X-Git-Url: http://www.git.stargrave.org/?a=blobdiff_plain;f=lib%2FPublicInbox%2FNNTP.pm;h=35729f003daecc99b12826df25456815b21f0c2e;hb=a65ebdc3a1f064bab0cddf64b34caad49f1c4c9c;hp=b80ab4a81c01da7f9f8e3f77f282a236dee6f8d1;hpb=207b89615a1a0c06dd9afc94ca2200b889dc35e1;p=public-inbox.git diff --git a/lib/PublicInbox/NNTP.pm b/lib/PublicInbox/NNTP.pm index b80ab4a8..35729f00 100644 --- a/lib/PublicInbox/NNTP.pm +++ b/lib/PublicInbox/NNTP.pm @@ -180,6 +180,22 @@ sub cmd_list ($;$$) { '.' } +sub listgroup_range_i { + my ($self, $beg, $end) = @_; + my $r = $self->{ng}->mm->msg_range($beg, $end, 'num'); + scalar(@$r) or return; + more($self, join("\r\n", map { $_->[0] } @$r)); + 1; +} + +sub listgroup_all_i { + my ($self, $num) = @_; + my $ary = $self->{ng}->mm->ids_after($num); + scalar(@$ary) or return; + more($self, join("\r\n", @$ary)); + 1; +} + sub cmd_listgroup ($;$$) { my ($self, $group, $range) = @_; if (defined $group) { @@ -187,26 +203,13 @@ sub cmd_listgroup ($;$$) { return $res if ($res !~ /\A211 /); more($self, $res); } - my $ng = $self->{ng} or return '412 no newsgroup selected'; - my $mm = $ng->mm; + $self->{ng} or return '412 no newsgroup selected'; if (defined $range) { my $r = get_range($self, $range); return $r unless ref $r; - my ($beg, $end) = @$r; - long_response($self, sub { - $r = $mm->msg_range($beg, $end, 'num'); - scalar(@$r) or return; - more($self, join("\r\n", map { $_->[0] } @$r)); - 1; - }); + long_response($self, \&listgroup_range_i, @$r); } else { # grab every article number - my $n = 0; - long_response($self, sub { - my $ary = $mm->ids_after(\$n); - scalar(@$ary) or return; - more($self, join("\r\n", @$ary)); - 1; - }); + long_response($self, \&listgroup_all_i, \(my $num = 0)); } } @@ -217,16 +220,17 @@ sub parse_time ($$;$) { $gmt =~ /\A(?:UTC|GMT)\z/i or die "GM invalid: $gmt"; $gmt = 1; } - my @now = $gmt ? gmtime : localtime; my ($YYYY, $MM, $DD); if (bytes::length($date) == 8) { # RFC 3977 allows YYYYMMDD ($YYYY, $MM, $DD) = unpack('A4A2A2', $date); } else { # legacy clients send YYMMDD - ($YYYY, $MM, $DD) = unpack('A2A2A2', $date); + my $YY; + ($YY, $MM, $DD) = unpack('A2A2A2', $date); + my @now = $gmt ? gmtime : localtime; my $cur_year = $now[5] + 1900; - if ($YYYY > $cur_year) { - $YYYY += int($cur_year / 1000) * 1000 - 100; - } + my $cur_cent = int($cur_year / 100) * 100; + $YYYY = (($YY + $cur_cent) > $cur_year) ? + ($YY + 1900) : ($YY + $cur_cent); } if ($gmt) { timegm($ss, $mm, $hh, $DD, $MM - 1, $YYYY); @@ -287,6 +291,26 @@ sub ngpat2re (;$) { $_[0] = qr/\A(?:$_[0])\z/; } +sub newnews_i { + my ($self, $overs, $ts, $prev) = @_; + my $over = $overs->[0]; + my $msgs = $over->query_ts($ts, $$prev); + if (scalar @$msgs) { + more($self, '<' . + join(">\r\n<", map { $_->mid } @$msgs ). + '>'); + $$prev = $msgs->[-1]->{num}; + } else { + shift @$overs; + if (@$overs) { # continue onto next newsgroup + $$prev = 0; + return 1; + } else { # break out of the long response. + return; + } + } +} + sub cmd_newnews ($$$$;$$) { my ($self, $newsgroups, $date, $time, $gmt, $dists) = @_; my $ts = eval { parse_time($date, $time, $gmt) }; @@ -295,34 +319,17 @@ sub cmd_newnews ($$$$;$$) { my ($keep, $skip) = split('!', $newsgroups, 2); ngpat2re($keep); ngpat2re($skip); - my @over; + my @overs; foreach my $ng (@{$self->{nntpd}->{grouplist}}) { $ng->{newsgroup} =~ $keep or next; $ng->{newsgroup} =~ $skip and next; my $over = $ng->over or next; - push @over, $over; + push @overs, $over; }; - return '.' unless @over; + return '.' unless @overs; my $prev = 0; - long_response($self, sub { - my $over = $over[0]; - my $msgs = $over->query_ts($ts, $prev); - if (scalar @$msgs) { - more($self, '<' . - join(">\r\n<", map { $_->mid } @$msgs ). - '>'); - $prev = $msgs->[-1]->{num}; - } else { - shift @over; - if (@over) { # continue onto next newsgroup - $prev = 0; - return 1; - } else { # break out of the long response. - return; - } - } - }); + long_response($self, \&newnews_i, \@overs, $ts, \$prev); } sub cmd_group ($$) { @@ -589,12 +596,11 @@ sub get_range ($$) { sub long_step { my ($self) = @_; # wbuf is unset or empty, here; {long} may add to it - my ($cb, $t0, @args) = @{$self->{long_cb}}; + my ($fd, $cb, $t0, @args) = @{$self->{long_cb}}; my $more = eval { $cb->($self, @args) }; if ($@ || !$self->{sock}) { # something bad happened... delete $self->{long_cb}; my $elapsed = now() - $t0; - my $fd = fileno($self->{sock}); if ($@) { err($self, "%s during long response[$fd] - %0.6f", @@ -610,20 +616,19 @@ sub long_step { # each other's data $self->zflush; - # no recursion, schedule another call ASAP - # but only after all pending writes are done - my $wbuf = $self->{wbuf} ||= []; - push @$wbuf, \&long_step; + # no recursion, schedule another call ASAP, but only after + # all pending writes are done. autovivify wbuf: + my $new_size = push(@{$self->{wbuf}}, \&long_step); # wbuf may be populated by $cb, no need to rearm if so: - $self->requeue if scalar(@$wbuf) == 1; + $self->requeue if $new_size == 1; } else { # all done! delete $self->{long_cb}; res($self, '.'); my $elapsed = now() - $t0; my $fd = fileno($self->{sock}); out($self, " deferred[$fd] done - %0.6f", $elapsed); - my $wbuf = $self->{wbuf}; + my $wbuf = $self->{wbuf}; # do NOT autovivify $self->requeue unless $wbuf && @$wbuf; } } @@ -631,15 +636,23 @@ sub long_step { sub long_response ($$;@) { my ($self, $cb, @args) = @_; # cb returns true if more, false if done - $self->{sock} or return; + my $sock = $self->{sock} or return; # make sure we disable reading during a long response, # clients should not be sending us stuff and making us do more # work while we are stream a response to them - $self->{long_cb} = [ $cb, now(), @args ]; + $self->{long_cb} = [ fileno($sock), $cb, now(), @args ]; long_step($self); # kick off! undef; } +sub hdr_msgid_range_i { + my ($self, $beg, $end) = @_; + my $r = $self->{ng}->mm->msg_range($beg, $end); + @$r or return; + more($self, join("\r\n", map { "$_->[0] <$_->[1]>" } @$r)); + 1; +} + sub hdr_message_id ($$$) { # optimize XHDR Message-ID [range] for slrnpull. my ($self, $xhdr, $range) = @_; @@ -651,17 +664,8 @@ sub hdr_message_id ($$$) { # optimize XHDR Message-ID [range] for slrnpull. $range = $self->{article} unless defined $range; my $r = get_range($self, $range); return $r unless ref $r; - my $mm = $self->{ng}->mm; - my ($beg, $end) = @$r; more($self, $xhdr ? r221 : r225); - long_response($self, sub { - my $r = $mm->msg_range($beg, $end); - @$r or return; - more($self, join("\r\n", map { - "$_->[0] <$_->[1]>" - } @$r)); - 1; - }); + long_response($self, \&hdr_msgid_range_i, @$r); } } @@ -717,6 +721,20 @@ sub over_header_for { $smsg->{$field}; } +sub searchmsg_range_i { + my ($self, $beg, $end, $field) = @_; + my $over = $self->{ng}->over; + my $msgs = $over->query_xover($$beg, $end); + scalar(@$msgs) or return; + my $tmp = ''; + foreach my $s (@$msgs) { + $tmp .= $s->{num} . ' ' . $s->$field . "\r\n"; + } + utf8::encode($tmp); + $self->msg_more($tmp); + $$beg = $msgs->[-1]->{num} + 1; +} + sub hdr_searchmsg ($$$$) { my ($self, $xhdr, $field, $range) = @_; if (defined $range && $range =~ /\A<(.+)>\z/) { # Message-ID @@ -726,24 +744,10 @@ sub hdr_searchmsg ($$$$) { hdr_mid_response($self, $xhdr, $ng, $n, $range, $v); } else { # numeric range $range = $self->{article} unless defined $range; - my $over = $self->{ng}->over; - my $mm = $self->{ng}->mm; my $r = get_range($self, $range); return $r unless ref $r; - my ($beg, $end) = @$r; more($self, $xhdr ? r221 : r225); - my $cur = $$beg; - long_response($self, sub { - my $msgs = $over->query_xover($cur, $end); - my $nr = scalar @$msgs or return; - my $tmp = ''; - foreach my $s (@$msgs) { - $tmp .= $s->{num} . ' ' . $s->$field . "\r\n"; - } - utf8::encode($tmp); - $self->msg_more($tmp); - $cur = $msgs->[-1]->{num} + 1; - }); + long_response($self, \&searchmsg_range_i, @$r, $field); } } @@ -803,6 +807,13 @@ sub hdr_mid_response ($$$$$$) { undef; } +sub xrover_i { + my ($self, $beg, $end) = @_; + my $h = over_header_for($self->{ng}->over, $$beg, 'references'); + more($self, "$$beg $h") if defined($h); + $$beg++ < $end; +} + sub cmd_xrover ($;$) { my ($self, $range) = @_; my $ng = $self->{ng} or return '412 no newsgroup selected'; @@ -812,16 +823,8 @@ sub cmd_xrover ($;$) { $range = $self->{article} unless defined $range; my $r = get_range($self, $range); return $r unless ref $r; - my ($beg, $end) = @$r; - my $mm = $ng->mm; - my $over = $ng->over; more($self, '224 Overview information follows'); - - long_response($self, sub { - my $h = over_header_for($over, $$beg, 'references'); - more($self, "$$beg $h") if defined($h); - $$beg++ < $end; - }); + long_response($self, \&xrover_i, @$r); } sub over_line ($$$$) { @@ -859,6 +862,19 @@ sub cmd_over ($;$) { } } +sub xover_i { + my ($self, $beg, $end) = @_; + my $ng = $self->{ng}; + my $msgs = $ng->over->query_xover($$beg, $end); + my $nr = scalar @$msgs or return; + + # OVERVIEW.FMT + more($self, join("\r\n", map { + over_line($self, $ng, $_->{num}, $_); + } @$msgs)); + $$beg = $msgs->[-1]->{num} + 1; +} + sub cmd_xover ($;$) { my ($self, $range) = @_; $range = $self->{article} unless defined $range; @@ -866,18 +882,7 @@ sub cmd_xover ($;$) { return $r unless ref $r; my ($beg, $end) = @$r; more($self, "224 Overview information follows for $$beg to $end"); - my $over = $self->{ng}->over; - my $cur = $$beg; - long_response($self, sub { - my $msgs = $over->query_xover($cur, $end); - my $nr = scalar @$msgs or return; - - # OVERVIEW.FMT - more($self, join("\r\n", map { - over_line($self, $self->{ng}, $_->{num}, $_); - } @$msgs)); - $cur = $msgs->[-1]->{num} + 1; - }); + long_response($self, \&xover_i, @$r); } sub compressed { undef }