X-Git-Url: http://www.git.stargrave.org/?a=blobdiff_plain;f=lib%2FPublicInbox%2FNNTP.pm;h=23be7754445b01686a6df0e209ef539cd285553b;hb=4f0b09919ae9c8823bf6c1fa1452bc27945952a3;hp=0b30d43a174562328df2a78d767c6c3d6b18f0d1;hpb=8e85257577ee4d7d49e59f048852d9d4ac6f8172;p=public-inbox.git

diff --git a/lib/PublicInbox/NNTP.pm b/lib/PublicInbox/NNTP.pm
index 0b30d43a..23be7754 100644
--- a/lib/PublicInbox/NNTP.pm
+++ b/lib/PublicInbox/NNTP.pm
@@ -1,5 +1,5 @@
-# Copyright (C) 2015 all contributors <meta@public-inbox.org>
-# License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
+# Copyright (C) 2015-2018 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
 package PublicInbox::NNTP;
@@ -9,12 +9,14 @@ use base qw(Danga::Socket);
 use fields qw(nntpd article rbuf ng long_res);
 use PublicInbox::Search;
 use PublicInbox::Msgmap;
+use PublicInbox::MID qw(mid_escape);
 use PublicInbox::Git;
 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 Digest::SHA qw(sha1_hex);
+use Time::Local qw(timegm timelocal);
 use constant {
 	r501 => '501 command syntax error',
 	r221 => '221 Header follows',
@@ -125,6 +127,7 @@ sub process_line ($$) {
 	my $res = eval { $req->($self, @args) };
 	my $err = $@;
 	if ($err && !$self->{closed}) {
+		local $/ = "\n";
 		chomp($l);
 		err($self, 'error from: %s (%s)', $l, $err);
 		$res = '503 program fault - command not performed';
@@ -236,7 +239,6 @@ sub cmd_listgroup ($;$) {
 
 sub parse_time ($$;$) {
 	my ($date, $time, $gmt) = @_;
-	use Time::Local qw();
 	my ($hh, $mm, $ss) = unpack('A2A2A2', $time);
 	if (defined $gmt) {
 		$gmt =~ /\A(?:UTC|GMT)\z/i or die "GM invalid: $gmt";
@@ -248,15 +250,15 @@ sub parse_time ($$;$) {
 		($YYYY, $MM, $DD) = unpack('A4A2A2', $date);
 	} else { # legacy clients send YYMMDD
 		($YYYY, $MM, $DD) = unpack('A2A2A2', $date);
-		if ($YYYY > strftime('%y', @now)) {
-			my $cur_year = $now[5] + 1900;
+		my $cur_year = $now[5] + 1900;
+		if ($YYYY > $cur_year) {
 			$YYYY += int($cur_year / 1000) * 1000 - 100;
 		}
 	}
 	if ($gmt) {
-		Time::Local::timegm($ss, $mm, $hh, $DD, $MM - 1, $YYYY);
+		timegm($ss, $mm, $hh, $DD, $MM - 1, $YYYY);
 	} else {
-		Time::Local::timelocal($ss, $mm, $hh, $DD, $MM - 1, $YYYY);
+		timelocal($ss, $mm, $hh, $DD, $MM - 1, $YYYY);
 	}
 }
 
@@ -285,7 +287,6 @@ 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#(?<!\\)\[(.+)(?<!\\)\]#
@@ -335,7 +336,7 @@ sub cmd_newnews ($$$$;$$) {
 	long_response($self, 0, long_response_limit, sub {
 		my ($i) = @_;
 		my $srch = $srch[0];
-		my $res = $srch->query($ts, $opts);
+		my $res = $srch->query_ts($ts, $opts);
 		my $msgs = $res->{msgs};
 		if (my $nr = scalar @$msgs) {
 			more($self, '<' .
@@ -420,7 +421,7 @@ sub set_nntp_headers {
 	$hdr->header_set('Xref', xref($ng, $n));
 	header_append($hdr, 'List-Post', "<mailto:$ng->{-primary_address}>");
 	if (my $url = $ng->base_url) {
-		$mid = uri_escape_utf8($mid);
+		$mid = mid_escape($mid);
 		header_append($hdr, 'Archived-At', "<$url$mid/>");
 		header_append($hdr, 'List-Archive', "<$url>");
 	}
@@ -589,9 +590,10 @@ sub long_response ($$$$) {
 
 		my $err;
 		do {
-			eval { $cb->(\$beg) };
+			eval { $cb->(\$beg, \$lim) };
 		} until (($err = $@) || $self->{closed} ||
-			 ++$beg > $end || !--$lim || $self->{write_buf_size});
+			 ++$beg > $end || --$lim < 0 ||
+			 $self->{write_buf_size});
 
 		if ($err || $self->{closed}) {
 			$self->{long_res} = undef;
@@ -608,7 +610,7 @@ sub long_response ($$$$) {
 				update_idle_time($self);
 				$self->watch_read(1);
 			}
-		} elsif (!$lim || $self->{write_buf_size}) {
+		} elsif ($lim < 0 || $self->{write_buf_size}) {
 			# no recursion, schedule another call ASAP
 			# but only after all pending writes are done
 			update_idle_time($self);
@@ -714,11 +716,12 @@ sub hdr_searchmsg ($$$$) {
 		more($self, $xhdr ? r221 : r225);
 		my $off = 0;
 		long_response($self, $beg, $end, sub {
-			my ($i) = @_;
+			my ($i, $lim) = @_;
 			my $res = $srch->query_xover($beg, $end, $off);
 			my $msgs = $res->{msgs};
 			my $nr = scalar @$msgs or return;
 			$off += $nr;
+			$$lim -= $nr;
 			my $tmp = '';
 			foreach my $s (@$msgs) {
 				$tmp .= $s->num . ' ' . $s->$field . "\r\n";
@@ -852,11 +855,12 @@ sub cmd_xover ($;$) {
 	my $srch = $self->{ng}->search;
 	my $off = 0;
 	long_response($self, $beg, $end, sub {
-		my ($i) = @_;
+		my ($i, $lim) = @_;
 		my $res = $srch->query_xover($beg, $end, $off);
 		my $msgs = $res->{msgs};
 		my $nr = scalar @$msgs or return;
 		$off += $nr;
+		$$lim -= $nr;
 
 		# OVERVIEW.FMT
 		more($self, join("\r\n", map {
@@ -894,7 +898,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
@@ -945,10 +949,12 @@ sub event_write {
 sub event_read {
 	my ($self) = @_;
 	use constant LINE_MAX => 512; # RFC 977 section 2.3
-	my $r = 1;
 
-	my $buf = $self->read(LINE_MAX) or return $self->close;
-	$self->{rbuf} .= $$buf;
+	if (index($self->{rbuf}, "\n") < 0) {
+		my $buf = $self->read(LINE_MAX) or return $self->close;
+		$self->{rbuf} .= $$buf;
+	}
+	my $r = 1;
 	while ($r > 0 && $self->{rbuf} =~ s/\A\s*([^\r\n]+)\r?\n//) {
 		my $line = $1;
 		return $self->close if $line =~ /[[:cntrl:]]/s;