]> Sergey Matveev's repositories - public-inbox.git/blobdiff - lib/PublicInbox/NNTP.pm
www: label sections and hopefully improve navigation
[public-inbox.git] / lib / PublicInbox / NNTP.pm
index ac536f71fb703d882fb9466760652df46e51f9b8..5b055bca0c9c9ef859e85fc7da4cef162668da67 100644 (file)
@@ -10,13 +10,11 @@ use fields qw(nntpd article rbuf ng long_res);
 use PublicInbox::Search;
 use PublicInbox::Msgmap;
 use PublicInbox::Git;
-use PublicInbox::MID qw(mid2path);
+require PublicInbox::EvCleanup;
 use Email::Simple;
 use POSIX qw(strftime);
 use Time::HiRes qw(clock_gettime CLOCK_MONOTONIC);
 use URI::Escape qw(uri_escape_utf8);
-use Encode qw(find_encoding);
-my $enc_utf8 = find_encoding('UTF-8');
 use constant {
        r501 => '501 command syntax error',
        r221 => '221 Header follows',
@@ -38,15 +36,13 @@ my $LIST_HEADERS = join("\r\n", @OVERVIEW,
 my %DISABLED; # = map { $_ => 1 } qw(xover list_overview_fmt newnews xhdr);
 
 my $EXPMAP; # fd -> [ idle_time, $self ]
-my $EXPTIMER;
+my $expt;
 our $EXPTIME = 180; # 3 minutes
-my $WEAKEN = {}; # string(nntpd) -> nntpd
-my $WEAKTIMER;
+my $nextt;
 
-my $next_tick;
 my $nextq = [];
 sub next_tick () {
-       $next_tick = undef;
+       $nextt = undef;
        my $q = $nextq;
        $nextq = [];
        foreach my $nntp (@$q) {
@@ -62,26 +58,14 @@ sub next_tick () {
 
 sub update_idle_time ($) {
        my ($self) = @_;
-       my $tmp = $self->{sock} or return;
-       $tmp = fileno($tmp);
-       defined $tmp and $EXPMAP->{$tmp} = [ now(), $self ];
-}
-
-# reduce FD pressure by closing some "git cat-file --batch" processes
-# and unused FDs for msgmap and Xapian indices
-sub weaken_groups () {
-       $WEAKTIMER = undef;
-       foreach my $nntpd (values %$WEAKEN) {
-               $_->weaken_all foreach (@{$nntpd->{grouplist}});
-       }
-       $WEAKEN = {};
+       my $fd = $self->{fd};
+       defined $fd and $EXPMAP->{$fd} = [ now(), $self ];
 }
 
 sub expire_old () {
        my $now = now();
        my $exp = $EXPTIME;
        my $old = $now - $exp;
-       my $next = $now + $exp;
        my $nr = 0;
        my %new;
        while (my ($fd, $v) = each %$EXPMAP) {
@@ -89,26 +73,18 @@ sub expire_old () {
                if ($idle_time < $old) {
                        $nntp->close; # idempotent
                } else {
-                       my $nexp = $idle_time + $exp;
-                       $next = $nexp if ($nexp < $next);
                        ++$nr;
                        $new{$fd} = $v;
                }
        }
        $EXPMAP = \%new;
        if ($nr) {
-               $next -= $now;
-               $next = 0 if $next < 0;
-               $EXPTIMER = Danga::Socket->AddTimer($next, *expire_old);
-               weaken_groups();
+               $expt = PublicInbox::EvCleanup::later(*expire_old);
        } else {
-               $EXPTIMER = undef;
+               $expt = undef;
                # noop to kick outselves out of the loop ASAP so descriptors
                # really get closed
-               Danga::Socket->AddTimer(0, sub {});
-
-               # grace period for reaping resources
-               $WEAKTIMER ||= Danga::Socket->AddTimer(30, *weaken_groups);
+               PublicInbox::EvCleanup::asap(sub {});
        }
 }
 
@@ -121,8 +97,7 @@ sub new ($$$) {
        $self->{rbuf} = '';
        $self->watch_read(1);
        update_idle_time($self);
-       $WEAKEN->{"$nntpd"} = $nntpd;
-       $EXPTIMER ||= Danga::Socket->AddTimer($EXPTIME, *expire_old);
+       $expt ||= PublicInbox::EvCleanup::later(*expire_old);
        $self;
 }
 
@@ -199,7 +174,7 @@ sub list_active_times ($;$) {
        foreach my $ng (@{$self->{nntpd}->{grouplist}}) {
                $ng->{newsgroup} =~ $wildmat or next;
                my $c = eval { $ng->mm->created_at } || time;
-               more($self, "$ng->{newsgroup} $c $ng->{address}");
+               more($self, "$ng->{newsgroup} $c $ng->{-primary_address}");
        }
 }
 
@@ -417,7 +392,8 @@ sub cmd_last ($) { article_adj($_[0], -1) }
 sub cmd_post ($) {
        my ($self) = @_;
        my $ng = $self->{ng};
-       $ng ? "440 mailto:$ng->{address} to post" : '440 posting not allowed'
+       $ng ? "440 mailto:$ng->{-primary_address} to post"
+               : '440 posting not allowed'
 }
 
 sub cmd_quit ($) {
@@ -442,8 +418,8 @@ sub set_nntp_headers {
        # clobber some
        $hdr->header_set('Newsgroups', $ng->{newsgroup});
        $hdr->header_set('Xref', xref($ng, $n));
-       header_append($hdr, 'List-Post', "<mailto:$ng->{address}>");
-       if (my $url = $ng->{url}) {
+       header_append($hdr, 'List-Post', "<mailto:$ng->{-primary_address}>");
+       if (my $url = $ng->base_url) {
                $mid = uri_escape_utf8($mid);
                header_append($hdr, 'Archived-At', "<$url$mid/>");
                header_append($hdr, 'List-Archive', "<$url>");
@@ -486,10 +462,9 @@ find_mid:
                defined $mid or return $err;
        }
 found:
-       my $o = 'HEAD:' . mid2path($mid);
        my $bytes;
-       my $s = eval { Email::Simple->new($ng->gcf->cat_file($o, \$bytes)) };
-       return $err unless $s;
+       my $s = eval { $ng->msg_by_mid($mid, \$bytes) } or return $err;
+       $s = Email::Simple->new($s);
        my $lines;
        if ($set_headers) {
                set_nntp_headers($s->header_obj, $ng, $n, $mid);
@@ -517,6 +492,12 @@ sub set_art {
        $self->{article} = $art if defined $art && $art =~ /\A\d+\z/;
 }
 
+sub _header ($) {
+       my $hdr = $_[0]->header_obj->as_string;
+       utf8::encode($hdr);
+       $hdr
+}
+
 sub cmd_article ($;$) {
        my ($self, $art) = @_;
        my $r = art_lookup($self, $art, 1);
@@ -524,7 +505,7 @@ sub cmd_article ($;$) {
        my ($n, $mid, $s) = @$r;
        set_art($self, $art);
        more($self, "220 $n <$mid> article retrieved - head and body follow");
-       do_more($self, $s->header_obj->as_string);
+       do_more($self, _header($s));
        do_more($self, "\r\n");
        simple_body_write($self, $s);
 }
@@ -536,7 +517,7 @@ sub cmd_head ($;$) {
        my ($n, $mid, $s) = @$r;
        set_art($self, $art);
        more($self, "221 $n <$mid> article retrieved - head follows");
-       do_more($self, $s->header_obj->as_string);
+       do_more($self, _header($s));
        '.'
 }
 
@@ -633,7 +614,7 @@ sub long_response ($$$$) {
                        update_idle_time($self);
 
                        push @$nextq, $self;
-                       $next_tick ||= Danga::Socket->AddTimer(0, *next_tick);
+                       $nextt ||= PublicInbox::EvCleanup::asap(*next_tick);
                } else { # all done!
                        $self->{long_res} = undef;
                        $self->watch_read(1);
@@ -712,8 +693,7 @@ sub hdr_xref ($$$) { # optimize XHDR Xref [range] for rtin
 
 sub search_header_for {
        my ($srch, $mid, $field) = @_;
-       my $smsg = $srch->lookup_message($mid) or return;
-       $smsg = PublicInbox::SearchMsg->load_doc($smsg->{doc});
+       my $smsg = $srch->lookup_mail($mid) or return;
        $smsg->$field;
 }
 
@@ -743,6 +723,7 @@ sub hdr_searchmsg ($$$$) {
                        foreach my $s (@$msgs) {
                                $tmp .= $s->num . ' ' . $s->$field . "\r\n";
                        }
+                       utf8::encode($tmp);
                        do_more($self, $tmp);
                        # -1 to adjust for implicit increment in long_response
                        $$i = $nr ? $$i + $nr - 1 : long_response_limit;
@@ -831,7 +812,7 @@ sub over_line ($$) {
        my ($num, $smsg) = @_;
        # n.b. field access and procedural calls can be
        # 10%-15% faster than OO method calls:
-       join("\t", $num,
+       my $s = join("\t", $num,
                $smsg->{subject},
                $smsg->{from},
                PublicInbox::SearchMsg::date($smsg),
@@ -839,16 +820,17 @@ sub over_line ($$) {
                $smsg->{references},
                PublicInbox::SearchMsg::bytes($smsg),
                PublicInbox::SearchMsg::lines($smsg));
+       utf8::encode($s);
+       $s
 }
 
 sub cmd_over ($;$) {
        my ($self, $range) = @_;
        if ($range && $range =~ /\A<(.+)>\z/) {
                my ($ng, $n) = mid_lookup($self, $1);
-               my $smsg = $ng->search->lookup_message($range) or
+               my $smsg = $ng->search->lookup_mail($range) or
                        return '430 No article with that message-id';
                more($self, '224 Overview information follows (multi-line)');
-               $smsg = PublicInbox::SearchMsg->load_doc($smsg->{doc});
 
                # Only set article number column if it's the current group
                my $self_ng = $self->{ng};
@@ -901,7 +883,6 @@ sub cmd_xpath ($$) {
 
 sub res ($$) {
        my ($self, $line) = @_;
-       $line = $enc_utf8->encode($line);
        do_write($self, $line . "\r\n");
 }
 
@@ -913,7 +894,7 @@ sub more ($$) {
 sub do_write ($$) {
        my ($self, $data) = @_;
        my $done = $self->write($data);
-       die if $self->{closed};
+       return if $self->{closed};
 
        # Do not watch for readability if we have data in the queue,
        # instead re-enable watching for readability when we can
@@ -936,7 +917,6 @@ use constant MSG_MORE => ($^O eq 'linux') ? 0x8000 : 0;
 
 sub do_more ($$) {
        my ($self, $data) = @_;
-       $data = $enc_utf8->encode($data);
        if (MSG_MORE && !$self->{write_buf_size}) {
                my $n = send($self->{sock}, $data, MSG_MORE);
                if (defined $n) {
@@ -996,15 +976,24 @@ sub watch_read {
                # in case we really did dispatch a read event and started
                # another long response.
                push @$nextq, $self;
-               $next_tick ||= Danga::Socket->AddTimer(0, *next_tick);
+               $nextt ||= PublicInbox::EvCleanup::asap(*next_tick);
        }
        $rv;
 }
 
+sub not_idle_long ($$) {
+       my ($self, $now) = @_;
+       defined(my $fd = $self->{fd}) or return;
+       my $ary = $EXPMAP->{$fd} or return;
+       my $exp_at = $ary->[0] + $EXPTIME;
+       $exp_at > $now;
+}
+
 # for graceful shutdown in PublicInbox::Daemon:
-sub busy () {
-       my ($self) = @_;
-       ($self->{rbuf} ne '' || $self->{long_res} || $self->{write_buf_size});
+sub busy {
+       my ($self, $now) = @_;
+       ($self->{rbuf} ne '' || $self->{long_res} || $self->{write_buf_size} ||
+        not_idle_long($self, $now));
 }
 
 1;