nntp: ensure body lines end with CRLF

[public-inbox.git] / lib / PublicInbox / NNTP.pm

diff --git a/lib/PublicInbox/NNTP.pm b/lib/PublicInbox/NNTP.pm
index 79f2c2f8e3edc5b191c57c7e7f38018b349c6d53..71b774d224bc03396e2ec582448fb6cddac36e76 100644 (file)
--- a/lib/PublicInbox/NNTP.pm
+++ b/lib/PublicInbox/NNTP.pm
@@ -8,7 +8,7 @@ use fields qw(nntpd article rbuf ng long_res);
 use PublicInbox::Msgmap;
 use PublicInbox::GitCatFile;
 use PublicInbox::MID qw(mid2path);
-use Email::Simple;
+use Email::MIME;
 use Data::Dumper qw(Dumper);
 use POSIX qw(strftime);
 use Time::HiRes qw(clock_gettime ualarm CLOCK_MONOTONIC);
@@ -29,6 +29,7 @@ my %DISABLED; # = map { $_ => 1 } qw(xover list_overview_fmt newnews xhdr);
 sub new ($$$) {
        my ($class, $sock, $nntpd) = @_;
        my $self = fields::new($class);
+       binmode $sock, ':utf8'; # RFC 3977
        $self->SUPER::new($sock);
        $self->{nntpd} = $nntpd;
        res($self, '201 server ready - post via email');
@@ -168,22 +169,26 @@ sub cmd_listgroup ($;$) {
 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;
+       my ($YYYY, $MM, $DD);
+       if (length($date) == 8) { # RFC 3977 allows YYYYMMDD
+               ($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;
+                       $YYYY += int($cur_year / 1000) * 1000 - 100;
+               }
        }
-
        if ($gmt) {
-               Time::Local::timegm($ss, $mm, $hh, $DD, $MM - 1, $YY);
+               Time::Local::timegm($ss, $mm, $hh, $DD, $MM - 1, $YYYY);
        } else {
-               Time::Local::timelocal($ss, $mm, $hh, $DD, $MM - 1, $YY);
+               Time::Local::timelocal($ss, $mm, $hh, $DD, $MM - 1, $YYYY);
        }
 }
 
@@ -366,16 +371,17 @@ find_mid:
        }
 found:
        my $o = 'HEAD:' . mid2path($mid);
-       my $s = eval { Email::Simple->new($ng->gcf->cat_file($o)) };
+       my $bytes;
+       my $s = eval { Email::MIME->new($ng->gcf->cat_file($o, \$bytes)) };
        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");
+               $s->header_set('Xref', xref($ng, $n));
 
                # must be last
                if ($set_headers == 2) {
-                       $s->header_set('Bytes', bytes::length($s->as_string));
+                       $s->header_set('Bytes', $bytes);
                        $s->body_set('');
                }
        }
@@ -387,7 +393,9 @@ sub simple_body_write ($$) {
        my $body = $s->body;
        $s->body_set('');
        $body =~ s/^\./../smg;
+       $body =~ s/(?<!\r)\n/\r\n/sg;
        do_more($self, $body);
+       do_more($self, "\r\n") unless $body =~ /\r\n\z/s;
        '.'
 }
 
@@ -562,6 +570,35 @@ sub xhdr_message_id ($$) { # optimize XHDR Message-ID [range] for slrnpull.
        }
 }
 
+sub xref ($$) {
+       my ($ng, $n) = @_;
+       "$ng->{domain} $ng->{name}:$n"
+}
+
+sub xhdr_xref ($$) { # optimize XHDR Xref [range] for rtin
+       my ($self, $range) = @_;
+
+       my $ng = $self->{ng};
+       my $mm = $ng->mm;
+       if (defined $range && $range =~ /\A<(.+)>\z/) { # Message-ID
+               my $n = $mm->num_for($range);
+               more($self, '221 Header follows');
+               more($self, "<$range> ".xref($ng, $n)) if defined $n;
+               '.';
+       } else { # numeric range
+               $range = $self->{article} unless defined $range;
+               my $r = get_range($self, $range);
+               return $r unless ref $r;
+               my ($beg, $end) = @$r;
+               more($self, '221 Header follows');
+               $self->long_response($beg, $end, sub {
+                       my ($i) = @_;
+                       my $mid = $mm->mid_for($$i);
+                       more($self, "$$i ".xref($ng, $$i)) if defined $mid;
+               });
+       }
+}
+
 sub header_obj_for {
        my ($srch, $mid) = @_;
        eval {
@@ -612,6 +649,8 @@ sub cmd_xhdr ($$;$) {
        my $sub = lc $header;
        if ($sub eq 'message-id') {
                xhdr_message_id($self, $range);
+       } elsif ($sub eq 'xref') {
+               xhdr_xref($self, $range);
        } elsif ($sub =~ /\A(subject|references|date)\z/ && $ng->search) {
                xhdr_searchmsg($self, $sub, $range);
        } else {
@@ -739,9 +778,9 @@ sub do_more ($$) {
        if (MSG_MORE && !$self->{write_buf_size}) {
                my $n = send($self->{sock}, $data, MSG_MORE);
                if (defined $n) {
-                       my $dlen = bytes::length($data);
+                       my $dlen = length($data);
                        return 1 if $n == $dlen; # all done!
-                       $data = bytes::substr($data, $n, $dlen - $n);
+                       $data = substr($data, $n, $dlen - $n);
                }
        }
        $self->do_write($data);
@@ -781,7 +820,7 @@ again:
        }
 
        return $self->close if $r < 0;
-       my $len = bytes::length($self->{rbuf});
+       my $len = length($self->{rbuf});
        return $self->close if ($len >= LINE_MAX);
 }