From f40f4695c0cb576a4e00819da45c1bea8f548aec Mon Sep 17 00:00:00 2001 From: Eric Wong Date: Wed, 20 Jul 2022 09:24:13 +0000 Subject: [PATCH] pop3: advertise STLS in CAPA if appropriate This is documented in RFC 2595, and POP3 clients may rely on seeing "STLS" in CAPA output to initiate TLS negotiation. --- Documentation/standards.perl | 1 + lib/PublicInbox/POP3.pm | 6 ++++-- t/pop3d.t | 7 +++++++ 3 files changed, 12 insertions(+), 2 deletions(-) diff --git a/Documentation/standards.perl b/Documentation/standards.perl index 835de3a2..c36afb5d 100755 --- a/Documentation/standards.perl +++ b/Documentation/standards.perl @@ -69,6 +69,7 @@ my $rfcs = [ 1081 => 'Post Office Protocol – Version 3', 1939 => 'Post Office Protocol – Version 3 (STD 53)', 2449 => 'POP3 extension mechanism', + 2595 => 'STARTTLS for IMAP and POP3', 2384 => 'POP URL Scheme', # TODO: flesh this out diff --git a/lib/PublicInbox/POP3.pm b/lib/PublicInbox/POP3.pm index 2c20c84b..ec73893c 100644 --- a/lib/PublicInbox/POP3.pm +++ b/lib/PublicInbox/POP3.pm @@ -343,15 +343,17 @@ sub cmd_dele { # RFC 2449 sub cmd_capa { my ($self) = @_; + my $STLS = !$self->{ibx} && !$self->{sock}->can('stop_SSL') && + $self->{pop3d}->{accept_tls} ? "\nSTLS\r" : ''; $self->{expire} = ''; # "EXPIRE 0" allows clients to avoid DELE commands - \<sockhost, Port => $pop3s->sockport, SSL => 1, %o); my $p3s = Net::POP3->new(@p3s_args); + my $capa = $p3s->capa; + ok(!exists $capa->{STLS}, 'no STLS CAPA for POP3S'); ok($p3s->quit, 'QUIT works w/POP3S'); { $p3s = Net::POP3->new(@p3s_args); @@ -127,7 +129,11 @@ for my $args ( my $np3 = Net::POP3->new(@np3_args); ok($np3->quit, 'plain QUIT works'); $np3 = Net::POP3->new(@np3_args, %o); + $capa = $np3->capa; + ok(exists $capa->{STLS}, 'STLS CAPA advertised before STLS'); ok($np3->starttls, 'STLS works'); + $capa = $np3->capa; + ok(!exists $capa->{STLS}, 'STLS CAPA not advertised after STLS'); ok($np3->quit, 'QUIT works after STLS'); for my $mailbox (('x'x32)."\@$group", $group, ('a'x32)."\@z.$group") { @@ -239,6 +245,7 @@ EOF my $capa = $oldc->capa; ok(defined($capa->{PIPELINING}), 'pipelining supported by CAPA'); is($capa->{EXPIRE}, 0, 'EXPIRE 0 set'); + ok(!exists $capa->{STLS}, 'STLS unset w/o daemon certs'); # ensure TOP doesn't trigger "EXPIRE 0" like RETR does (cf. RFC2449) my $list = $oldc->list; -- 2.44.0