diff options
| -rw-r--r-- | lib/PublicInbox/Msgmap.pm | 74 | ||||
| -rw-r--r-- | lib/PublicInbox/NNTP.pm | 560 | ||||
| -rw-r--r-- | lib/PublicInbox/NewsGroup.pm | 81 | ||||
| -rw-r--r-- | lib/PublicInbox/Search.pm | 9 | ||||
| -rw-r--r-- | public-inbox-nntpd | 77 | ||||
| -rw-r--r-- | t/msgmap.t | 14 | ||||
| -rw-r--r-- | t/nntp.t | 64 |
7 files changed, 856 insertions, 23 deletions
diff --git a/lib/PublicInbox/Msgmap.pm b/lib/PublicInbox/Msgmap.pm index a1748af9..c0fc636f 100644 --- a/lib/PublicInbox/Msgmap.pm +++ b/lib/PublicInbox/Msgmap.pm @@ -4,7 +4,7 @@ package PublicInbox::Msgmap; use strict; use warnings; -use fields qw(dbh mid_insert mid_for num_for); +use fields qw(dbh mid_insert mid_for num_for num_minmax); use DBI; use DBD::SQLite; @@ -23,43 +23,55 @@ sub new { sqlite_use_immediate_transaction => 1, }); $dbh->do('PRAGMA case_sensitive_like = ON'); - - $writable and create_tables($dbh); my $self = fields::new($class); $self->{dbh} = $dbh; + + if ($writable) { + create_tables($dbh); + $self->created_at(time) unless $self->created_at; + } $self; } -# accessor -sub last_commit { - my ($self, $commit) = @_; - my $dbh = $self->{dbh}; - my $prev; +sub meta_accessor { + my ($self, $key, $value) = @_; use constant { - key => 'last_commit', meta_select => 'SELECT val FROM meta WHERE key = ? LIMIT 1', meta_update => 'UPDATE meta SET val = ? WHERE key = ? LIMIT 1', meta_insert => 'INSERT INTO meta (key,val) VALUES (?,?)', }; - defined $commit or - return $dbh->selectrow_array(meta_select, undef, key); + my $dbh = $self->{dbh}; + my $prev; + defined $value or + return $dbh->selectrow_array(meta_select, undef, $key); $dbh->begin_work; eval { - $prev = $dbh->selectrow_array(meta_select, undef, key); + $prev = $dbh->selectrow_array(meta_select, undef, $key); if (defined $prev) { - $dbh->do(meta_update, undef, $commit, key); + $dbh->do(meta_update, undef, $value, $key); } else { - $dbh->do(meta_insert, undef, key, $commit); + $dbh->do(meta_insert, undef, $key, $value); } $dbh->commit; }; - return $prev unless $@; + my $err = $@; + return $prev unless $err; $dbh->rollback; - die $@; + die $err; +} + +sub last_commit { + my ($self, $commit) = @_; + $self->meta_accessor('last_commit', $commit); +} + +sub created_at { + my ($self, $second) = @_; + $self->meta_accessor('created_at', $second); } sub mid_insert { @@ -92,6 +104,15 @@ sub num_for { $sth->fetchrow_array; } +sub minmax { + my ($self) = @_; + my $dbh = $self->{dbh}; + use constant NUM_MINMAX => 'SELECT MIN(num),MAX(num) FROM msgmap'; + my $sth = $self->{num_minmax} ||= $dbh->prepare(NUM_MINMAX); + $sth->execute; + $sth->fetchrow_array; +} + sub mid_prefixes { my ($self, $pfx, $limit) = @_; @@ -134,4 +155,25 @@ sub create_tables { 'val VARCHAR(255) NOT NULL)'); } +sub each_id_batch { + my ($self, $cb) = @_; + my $dbh = $self->{dbh}; + my $n = 0; + my $total = 0; + my $nr; + my $sth = $dbh->prepare('SELECT num FROM msgmap WHERE num > ? '. + 'ORDER BY num ASC LIMIT 1000'); + while (1) { + $sth->execute($n); + my $ary = $sth->fetchall_arrayref; + @$ary = map { $_->[0] } @$ary; + $nr = scalar @$ary; + last if $nr == 0; + $total += $nr; + $n = $ary->[-1]; + $cb->($ary); + } + $total; +} + 1; diff --git a/lib/PublicInbox/NNTP.pm b/lib/PublicInbox/NNTP.pm new file mode 100644 index 00000000..f1aaed48 --- /dev/null +++ b/lib/PublicInbox/NNTP.pm @@ -0,0 +1,560 @@ +# Copyright (C) 2015 all contributors <meta@public-inbox.org> +# License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt) +package PublicInbox::NNTP; +use strict; +use warnings; +use base qw(Danga::Socket); +use fields qw(nntpd article ng); +use PublicInbox::Msgmap; +use PublicInbox::GitCatFile; +use PublicInbox::MID qw(mid2path); +use Email::Simple; +use Data::Dumper qw(Dumper); +use POSIX qw(strftime); +use constant { + r501 => '501 command syntax error', +}; + +my @OVERVIEW = qw(Subject From Date Message-ID References Bytes Lines); +my %OVERVIEW = map { $_ => 1 } @OVERVIEW; + +# disable commands with easy DoS potential: +# LISTGROUP could get pretty bad, too... +my %DISABLED; # = map { $_ => 1 } qw(xover list_overview_fmt newnews xhdr); + +sub new { + my ($class, $sock, $nntpd) = @_; + my $self = fields::new($class); + $self->SUPER::new($sock); + $self->{nntpd} = $nntpd; + res($self, '201 server ready - post via email'); + $self->watch_read(1); + $self; +} + +# returns 1 if we can continue, 0 if not due to buffered writes or disconnect +sub process_line { + my ($self, $l) = @_; + my ($req, @args) = split(/\s+/, $l); + $req = lc($req); + $req = eval { + no strict 'refs'; + $req = $DISABLED{$req} ? undef : *{'cmd_'.$req}{CODE}; + }; + return res($self, '500 command not recognized') unless $req; + + my $res = eval { $req->($self, @args) }; + my $err = $@; + if ($err && !$self->{closed}) { + chomp($l = Dumper(\$l)); + warning('error from: ', $l, ' ', $err); + $res = '503 program fault - command not performed'; + } + return 0 unless defined $res; + res($self, $res); +} + +sub cmd_mode { + my ($self, $arg) = @_; + return r501 unless defined $arg; + $arg = uc $arg; + return r501 unless $arg eq 'READER'; + '200 reader status acknowledged'; +} + +sub cmd_slave { + my ($self, @x) = @_; + return r501 if @x; + '202 slave status noted'; +} + +sub cmd_xgtitle { + my ($self, $wildmat) = @_; + more($self, '282 list of groups and descriptions follows'); + list_newsgroups($self, $wildmat); + '.' +} + +sub list_overview_fmt { + my ($self) = @_; + more($self, $_ . ':') foreach @OVERVIEW; +} + +sub list_active { + my ($self, $wildmat) = @_; + wildmat2re($wildmat); + foreach my $ng (values %{$self->{nntpd}->{groups}}) { + $ng->{name} =~ $wildmat or next; + group_line($self, $ng); + } +} + +sub list_active_times { + my ($self, $wildmat) = @_; + wildmat2re($wildmat); + foreach my $ng (values %{$self->{nntpd}->{groups}}) { + $ng->{name} =~ $wildmat or next; + my $c = eval { $ng->mm->created_at } || time; + more($self, "$ng->{name} $c $ng->{address}"); + } +} + +sub list_newsgroups { + my ($self, $wildmat) = @_; + wildmat2re($wildmat); + foreach my $ng (values %{$self->{nntpd}->{groups}}) { + $ng->{name} =~ $wildmat or next; + my $d = $ng->description; + more($self, "$ng->{name} $d"); + } +} + +# LIST SUBSCRIPTIONS not supported +sub cmd_list { + my ($self, $arg, $wildmat, @x) = @_; + if (defined $arg) { + $arg = lc $arg; + $arg =~ tr/./_/; + $arg = "list_$arg"; + return '503 function not performed' if $DISABLED{$arg}; + $arg = eval { + no strict 'refs'; + *{$arg}{CODE}; + }; + return r501 unless $arg; + more($self, '215 information follows'); + $arg->($self, $wildmat, @x); + } else { + more($self, '215 list of newsgroups follows'); + foreach my $ng (values %{$self->{nntpd}->{groups}}) { + group_line($self, $ng); + } + } + '.' +} + +sub cmd_listgroup { + my ($self, $group) = @_; + if (defined $group) { + my $res = cmd_group($self, $group); + return $res if ($res !~ /\A211 /); + more($self, $res); + } + + my $ng = $self->{ng} or return '412 no newsgroup selected'; + # Ugh this can be silly expensive for big groups + $ng->mm->each_id_batch(sub { + my ($ary) = @_; + more($self, join("\r\n", @$ary)); + }); + '.' +} + +sub parse_time { + my ($date, $time, $gmt) = @_; + use Time::Local qw(); + my ($YY, $MM, $DD) = unpack('A2A2A2', $date); + my ($hh, $mm, $ss) = unpack('A2A2A2', $time); + if (defined $gmt) { + $gmt =~ /\A(?:UTC|GMT)\z/i or die "GM invalid: $gmt\n"; + $gmt = 1; + } + my @now = $gmt ? gmtime : localtime; + if ($YY > strftime('%y', @now)) { + my $cur_year = $now[5] + 1900; + $YY += int($cur_year / 1000) * 1000 - 100; + } + + if ($gmt) { + Time::Local::timegm($ss, $mm, $hh, $DD, $MM - 1, $YY); + } else { + Time::Local::timelocal($ss, $mm, $hh, $DD, $MM - 1, $YY); + } +} + +sub group_line { + my ($self, $ng) = @_; + my ($min, $max) = $ng->mm->minmax; + more($self, "$ng->{name} $max $min n") if defined $min && defined $max; +} + +sub cmd_newgroups { + my ($self, $date, $time, $gmt, $dists) = @_; + my $ts = eval { parse_time($date, $time, $gmt) }; + return r501 if $@; + + # TODO dists + more($self, '231 list of new newsgroups follows'); + foreach my $ng (values %{$self->{nntpd}->{groups}}) { + my $c = eval { $ng->mm->created_at } || 0; + next unless $c > $ts; + group_line($self, $ng); + } + '.' +} + +sub wildmat2re { + return $_[0] = qr/.*/ if (!defined $_[0] || $_[0] eq '*'); + my %keep; + my $salt = rand; + use Digest::SHA qw(sha1_hex); + my $tmp = $_[0]; + + $tmp =~ s#(?<!\\)\[(.+)(?<!\\)\]# + my $orig = $1; + my $key = sha1_hex($orig . $salt); + $orig =~ s/([^\w\-])+/\Q$1/g; + $keep{$key} = $orig; + $key + #gex; + my %map = ('*' => '.*', '?' => '.' ); + $tmp =~ s#(?<!\\)([^\w\\])#$map{$1} || "\Q$1"#ge; + if (scalar %keep) { + $tmp =~ s#([a-f0-9]{40})# + my $orig = $keep{$1}; + defined $orig ? $orig : $1; + #ge; + } + $_[0] = qr/\A$tmp\z/; +} + +sub ngpat2re { + return $_[0] = qr/\A\z/ unless defined $_[0]; + my %map = ('*' => '.*', ',' => '|'); + $_[0] =~ s!(.)!$map{$1} || "\Q$1"!ge; + $_[0] = qr/\A(?:$_[0])\z/; +} + +sub cmd_newnews { + my ($self, $newsgroups, $date, $time, $gmt, $dists) = @_; + my $ts = eval { parse_time($date, $time, $gmt) }; + return r501 if $@; + more($self, '230 list of new articles by message-id follows'); + my ($keep, $skip) = split('!', $newsgroups, 2); + ngpat2re($keep); + ngpat2re($skip); + $ts .= '..'; + + my $opts = { asc => 1, limit => 1000 }; + foreach my $ng (values %{$self->{nntpd}->{groups}}) { + $ng->{name} =~ $keep or next; + $ng->{name} =~ $skip and next; + my $srch = $ng->search or next; + $opts->{offset} = 0; + + while (1) { + my $res = $srch->query($ts, $opts); + my $msgs = $res->{msgs}; + my $nr = scalar @$msgs or last; + more($self, '<' . + join(">\r\n<", map { $_->mid } @$msgs ). + '>'); + $opts->{offset} += $nr; + } + } + '.'; +} + +sub cmd_group { + my ($self, $group) = @_; + my $no_such = '411 no such news group'; + my $ng = $self->{nntpd}->{groups}->{$group} or return $no_such; + + $self->{ng} = $ng; + my ($min, $max) = $ng->mm->minmax; + $min ||= 0; + $max ||= 0; + $self->{article} = $min; + my $est_size = $max - $min; + "211 $est_size $min $max $group"; +} + +sub article_adj { + my ($self, $off) = @_; + my $ng = $self->{ng} or return '412 no newsgroup selected'; + + my $n = $self->{article}; + defined $n or return '420 no current article has been selected'; + + $n += $off; + my $mid = $ng->mm->mid_for($n); + unless ($mid) { + $n = $off > 0 ? 'next' : 'previous'; + return "421 no $n article in this group"; + } + $self->{article} = $n; + "223 $n <$mid> article retrieved - request text separately"; +} + +sub cmd_next { article_adj($_[0], 1) } +sub cmd_last { article_adj($_[0], -1) } + +# We want to encourage using email and CC-ing everybody involved to avoid +# the single-point-of-failure a single server provides. +sub cmd_post { + my ($self) = @_; + my $ng = $self->{ng}; + $ng ? "440 mailto:$ng->{address} to post" : '440 posting not allowed' +} + +sub cmd_quit { + my ($self) = @_; + res($self, '205 closing connection - goodbye!'); + $self->close; + undef; +} + +sub art_lookup { + my ($self, $art, $set_headers) = @_; + my $ng = $self->{ng} or return '412 no newsgroup has been selected'; + my ($n, $mid); + my $err; + if (defined $art) { + if ($art =~ /\A\d+\z/o) { + $err = '423 no such article number in this group'; + $n = int($art); + goto find_mid; + } elsif ($art =~ /\A<([^>]+)>\z/) { + $err = '430 no such article found'; + $mid = $1; + $n = $ng->mm->num_for($mid); + defined $mid or return $err; + } else { + return r501; + } + } else { + $err = '420 no current article has been selected'; + $n = $self->{article}; + defined $n or return $err; +find_mid: + $mid = $ng->mm->mid_for($n); + defined $mid or return $err; + } + + my $o = 'HEAD:' . mid2path($mid); + my $s = eval { Email::Simple->new($ng->gcf->cat_file($o)) }; + return $err unless $s; + if ($set_headers) { + $s->header_set('Newsgroups', $ng->{name}); + $s->header_set('Lines', $s->body =~ tr!\n!\n!); + $s->header_set('Xref', "$ng->{domain} $ng->{name}:$n"); + + # must be last + if ($set_headers == 2) { + $s->header_set('Bytes', bytes::length($s->as_string)); + $s->body_set(''); + } + } + [ $n, $mid, $s ]; +} + +sub simple_body_write { + my ($self, $s) = @_; + my $body = $s->body; + $s->body_set(''); + $body =~ s/^\./../smg; + do_more($self, $body); + '.' +} + +sub header_str { + my ($s) = @_; + my $h = $s->header_obj; + $h->header_set('Bytes'); + $h->as_string +} + +sub cmd_article { + my ($self, $art) = @_; + my $r = $self->art_lookup($art, 1); + return $r unless ref $r; + my ($n, $mid, $s) = @$r; + more($self, "220 $n <$mid> article retrieved - head and body follow"); + do_more($self, header_str($s)); + do_more($self, "\r\n"); + simple_body_write($self, $s); +} + +sub cmd_head { + my ($self, $art) = @_; + my $r = $self->art_lookup($art, 2); + return $r unless ref $r; + my ($n, $mid, $s) = @$r; + more($self, "221 $n <$mid> article retrieved - head follows"); + do_more($self, header_str($s)); + '.' +} + +sub cmd_body { + my ($self, $art) = @_; + my $r = $self->art_lookup($art, 0); + return $r unless ref $r; + my ($n, $mid, $s) = @$r; + more($self, "222 $n <$mid> article retrieved - body follows"); + simple_body_write($self, $s); +} + +sub cmd_stat { + my ($self, $art) = @_; + my $r = $self->art_lookup($art, 0); + return $r unless ref $r; + my ($n, $mid, undef) = @$r; + "223 $n <$mid> article retrieved - request text separately"; +} + +sub cmd_ihave { '435 article not wanted - do not send it' } + +sub cmd_date { '111 '.strftime('%Y%m%d%H%M%S', gmtime(time)) } + +sub cmd_help { + my ($self) = @_; + more($self, '100 help text follows'); + '.' +} + +sub get_range { + my ($self, $range) = @_; + my $ng = $self->{ng} or return '412 no news group has been selected'; + defined $range or return '420 No article(s) selected'; + my ($beg, $end); + my ($min, $max) = $ng->mm->minmax; + if ($range =~ /\A(\d+)\z/) { + $beg = $end = $1; + } elsif ($range =~ /\A(\d+)-\z/) { + ($beg, $end) = ($1, $max); + } elsif ($range =~ /\A(\d+)-(\d+)\z/) { + ($beg, $end) = ($1, $2); + } else { + return r501; + } + $beg = $min if ($beg < $min); + $end = $max if ($end > $max); + return '420 No article(s) selected' if ($beg > $end); + [ $beg, $end ]; +} + +sub xhdr { + my ($r, $header) = @_; + $r = $r->[2]->header_obj->header($header); + defined $r or return; + $r =~ s/[\r\n\t]+/ /sg; + $r; +} + +sub cmd_xhdr { + my ($self, $header, $range) = @_; + defined $self->{ng} or return '412 no news group currently selected'; + unless (defined $range) { + defined($range = $self->{article}) or + return '420 no current article has been selected'; + } + if ($range =~ /\A<(.+)>\z/) { # Message-ID + my $r = $self->art_lookup($range, 2); + return $r unless ref $r; + more($self, '221 Header follows'); + if (defined($r = xhdr($r, $header))) { + more($self, "<$range> $r"); + } + } else { # numeric range + my $r = get_range($self, $range); + return $r unless ref $r; + my ($beg, $end) = @$r; + more($self, '221 Header follows'); + foreach my $i ($beg..$end) { + $r = $self->art_lookup($i, 2); + next unless ref $r; + defined($r = xhdr($r, $header)) or next; + more($self, "$i $r"); + } + } + '.'; +} + +sub cmd_xover { + my ($self, $range) = @_; + my $r = get_range($self, $range); + return $r unless ref $r; + my ($beg, $end) = @$r; + more($self, "224 Overview information follows for $beg to $end"); + foreach my $i ($beg..$end) { + my $r = $self->art_lookup($i, 2); + next unless ref $r; + more($self, join("\t", $r->[0], + map { + my $h = xhdr($r, $_); + defined $h ? $h : ''; + } @OVERVIEW )); + } + '.'; +} + +sub res { + my ($self, $line) = @_; + do_write($self, $line . "\r\n"); +} + +sub more { + my ($self, $line) = @_; + do_more($self, $line . "\r\n"); +} + +sub do_write { + my ($self, $data) = @_; + my $done = $self->write($data); + die if $self->{closed}; + + # Do not watch for readability if we have data in the queue, + # instead re-enable watching for readability when we can + $self->watch_read(0) unless $done; + + $done; +} + +use constant MSG_MORE => ($^O eq 'linux') ? 0x8000 : 0; + +sub do_more { + my ($self, $data) = @_; + if (MSG_MORE && !scalar @{$self->{write_buf}}) { + my $n = send($self->{sock}, $data, MSG_MORE); + if (defined $n) { + my $dlen = bytes::length($data); + return 1 if $n == $dlen; # all done! + $data = bytes::substr($data, $n, $dlen - $n); + } + } + $self->do_write($data); +} + +# callbacks for by Danga::Socket + +sub event_hup { $_[0]->close } +sub event_err { $_[0]->close } + +sub event_write { + my ($self) = @_; + # only continue watching for readability when we are done writing: + $self->write(undef) == 1 and $self->watch_read(1); +} + +sub event_read { + my ($self) = @_; + use constant LINE_MAX => 512; # RFC 977 section 2.3 + use Time::HiRes qw(gettimeofday tv_interval); + my $r = 1; + my $buf = $self->read(LINE_MAX) or return $self->close; + while ($r > 0 && $$buf =~ s/\A([^\r\n]+)\r?\n//) { + my $line = $1; + my $t0 = [ gettimeofday ]; + $r = eval { $self->process_line($line) }; + printf(STDERR "$line %0.6f\n", + tv_interval($t0, [gettimeofday])); + } + return $self->close if $r < 0; + my $len = bytes::length($$buf); + return $self->close if ($len >= LINE_MAX); + $self->push_back_read($buf) if ($len); +} + +sub warning { print STDERR @_, "\n" } + +1; diff --git a/lib/PublicInbox/NewsGroup.pm b/lib/PublicInbox/NewsGroup.pm new file mode 100644 index 00000000..6cc3f248 --- /dev/null +++ b/lib/PublicInbox/NewsGroup.pm @@ -0,0 +1,81 @@ +# Copyright (C) 2015 all contributors <meta@public-inbox.org> +# License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt) +package PublicInbox::NewsGroup; +use strict; +use warnings; +use fields qw(name git_dir address domain mm gcf search); +use Scalar::Util qw(weaken); +require Danga::Socket; +require PublicInbox::Msgmap; +require PublicInbox::GitCatFile; + +sub new { + my ($class, $name, $git_dir, $address) = @_; + my $self = fields::new($class); + $self->{name} = $name; + $self->{domain} = ($address =~ /\@(\S+)\z/) ? $1 : 'localhost'; + $self->{git_dir} = $git_dir; + $self->{address} = $address; + $self; +} + +sub defer_weaken { + my ($self, $field) = @_; + Danga::Socket->AddTimer(30, sub { weaken($self->{$field}) }); +} + +sub gcf { + my ($self) = @_; + $self->{gcf} ||= eval { + my $gcf = PublicInbox::GitCatFile->new($self->{git_dir}); + + # git repos may be repacked and old packs unlinked + defer_weaken($self, 'gcf'); + $gcf; + }; +} + +sub mm { + my ($self) = @_; + $self->{mm} ||= eval { + my $mm = PublicInbox::Msgmap->new($self->{git_dir}); + + # may be needed if we run low on handles + defer_weaken($self, 'mm'); + $mm; + }; +} + +sub search { + my ($self) = @_; + $self->{search} ||= eval { + require PublicInbox::Search; + my $search = PublicInbox::Search->new($self->{git_dir}); + + # may be needed if we run low on handles + defer_weaken($self, 'search'); + $search; + }; +} + +sub description { + my ($self) = @_; + open my $fh, '<', "$self->{git_dir}/description" or return ''; + my $desc = eval { local $/; <$fh> }; + chomp $desc; + $desc =~ s/\s+/ /smg; + $desc; +} + +sub update { + my ($self, $new) = @_; + $self->{address} = $new->{address}; + $self->{domain} = $new->{domain}; + if ($self->{git_dir} ne $new->{git_dir}) { + # new git_dir requires a new mm and gcf + $self->{mm} = $self->{gcf} = undef; + $self->{git_dir} = $new->{git_dir}; + } +} + +1; diff --git a/lib/PublicInbox/Search.pm b/lib/PublicInbox/Search.pm index a588af43..810eab85 100644 --- a/lib/PublicInbox/Search.pm +++ b/lib/PublicInbox/Search.pm @@ -109,8 +109,6 @@ sub get_thread { $self->do_enquire($query, $opts); } -# private subs below - sub do_enquire { my ($self, $query, $opts) = @_; my $enquire = $self->enquire; @@ -120,12 +118,13 @@ sub do_enquire { $query = $mail_query; } $enquire->set_query($query); + $opts ||= {}; + my $desc = !$opts->{asc}; if ($opts->{relevance}) { - $enquire->set_sort_by_relevance_then_value(TS, 1); + $enquire->set_sort_by_relevance_then_value(TS, $desc); } else { - $enquire->set_sort_by_value_then_relevance(TS, 1); + $enquire->set_sort_by_value_then_relevance(TS, $desc); } - $opts ||= {}; my $offset = $opts->{offset} || 0; my $limit = $opts->{limit} || 50; my $mset = $enquire->get_mset($offset, $limit); diff --git a/public-inbox-nntpd b/public-inbox-nntpd new file mode 100644 index 00000000..7fec840e --- /dev/null +++ b/public-inbox-nntpd @@ -0,0 +1,77 @@ +#!/usr/bin/perl -w +# Copyright (C) 2015 all contributors <meta@public-inbox.org> +# License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt) +use strict; +use warnings; +require Danga::Socket; +use IO::Socket; +use Socket qw(SO_KEEPALIVE IPPROTO_TCP TCP_NODELAY); +require PublicInbox::NNTP; +require PublicInbox::NewsGroup; +my $nntpd = PublicInbox::NNTPD->new; +my $refresh = sub { $nntpd->refresh_groups }; + +my %opts = ( + LocalAddr => '127.0.0.1:1133', + Type => SOCK_STREAM, + Proto => 'tcp', + Blocking => 0, + Reuse => 1, + Listen => 1024, +); +my $s = IO::Socket::INET->new(%opts) or die "Error creating socket: $@\n"; +$s->sockopt(SO_KEEPALIVE, 1); +$s->setsockopt(IPPROTO_TCP, TCP_NODELAY, 1); + +$SIG{PIPE} = 'IGNORE'; +$SIG{HUP} = $refresh; +$refresh->(); + +Danga::Socket->AddOtherFds(fileno($s) => sub { + while (my $c = $s->accept) { + $c->blocking(0); # no accept4 :< + PublicInbox::NNTP->new($c, $nntpd); + } +}); +Danga::Socket->EventLoop(); + +package PublicInbox::NNTPD; +use strict; +use warnings; +use fields qw(groups err out); + +sub new { + my ($class) = @_; + my $self = fields::new($class); + $self->{groups} = {}; + $self; +} + +sub refresh_groups { + my ($self) = @_; + require PublicInbox::Config; + my $pi_config = PublicInbox::Config->new; + my $new = {}; + foreach my $k (keys %$pi_config) { + $k =~ /\Apublicinbox\.([^\.]+)\.mainrepo\z/ or next; + my $g = $1; + my $git_dir = $pi_config->{$k}; + my $address = $pi_config->{"publicinbox.$g.address"}; + my $ng = PublicInbox::NewsGroup->new($g, $git_dir, $address); + my $old_ng = $self->{groups}->{$g}; + + # Reuse the old one if possible since it can hold references + # to valid mm and gcf objects + if ($old_ng) { + $old_ng->update($ng); + $ng = $old_ng; + } + + # Only valid if Msgmap works + $new->{$g} = $ng if $ng->mm; + } + # this will destroy old groups that got deleted + %{$self->{groups}} = %$new; +}; + +1; @@ -12,6 +12,8 @@ my $d = PublicInbox::Msgmap->new($tmpdir, 1); my %mid2num; my %num2mid; my @mids = qw(a@b c@d e@f g@h aa@bb aa@cc); +is_deeply([$d->minmax], [undef,undef], "empty min max on new DB"); + foreach my $mid (@mids) { my $n = $d->mid_insert($mid); ok($n, "mid $mid inserted"); @@ -23,6 +25,7 @@ $@ = undef; eval { $d->mid_insert('a@b') }; ok($@, 'error raised when attempting duplicate message ID'); + foreach my $n (keys %num2mid) { is($d->mid_for($n), $num2mid{$n}, "num:$n maps correctly"); } @@ -47,7 +50,14 @@ is($d->mid_delete('a@b') + 0, 0, 'delete again returns zero'); is(undef, $d->num_for('a@b'), 'num_for fails on deleted msg'); $d = undef; -# idempotent -ok(PublicInbox::Msgmap->new($tmpdir, 1), 'idempotent DB creation'); +ok($d = PublicInbox::Msgmap->new($tmpdir, 1), 'idempotent DB creation'); +my ($min, $max) = $d->minmax; +ok($min > 0, "article min OK"); +ok($max > 0 && $max < 10, "article max OK"); +ok($min < $max, "article counts OK"); + +my $orig = $d->mid_insert('spam@1'); +$d->mid_delete('spam@1'); +is($d->mid_insert('spam@2'), 1 + $orig, "last number not recycled"); done_testing(); diff --git a/t/nntp.t b/t/nntp.t new file mode 100644 index 00000000..82918ff5 --- /dev/null +++ b/t/nntp.t @@ -0,0 +1,64 @@ +# Copyright (C) 2015 all contributors <meta@public-inbox.org> +# License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt) +use strict; +use warnings; +use Test::More; +use Data::Dumper; + +use_ok 'PublicInbox::NNTP'; + +{ + sub quote_str { + my (undef, $s) = split(/ = /, Dumper($_[0]), 2); + $s =~ s/;\n//; + $s; + } + + sub wm_prepare { + my ($wm) = @_; + my $orig = qq{'$wm'}; + PublicInbox::NNTP::wildmat2re($_[0]); + my $new = quote_str($_[0]); + ($orig, $new); + } + + sub wildmat_like { + my ($str, $wm) = @_; + my ($orig, $new) = wm_prepare($wm); + like($str, $wm, "$orig matches '$str' using $new"); + } + + sub wildmat_unlike { + my ($str, $wm, $check_ex) = @_; + if ($check_ex) { + use re 'eval'; + my $re = qr/$wm/; + like($str, $re, "normal re with $wm matches, but ..."); + } + my ($orig, $new) = wm_prepare($wm); + unlike($str, $wm, "$orig does not match '$str' using $new"); + } + + wildmat_like('[foo]', '[\[foo\]]'); + wildmat_like('any', '*'); + wildmat_unlike('bar.foo.bar', 'foo.*'); + + # no code execution + wildmat_unlike('HI', '(?{"HI"})', 1); + wildmat_unlike('HI', '[(?{"HI"})]', 1); +} + +{ + sub ngpat_like { + my ($str, $pat) = @_; + my $orig = $pat; + PublicInbox::NNTP::ngpat2re($pat); + like($str, $pat, "'$orig' matches '$str' using $pat"); + } + + ngpat_like('any', '*'); + ngpat_like('a.s.r', 'a.t,a.s.r'); + ngpat_like('a.s.r', 'a.t,a.s.*'); +} + +done_testing(); |