]> Sergey Matveev's repositories - public-inbox.git/blobdiff - lib/PublicInbox/NNTP.pm
switch read-only Email::Simple users to Eml
[public-inbox.git] / lib / PublicInbox / NNTP.pm
index 84335d30c131f745c4a1a8143b6567696fd574aa..54207500dd8db5576658ae993169efd10318fdc5 100644 (file)
@@ -7,8 +7,8 @@ use strict;
 use warnings;
 use base qw(PublicInbox::DS);
 use fields qw(nntpd article ng long_cb);
-use PublicInbox::MID qw(mid_escape);
-use Email::Simple;
+use PublicInbox::MID qw(mid_escape $MID_EXTRACT);
+use PublicInbox::Eml;
 use POSIX qw(strftime);
 use PublicInbox::DS qw(now);
 use Digest::SHA qw(sha1_hex);
@@ -24,7 +24,7 @@ use constant {
 };
 use PublicInbox::Syscall qw(EPOLLIN EPOLLONESHOT);
 use Errno qw(EAGAIN);
-
+my $ONE_MSGID = qr/\A$MID_EXTRACT\z/;
 my @OVERVIEW = qw(Subject From Date Message-ID References);
 my $OVERVIEW_FMT = join(":\r\n", @OVERVIEW, qw(Bytes Lines), '') .
                "Xref:full\r\n";
@@ -38,8 +38,7 @@ NEWNEWS\r
 LIST ACTIVE ACTIVE.TIMES NEWSGROUPS OVERVIEW.FMT\r
 HDR\r
 OVER\r
-
-my $have_deflate;
+COMPRESS DEFLATE\r
 
 sub greet ($) { $_[0]->write($_[0]->{nntpd}->{greet}) };
 
