Makefile.PL
README
TODO
+certs/.gitignore
+certs/create-certs.perl
ci/README
ci/deps.perl
ci/profiles.sh
lib/PublicInbox/Spawn.pm
lib/PublicInbox/SpawnPP.pm
lib/PublicInbox/Syscall.pm
+lib/PublicInbox/TLS.pm
lib/PublicInbox/Unsubscribe.pm
lib/PublicInbox/UserContent.pm
lib/PublicInbox/V2Writable.pm
t/msgmap.t
t/msgtime.t
t/nntp.t
+t/nntpd-tls.t
t/nntpd.t
t/nulsubject.t
t/over.t
--- /dev/null
+*.pem
+*.der
+*.enc
+*.p12
--- /dev/null
+#!/usr/bin/perl -w
+# License: GPL-1.0+ or Artistic-1.0-Perl
+# from IO::Socket::SSL 2.063 / https://github.com/noxxi/p5-io-socket-ssl
+use strict;
+use warnings;
+use IO::Socket::SSL::Utils;
+use Net::SSLeay;
+
+my $dir = "./";
+my $now = time();
+my $later = $now + 100*365*86400;
+
+Net::SSLeay::SSLeay_add_ssl_algorithms();
+my $sha256 = Net::SSLeay::EVP_get_digestbyname('sha256') or die;
+my $printfp = sub {
+ my ($w,$cert) = @_;
+ print $w.' sha256$'.unpack('H*',Net::SSLeay::X509_digest($cert, $sha256))."\n"
+};
+
+my %time_valid = (not_before => $now, not_after => $later);
+
+my @ca = CERT_create(
+ CA => 1,
+ subject => { CN => 'IO::Socket::SSL Demo CA' },
+ %time_valid,
+);
+save('test-ca.pem',PEM_cert2string($ca[0]));
+
+my @server = CERT_create(
+ CA => 0,
+ subject => { CN => 'server.local' },
+ purpose => 'server',
+ issuer => \@ca,
+ %time_valid,
+);
+save('server-cert.pem',PEM_cert2string($server[0]));
+save('server-key.pem',PEM_key2string($server[1]));
+$printfp->(server => $server[0]);
+
+@server = CERT_create(
+ CA => 0,
+ subject => { CN => 'server2.local' },
+ purpose => 'server',
+ issuer => \@ca,
+ %time_valid,
+);
+save('server2-cert.pem',PEM_cert2string($server[0]));
+save('server2-key.pem',PEM_key2string($server[1]));
+$printfp->(server2 => $server[0]);
+
+@server = CERT_create(
+ CA => 0,
+ subject => { CN => 'server-ecc.local' },
+ purpose => 'server',
+ issuer => \@ca,
+ key => KEY_create_ec(),
+ %time_valid,
+);
+save('server-ecc-cert.pem',PEM_cert2string($server[0]));
+save('server-ecc-key.pem',PEM_key2string($server[1]));
+$printfp->('server-ecc' => $server[0]);
+
+
+my @client = CERT_create(
+ CA => 0,
+ subject => { CN => 'client.local' },
+ purpose => 'client',
+ issuer => \@ca,
+ %time_valid,
+);
+save('client-cert.pem',PEM_cert2string($client[0]));
+save('client-key.pem',PEM_key2string($client[1]));
+$printfp->(client => $client[0]);
+
+my @swc = CERT_create(
+ CA => 0,
+ subject => { CN => 'server.local' },
+ purpose => 'server',
+ issuer => \@ca,
+ subjectAltNames => [
+ [ DNS => '*.server.local' ],
+ [ IP => '127.0.0.1' ],
+ [ DNS => 'www*.other.local' ],
+ [ DNS => 'smtp.mydomain.local' ],
+ [ DNS => 'xn--lwe-sna.idntest.local' ]
+ ],
+ %time_valid,
+);
+save('server-wildcard.pem',PEM_cert2string($swc[0]),PEM_key2string($swc[1]));
+
+
+my @subca = CERT_create(
+ CA => 1,
+ issuer => \@ca,
+ subject => { CN => 'IO::Socket::SSL Demo Sub CA' },
+ %time_valid,
+);
+save('test-subca.pem',PEM_cert2string($subca[0]));
+@server = CERT_create(
+ CA => 0,
+ subject => { CN => 'server.local' },
+ purpose => 'server',
+ issuer => \@subca,
+ %time_valid,
+);
+save('sub-server.pem',PEM_cert2string($server[0]).PEM_key2string($server[1]));
+
+
+
+my @cap = CERT_create(
+ CA => 1,
+ subject => { CN => 'IO::Socket::SSL::Intercept' },
+ %time_valid,
+);
+save('proxyca.pem',PEM_cert2string($cap[0]).PEM_key2string($cap[1]));
+
+sub save {
+ my $file = shift;
+ open(my $fd,'>',$dir.$file) or die $!;
+ print $fd @_;
+}
+
+system(<<CMD);
+cd $dir
+set -x
+openssl x509 -in server-cert.pem -out server-cert.der -outform der
+openssl rsa -in server-key.pem -out server-key.der -outform der
+openssl rsa -in server-key.pem -out server-key.enc -passout pass:bluebell
+openssl rsa -in client-key.pem -out client-key.enc -passout pass:opossum
+openssl pkcs12 -export -in server-cert.pem -inkey server-key.pem -out server.p12 -passout pass:
+openssl pkcs12 -export -in server-cert.pem -inkey server-key.pem -out server_enc.p12 -passout pass:bluebell
+CMD
}
} else { #($ref eq 'CODE') {
shift @$wbuf;
+ my $before = scalar(@$wbuf);
$bref->($self);
+
+ # bref may be enqueueing more CODE to call (see accept_tls_step)
+ return 0 if (scalar(@$wbuf) > $before);
}
} # while @$wbuf
return ($r == 0 ? $self->close : $r) if defined $r;
# common for clients to break connections without warning,
# would be too noisy to log here:
- $! == EAGAIN ? $self->watch_in1 : $self->close;
+ if (ref($self) eq 'IO::Socket::SSL') {
+ my $ev = PublicInbox::TLS::epollbit() or return $self->close;
+ watch($self, $ev | EPOLLONESHOT);
+ } elsif ($! == EAGAIN) {
+ watch($self, EPOLLIN | EPOLLONESHOT);
+ } else {
+ $self->close;
+ }
}
# drop the socket if we hit unrecoverable errors on our system which
my $self = $_[0];
my $sock = $self->{sock} or return 1;
- if (MSG_MORE && !$self->{wbuf}) {
+ if (MSG_MORE && !$self->{wbuf} && ref($sock) ne 'IO::Socket::SSL') {
my $n = send($sock, $_[1], MSG_MORE);
if (defined $n) {
my $nlen = bytes::length($_[1]) - $n;
sub watch_in1 ($) { watch($_[0], EPOLLIN | EPOLLONESHOT) }
+# return true if complete, false if incomplete (or failure)
+sub accept_tls_step ($) {
+ my ($self) = @_;
+ my $sock = $self->{sock} or return;
+ return 1 if $sock->accept_SSL;
+ return $self->close if $! != EAGAIN;
+ if (my $ev = PublicInbox::TLS::epollbit()) {
+ unshift @{$self->{wbuf} ||= []}, \&accept_tls_step;
+ return watch($self, $ev | EPOLLONESHOT);
+ }
+ drop($self, 'BUG? EAGAIN but '.PublicInbox::TLS::err());
+}
+
package PublicInbox::DS::Timer;
# [$abs_float_firetime, $coderef];
sub cancel {
my $worker_processes = 1;
my @listeners;
my %pids;
-my %listener_names;
+my %listener_names; # sockname => IO::Handle
+my %tls_opt; # scheme://sockname => args for IO::Socket::SSL->start_SSL
my $reexec_pid;
my $cleanup;
my ($uid, $gid);
+my ($default_cert, $default_key);
END { $cleanup->() if $cleanup };
+sub tls_listen ($$$) {
+ my ($scheme, $sockname, $opt_str) = @_;
+ # opt_str: opt1=val1,opt2=val2 (opt may repeat for multi-value)
+ require PublicInbox::TLS;
+ my $o = {};
+ # allow ',' as delimiter since '&' is shell-unfriendly
+ foreach (split(/[,&]/, $opt_str)) {
+ my ($k, $v) = split(/=/, $_, 2);
+ push @{$o->{$k} ||= []}, $v;
+ }
+
+ # key may be a part of cert. At least
+ # p5-io-socket-ssl/example/ssl_server.pl has this fallback:
+ $o->{cert} //= [ $default_cert ];
+ $o->{key} //= defined($default_key) ? [ $default_key ] : $o->{cert};
+ my %ctx_opt = (SSL_server => 1);
+ # parse out hostname:/path/to/ mappings:
+ foreach my $k (qw(cert key)) {
+ my $x = $ctx_opt{'SSL_'.$k.'_file'} = {};
+ foreach my $path (@{$o->{$k}}) {
+ my $host = '';
+ $path =~ s/\A([^:]+):// and $host = $1;
+ $x->{$host} = $path;
+ }
+ }
+ my $ctx = IO::Socket::SSL::SSL_Context->new(%ctx_opt) or
+ die 'SSL_Context->new: '.PublicInbox::TLS::err();
+ $tls_opt{"$scheme://$sockname"} = {
+ SSL_server => 1,
+ SSL_startHandshake => 0,
+ SSL_reuse_ctx => $ctx
+ };
+}
+
sub daemon_prepare ($) {
my ($default_listen) = @_;
@CMD = ($0, @ARGV);
'u|user=s' => \$user,
'g|group=s' => \$group,
'D|daemonize' => \$daemonize,
+ 'cert=s' => \$default_cert,
+ 'key=s' => \$default_key,
);
GetOptions(%opts) or die "bad command-line args\n";
push @cfg_listen, $default_listen unless (@listeners || @cfg_listen);
foreach my $l (@cfg_listen) {
+ my $orig = $l;
+ my $scheme = '';
+ $l =~ s!\A([^:]+)://!! and $scheme = $1;
+ if ($l =~ s!/?\?(.+)\z!!) {
+ tls_listen($scheme, $l, $1);
+ } elsif (defined($default_cert)) {
+ tls_listen($scheme, $l, '');
+ } elsif ($scheme =~ /\A(?:nntps|https)\z/) {
+ die "$orig specified w/o cert=\n";
+ }
+ # TODO: use scheme to load either NNTP.pm or HTTP.pm
+
next if $listener_names{$l}; # already inherited
my (%o, $sock_pkg);
if (index($l, '/') == 0) {
exit # never gets here, just for documentation
}
-sub daemon_loop ($$) {
- my ($refresh, $post_accept) = @_;
+sub tls_start_cb ($$) {
+ my ($opt, $orig_post_accept) = @_;
+ sub {
+ my ($io, $addr, $srv) = @_;
+ my $ssl = IO::Socket::SSL->start_SSL($io, %$opt);
+ $orig_post_accept->($ssl, $addr, $srv);
+ }
+}
+
+sub daemon_loop ($$$) {
+ my ($refresh, $post_accept, $nntpd) = @_;
PublicInbox::EvCleanup::enable(); # early for $refresh
+ my %post_accept;
+ while (my ($k, $v) = each %tls_opt) {
+ if ($k =~ s!\A(?:nntps|https)://!!) {
+ $post_accept{$k} = tls_start_cb($v, $post_accept);
+ } elsif ($nntpd) { # STARTTLS, $k eq '' is OK
+ $nntpd->{accept_tls} = $v;
+ }
+ }
my $parent_pipe;
if ($worker_processes > 0) {
$refresh->(); # preload by default
$SIG{$_} = 'IGNORE' for qw(USR2 TTIN TTOU WINCH);
# this calls epoll_create:
@listeners = map {
- PublicInbox::Listener->new($_, $post_accept)
+ PublicInbox::Listener->new($_,
+ $post_accept{sockname($_)} || $post_accept)
} @listeners;
PublicInbox::DS->EventLoop;
$parent_pipe = undef;
}
-sub run ($$$) {
- my ($default, $refresh, $post_accept) = @_;
+sub run ($$$;$) {
+ my ($default, $refresh, $post_accept, $nntpd) = @_;
daemon_prepare($default);
daemonize();
- daemon_loop($refresh, $post_accept);
+ daemon_loop($refresh, $post_accept, $nntpd);
}
sub do_chown ($) {
-# Copyright (C) 2015-2018 all contributors <meta@public-inbox.org>
+# Copyright (C) 2015-2019 all contributors <meta@public-inbox.org>
# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
#
# Each instance of this represents a NNTP client socket
sub new ($$$) {
my ($class, $sock, $nntpd) = @_;
my $self = fields::new($class);
- $self->SUPER::new($sock, EPOLLOUT | EPOLLONESHOT);
+ my $ev = EPOLLOUT | EPOLLONESHOT;
+ my $wbuf = [];
+ if (ref($sock) eq 'IO::Socket::SSL' && !$sock->accept_SSL) {
+ $ev = PublicInbox::TLS::epollbit() or return $sock->close;
+ $ev |= EPOLLONESHOT;
+ $wbuf->[0] = \&PublicInbox::DS::accept_tls_step;
+ }
+ $self->SUPER::new($sock, $ev);
$self->{nntpd} = $nntpd;
my $greet = "201 $nntpd->{servername} ready - post via email\r\n";
open my $fh, '<:scalar', \$greet or die "open :scalar: $!";
- $self->{wbuf} = [ $fh ];
+ push @$wbuf, $fh;
+ $self->{wbuf} = $wbuf;
$self->{rbuf} = '';
update_idle_time($self);
$expt ||= PublicInbox::EvCleanup::later(*expire_old);
});
}
+sub cmd_starttls ($) {
+ my ($self) = @_;
+ my $sock = $self->{sock} or return;
+ # RFC 4642 2.2.1
+ (ref($sock) eq 'IO::Socket::SSL') and return '502 Command unavailable';
+ my $opt = $self->{nntpd}->{accept_tls} or
+ return '580 can not initiate TLS negotiation';
+ res($self, '382 Continue with TLS negotiation');
+ $self->{sock} = IO::Socket::SSL->start_SSL($sock, %$opt);
+ requeue($self) if PublicInbox::DS::accept_tls_step($self);
+ undef;
+}
+
sub cmd_xpath ($$) {
my ($self, $mid) = @_;
return r501 unless $mid =~ /\A<(.+)>\z/;
out => \*STDOUT,
grouplist => [],
servername => $name,
+ # accept_tls => { SSL_server => 1, ..., SSL_reuse_ctx => ... }
}, $class;
}
--- /dev/null
+# Copyright (C) 2019 all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+
+# IO::Socket::SSL support code
+package PublicInbox::TLS;
+use strict;
+use IO::Socket::SSL;
+require Carp;
+use Errno qw(EAGAIN);
+use PublicInbox::Syscall qw(EPOLLIN EPOLLOUT);
+
+sub err () { $SSL_ERROR }
+
+# returns the EPOLL event bit which matches the existing SSL error
+sub epollbit () {
+ if ($! == EAGAIN) {
+ return EPOLLIN if $SSL_ERROR == SSL_WANT_READ;
+ return EPOLLOUT if $SSL_ERROR == SSL_WANT_WRITE;
+ die "unexpected SSL error: $SSL_ERROR";
+ }
+ 0;
+}
+
+1;
my $nntpd = PublicInbox::NNTPD->new;
PublicInbox::Daemon::run('0.0.0.0:119',
sub { $nntpd->refresh_groups }, # refresh
- sub ($$$) { PublicInbox::NNTP->new($_[0], $nntpd) }); # post_accept
+ sub ($$$) { PublicInbox::NNTP->new($_[0], $nntpd) }, # post_accept
+ $nntpd);
--- /dev/null
+# Copyright (C) 2019 all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+use strict;
+use warnings;
+use Test::More;
+use File::Temp qw(tempdir);
+use Socket qw(SOCK_STREAM);
+foreach my $mod (qw(DBD::SQLite IO::Socket::SSL Net::NNTP)) {
+ eval "require $mod";
+ plan skip_all => "$mod missing for $0" if $@;
+}
+my $cert = 'certs/server-cert.pem';
+my $key = 'certs/server-key.pem';
+unless (-r $key && -r $cert) {
+ plan skip_all =>
+ "certs/ missing for $0, run ./create-certs.perl in certs/";
+}
+
+use_ok 'PublicInbox::TLS';
+use_ok 'IO::Socket::SSL';
+require './t/common.perl';
+require PublicInbox::InboxWritable;
+require PublicInbox::MIME;
+require PublicInbox::SearchIdx;
+my $version = 2; # v2 needs newer git
+require_git('2.6') if $version >= 2;
+my $tmpdir = tempdir('pi-nntpd-tls-XXXXXX', TMPDIR => 1, CLEANUP => 1);
+my $err = "$tmpdir/stderr.log";
+my $out = "$tmpdir/stdout.log";
+my $mainrepo = "$tmpdir";
+my $pi_config = "$tmpdir/pi_config";
+my $group = 'test-nntpd-tls';
+my $addr = $group . '@example.com';
+my $nntpd = 'blib/script/public-inbox-nntpd';
+my %opts = (
+ LocalAddr => '127.0.0.1',
+ ReuseAddr => 1,
+ Proto => 'tcp',
+ Type => SOCK_STREAM,
+ Listen => 1024,
+);
+my $starttls = IO::Socket::INET->new(%opts);
+my $nntps = IO::Socket::INET->new(%opts);
+my ($pid, $tail_pid);
+END {
+ foreach ($pid, $tail_pid) {
+ kill 'TERM', $_ if defined $_;
+ }
+};
+
+my $ibx = PublicInbox::Inbox->new({
+ mainrepo => $mainrepo,
+ name => 'nntpd-tls',
+ version => $version,
+ -primary_address => $addr,
+ indexlevel => 'basic',
+});
+$ibx = PublicInbox::InboxWritable->new($ibx, {nproc=>1});
+$ibx->init_inbox(0);
+{
+ open my $fh, '>', $pi_config or die "open: $!\n";
+ print $fh <<EOF
+[publicinbox "nntpd-tls"]
+ mainrepo = $mainrepo
+ address = $addr
+ indexlevel = basic
+ newsgroup = $group
+EOF
+ ;
+ close $fh or die "close: $!\n";
+}
+
+{
+ my $im = $ibx->importer(0);
+ my $mime = PublicInbox::MIME->new(do {
+ open my $fh, '<', 't/data/0001.patch' or die;
+ local $/;
+ <$fh>
+ });
+ ok($im->add($mime), 'message added');
+ $im->done;
+ if ($version == 1) {
+ my $s = PublicInbox::SearchIdx->new($ibx, 1);
+ $s->index_sync;
+ }
+}
+
+my $nntps_addr = $nntps->sockhost . ':' . $nntps->sockport;
+my $starttls_addr = $starttls->sockhost . ':' . $starttls->sockport;
+my $env = { PI_CONFIG => $pi_config };
+
+for my $args (
+ [ "--cert=$cert", "--key=$key",
+ "-lnntps://$nntps_addr",
+ "-lnntp://$starttls_addr" ],
+) {
+ for ($out, $err) {
+ open my $fh, '>', $_ or die "truncate: $!";
+ }
+ if (my $tail_cmd = $ENV{TAIL}) { # don't assume GNU tail
+ $tail_pid = fork;
+ if (defined $tail_pid && $tail_pid == 0) {
+ exec(split(' ', $tail_cmd), $out, $err);
+ }
+ }
+ my $cmd = [ $nntpd, '-W0', @$args, "--stdout=$out", "--stderr=$err" ];
+ $pid = spawn_listener($env, $cmd, [ $starttls, $nntps ]);
+ my %o = (
+ SSL_hostname => 'server.local',
+ SSL_verifycn_name => 'server.local',
+ SSL => 1,
+ SSL_verify_mode => SSL_VERIFY_PEER(),
+ SSL_ca_file => 'certs/test-ca.pem',
+ );
+ my $expect = { $group => [qw(1 1 n)] };
+
+ # NNTPS
+ my $c = Net::NNTP->new($nntps_addr, %o);
+ my $list = $c->list;
+ is_deeply($list, $expect, 'NNTPS LIST works');
+
+ # STARTTLS
+ delete $o{SSL};
+ $c = Net::NNTP->new($starttls_addr, %o);
+ $list = $c->list;
+ is_deeply($list, $expect, 'plain LIST works');
+ ok($c->starttls, 'STARTTLS succeeds');
+ is($c->code, 382, 'got 382 for STARTTLS');
+ $list = $c->list;
+ is_deeply($list, $expect, 'LIST works after STARTTLS');
+
+ # Net::NNTP won't let us do dumb things, but we need to test
+ # dumb things, so use Net::Cmd directly:
+ my $n = $c->command('STARTTLS')->response();
+ is($n, Net::Cmd::CMD_ERROR(), 'error attempting STARTTLS again');
+ is($c->code, 502, '502 according to RFC 4642 sec#2.2.1');
+
+ $c = undef;
+ kill('TERM', $pid);
+ is($pid, waitpid($pid, 0), 'nntpd exited successfully');
+ is($?, 0, 'no error in exited process');
+ $pid = undef;
+ my $eout = eval {
+ open my $fh, '<', $err or die "open $err failed: $!";
+ local $/;
+ <$fh>;
+ };
+ unlike($eout, qr/wide/i, 'no Wide character warnings');
+ if (defined $tail_pid) {
+ kill 'TERM', $tail_pid;
+ waitpid($tail_pid, 0);
+ $tail_pid = undef;
+ }
+}
+done_testing();
+1;
is_deeply($list, { $group => [ qw(1 1 n) ] }, 'LIST works');
is_deeply([$n->group($group)], [ qw(0 1 1), $group ], 'GROUP works');
is_deeply($n->listgroup($group), [1], 'listgroup OK');
+ ok(!$n->starttls, 'STARTTLS fails when unconfigured');
+ is($n->code, 580, 'got 580 code on server w/o TLS');
%opts = (
PeerAddr => $host_port,