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.

diff --git a/Documentation/standards.perl b/Documentation/standards.perl
index 835de3a21dc46f327309cd447be3c0bd375cfb97..c36afb5d718bc6725701594618934dcecce8f395 100755 (executable)
--- 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 2c20c84b0e1022f6594227d8de9f1a4cb2aaf4fb..ec73893c5694d6cdda85ad5d3739d4c910c21d69 100644 (file)
--- 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
-       \<<EOM;
+       <<EOM;
 +OK Capability list follows\r
 TOP\r
 USER\r
 PIPELINING\r
 UIDL\r
 EXPIRE 0\r
-RESP-CODES\r
+RESP-CODES\r$STLS
 .\r
 EOM
 }

diff --git a/t/pop3d.t b/t/pop3d.t
index 3d70935fa69d162db37e5ffef1b0906a839f5454..9eb110d6879f0d86d7d1e5931d73d25df7a4a3b0 100644 (file)
--- a/t/pop3d.t
+++ b/t/pop3d.t
@@ -106,6 +106,8 @@ for my $args (
        my @p3s_args = ($pop3s->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;