@@ -76,7 +75,7 @@ sub args_ok ($$) {
 # 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(/[ \t]/, $l);
+       my ($req, @args) = split(/[ \t]+/, $l);
        return 1 unless defined($req); # skip blank line
        $req = $self->can('cmd_'.lc($req));
        return res($self, '500 command not recognized') unless $req;
@@ -384,7 +383,7 @@ sub cmd_quit ($) {
 
 sub header_append ($$$) {
        my ($hdr, $k, $v) = @_;
-       my @v = $hdr->header($k);
+       my @v = $hdr->header_raw($k);
        foreach (@v) {
                return if $v eq $_;
        }
@@ -417,11 +416,11 @@ sub set_nntp_headers ($$$$$) {
        # leafnode (and maybe other NNTP clients) have trouble dealing
        # with v2 messages which have multiple Message-IDs (either due
        # to our own content-based dedupe or buggy git-send-email versions).
-       my @mids = $hdr->header('Message-ID');
+       my @mids = $hdr->header_raw('Message-ID');
        if (scalar(@mids) > 1) {
                my $mid0 = "<$mid>";
                $hdr->header_set('Message-ID', $mid0);
-               my @alt = $hdr->header('X-Alt-Message-ID');
+               my @alt = $hdr->header_raw('X-Alt-Message-ID');
                my %seen = map { $_ => 1 } (@alt, $mid0);
                push(@alt, grep { !$seen{$_}++ } @mids);
                $hdr->header_set('X-Alt-Message-ID', @alt);
@@ -450,7 +449,7 @@ sub art_lookup ($$$) {
                        $err = '423 no such article number in this group';
                        $n = int($art);
                        goto find_mid;
-               } elsif ($art =~ /\A<([^>]+)>\z/) {
+               } elsif ($art =~ $ONE_MSGID) {
                        $mid = $1;
                        $err = r430;
                        $n = $ng->mm->num_for($mid) if $ng;
@@ -479,10 +478,9 @@ found:
        my $smsg = $ng->over->get_art($n) or return $err;
        my $msg = $ng->msg_by_smsg($smsg) or return $err;
 
-       # Email::Simple->new will modify $msg in-place as documented
-       # in its manpage, so what's left is the body and we won't need
-       # to call Email::Simple::body(), later
-       my $hdr = Email::Simple->new($msg)->header_obj;
+       # PublicInbox::Eml->new will modify $msg in-place, so what's
+       # left is the body and we won't need to call ->body(), later
+       my $hdr = PublicInbox::Eml->new($msg)->header_obj;
        set_nntp_headers($self, $hdr, $ng, $n, $mid) if $set_headers;
        [ $n, $mid, $msg, $hdr ];
 }
@@ -506,13 +504,13 @@ sub set_art {
 sub msg_hdr_write ($$$) {
        my ($self, $hdr, $body_follows) = @_;
        $hdr = $hdr->as_string;
+       # fixup old bug from import (pre-a0c07cba0e5d8b6a)
+       $hdr =~ s/\A[\r\n]*From [^\r\n]*\r?\n//s;
        utf8::encode($hdr);
        $hdr =~ s/(?<!\r)\n/\r\n/sg; # Alpine barfs without this
 
        # for leafnode compatibility, we need to ensure Message-ID headers
-       # are only a single line.  We can't subclass Email::Simple::Header
-       # and override _default_fold_at in here, either; since that won't
-       # affect messages already in the archive.
+       # are only a single line.
        $hdr =~ s/^(Message-ID:)[ \t]*\r\n[ \t]+([^\r]+)\r\n/$1 $2\r\n/igsm;
        $hdr .= "\r\n" if $body_follows;
        $self->msg_more($hdr);
@@ -653,7 +651,7 @@ sub hdr_msgid_range_i {
 sub hdr_message_id ($$$) { # optimize XHDR Message-ID [range] for slrnpull.
        my ($self, $xhdr, $range) = @_;
 
-       if (defined $range && $range =~ /\A<(.+)>\z/) { # Message-ID
+       if (defined $range && $range =~ $ONE_MSGID) {
                my ($ng, $n) = mid_lookup($self, $1);
                return r430 unless $n;
                hdr_mid_response($self, $xhdr, $ng, $n, $range, $range);
@@ -696,7 +694,7 @@ sub xref_range_i {
 sub hdr_xref ($$$) { # optimize XHDR Xref [range] for rtin
        my ($self, $xhdr, $range) = @_;
 
-       if (defined $range && $range =~ /\A<(.+)>\z/) { # Message-ID
+       if (defined $range && $range =~ $ONE_MSGID) {
                my $mid = $1;
                my ($ng, $n) = mid_lookup($self, $mid);
                return r430 unless $n;
@@ -714,11 +712,11 @@ sub hdr_xref ($$$) { # optimize XHDR Xref [range] for rtin
 sub over_header_for {
        my ($over, $num, $field) = @_;
        my $smsg = $over->get_art($num) or return;
-       return PublicInbox::SearchMsg::date($smsg) if $field eq 'date';
+       return PublicInbox::Smsg::date($smsg) if $field eq 'date';
        $smsg->{$field};
 }
 
-sub searchmsg_range_i {
+sub smsg_range_i {
        my ($self, $beg, $end, $field) = @_;
        my $over = $self->{ng}->over;
        my $msgs = $over->query_xover($$beg, $end);
@@ -732,9 +730,9 @@ sub searchmsg_range_i {
        $$beg = $msgs->[-1]->{num} + 1;
 }
 
-sub hdr_searchmsg ($$$$) {
+sub hdr_smsg ($$$$) {
        my ($self, $xhdr, $field, $range) = @_;
-       if (defined $range && $range =~ /\A<(.+)>\z/) { # Message-ID
+       if (defined $range && $range =~ $ONE_MSGID) {
                my ($ng, $n) = mid_lookup($self, $1);
                return r430 unless defined $n;
                my $v = over_header_for($ng->over, $n, $field);
@@ -744,7 +742,7 @@ sub hdr_searchmsg ($$$$) {
                my $r = get_range($self, $range);
                return $r unless ref $r;
                more($self, $xhdr ? r221 : r225);
-               long_response($self, \&searchmsg_range_i, @$r, $field);
+               long_response($self, \&smsg_range_i, @$r, $field);
        }
 }
 
@@ -757,9 +755,9 @@ sub do_hdr ($$$;$) {
                hdr_xref($self, $xhdr, $range);
        } elsif ($sub =~ /\A(?:subject|references|date|from|to|cc|
                                bytes|lines)\z/x) {
-               hdr_searchmsg($self, $xhdr, $sub, $range);
+               hdr_smsg($self, $xhdr, $sub, $range);
        } elsif ($sub =~ /\A:(bytes|lines)\z/) {
-               hdr_searchmsg($self, $xhdr, $1, $range);
+               hdr_smsg($self, $xhdr, $1, $range);
        } else {
                $xhdr ? (r221 . "\r\n.") : "503 HDR not permitted on $header";
        }
@@ -831,7 +829,7 @@ sub over_line ($$$$) {
        my $s = join("\t", $num,
                $smsg->{subject},
                $smsg->{from},
-               PublicInbox::SearchMsg::date($smsg),
+               PublicInbox::Smsg::date($smsg),
                "<$smsg->{mid}>",
                $smsg->{references},
                $smsg->{bytes},
@@ -843,7 +841,7 @@ sub over_line ($$$$) {
 
 sub cmd_over ($;$) {
        my ($self, $range) = @_;
-       if ($range && $range =~ /\A<(.+)>\z/) {
+       if ($range && $range =~ $ONE_MSGID) {
                my ($ng, $n) = mid_lookup($self, $1);
                defined $n or return r430;
                my $smsg = $ng->over->get_art($n) or return r430;
@@ -901,7 +899,7 @@ sub cmd_starttls ($) {
 sub cmd_compress ($$) {
        my ($self, $alg) = @_;
        return '503 Only DEFLATE is supported' if uc($alg) ne 'DEFLATE';
-       return r502 if $self->compressed || !$have_deflate;
+       return r502 if $self->compressed;
        PublicInbox::NNTPdeflate->enable($self);
        $self->requeue;
        undef
@@ -911,7 +909,7 @@ sub zflush {} # overridden by NNTPdeflate
 
 sub cmd_xpath ($$) {
        my ($self, $mid) = @_;
-       return r501 unless $mid =~ /\A<(.+)>\z/;
+       return r501 unless $mid =~ $ONE_MSGID;
        $mid = $1;
        my @paths;
        foreach my $ng (values %{$self->{nntpd}->{groups}}) {
@@ -988,10 +986,4 @@ sub busy {
        ($self->{rbuf} || $self->{wbuf} || $self->not_idle_long($now));
 }
 
-# this is an import to prevent "perl -c" from complaining about fields
-sub import {
-       $have_deflate = eval { require PublicInbox::NNTPdeflate } and
-               $CAPABILITIES .= "COMPRESS DEFLATE\r\n";
-}
-
 1;