nntp: proper UTF-8 support (hopefully?)

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

diff --git a/lib/PublicInbox/NNTP.pm b/lib/PublicInbox/NNTP.pm
index 8f8668591e51ce0e0ffce62f9caa28fb3a1bd223..91b10f20ac39894a561ecb313cc938a36b3e3c2b 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');
@@ -93,7 +94,7 @@ sub list_overview_fmt ($$) {
 sub list_active ($;$) {
        my ($self, $wildmat) = @_;
        wildmat2re($wildmat);
-       foreach my $ng (values %{$self->{nntpd}->{groups}}) {
+       foreach my $ng (@{$self->{nntpd}->{grouplist}}) {
                $ng->{name} =~ $wildmat or next;
                group_line($self, $ng);
        }
@@ -102,7 +103,7 @@ sub list_active ($;$) {
 sub list_active_times ($;$) {
        my ($self, $wildmat) = @_;
        wildmat2re($wildmat);
-       foreach my $ng (values %{$self->{nntpd}->{groups}}) {
+       foreach my $ng (@{$self->{nntpd}->{grouplist}}) {
                $ng->{name} =~ $wildmat or next;
                my $c = eval { $ng->mm->created_at } || time;
                more($self, "$ng->{name} $c $ng->{address}");
@@ -112,7 +113,7 @@ sub list_active_times ($;$) {
 sub list_newsgroups ($;$) {
        my ($self, $wildmat) = @_;
        wildmat2re($wildmat);
-       foreach my $ng (values %{$self->{nntpd}->{groups}}) {
+       foreach my $ng (@{$self->{nntpd}->{grouplist}}) {
                $ng->{name} =~ $wildmat or next;
                my $d = $ng->description;
                more($self, "$ng->{name} $d");
@@ -137,7 +138,7 @@ sub cmd_list ($;$$) {
                $arg->($self, @args);
        } else {
                more($self, '215 list of newsgroups follows');
-               foreach my $ng (values %{$self->{nntpd}->{groups}}) {
+               foreach my $ng (@{$self->{nntpd}->{grouplist}}) {
                        group_line($self, $ng);
                }
        }
@@ -200,7 +201,7 @@ sub cmd_newgroups ($$$;$$) {
 
        # TODO dists
        more($self, '231 list of new newsgroups follows');
-       foreach my $ng (values %{$self->{nntpd}->{groups}}) {
+       foreach my $ng (@{$self->{nntpd}->{grouplist}}) {
                my $c = eval { $ng->mm->created_at } || 0;
                next unless $c > $ts;
                group_line($self, $ng);
@@ -249,7 +250,7 @@ sub cmd_newnews ($$$$;$$) {
        ngpat2re($keep);
        ngpat2re($skip);
        my @srch;
-       foreach my $ng (values %{$self->{nntpd}->{groups}}) {
+       foreach my $ng (@{$self->{nntpd}->{grouplist}}) {
                $ng->{name} =~ $keep or next;
                $ng->{name} =~ $skip and next;
                my $srch = $ng->search or next;
@@ -366,16 +367,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('');
                }
        }
@@ -562,6 +564,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 +643,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 +772,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 +814,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);
 }