-# flesh out common NNTP-specific data structures
-sub nntp_common_init ($) {
- my ($self) = @_;
- my $cfg = $self->{pi_cfg};
- my $nn_args = {}; # scheme://authority => Net::NNTP->new arg
- for my $url (sort keys %{$self->{nntp}}) {
- my $sec = uri_section(uri_new($url));
-
- # Debug and Timeout are passed to Net::NNTP->new
- my $v = cfg_bool($cfg, 'nntp.Debug', $url);
- $nn_args->{$sec}->{Debug} = $v if defined $v;
- my $to = cfg_intvl($cfg, 'nntp.Timeout', $url);
- $nn_args->{$sec}->{Timeout} = $to if $to;
-
- # Net::NNTP post-connect commands
- for my $k (qw(starttls compress)) {
- $v = cfg_bool($cfg, "nntp.$k", $url) // next;
- $self->{nntp_opt}->{$sec}->{$k} = $v;
- }
-
- # internal option
- for my $k (qw(pollInterval)) {
- $to = cfg_intvl($cfg, "nntp.$k", $url) // next;
- $self->{nntp_opt}->{$sec}->{$k} = $to;
- }
- }
- $nn_args;
-}
-
-# Net::NNTP doesn't support CAPABILITIES, yet
-sub try_starttls ($) {
- my ($host) = @_;
- return if $host =~ /\.onion\z/s;
- return if $host =~ /\A127\.[0-9]+\.[0-9]+\.[0-9]+\z/s;
- return if $host eq '::1';
- 1;
-}
-
-sub nn_new ($$$) {
- my ($nn_arg, $nntp_opt, $url) = @_;
- my $nn = Net::NNTP->new(%$nn_arg) or die "E: <$url> new: $!\n";
-
- # default to using STARTTLS if it's available, but allow
- # it to be disabled for localhost/VPN users
- if (!$nn_arg->{SSL} && $nn->can('starttls')) {
- if (!defined($nntp_opt->{starttls}) &&
- try_starttls($nn_arg->{Host})) {
- # soft fail by default
- $nn->starttls or warn <<"";
-W: <$url> STARTTLS tried and failed (not requested)
-
- } elsif ($nntp_opt->{starttls}) {
- # hard fail if explicitly configured
- $nn->starttls or die <<"";
-E: <$url> STARTTLS requested and failed
-
- }
- } elsif ($nntp_opt->{starttls}) {
- $nn->can('starttls') or
- die "E: <$url> Net::NNTP too old for STARTTLS\n";
- $nn->starttls or die <<"";
-E: <$url> STARTTLS requested and failed
-
- }
- $nn;
-}
-
-sub nn_for ($$$) { # nn = Net::NNTP
- my ($self, $url, $nn_args) = @_;
- my $uri = uri_new($url);
- my $sec = uri_section($uri);
- my $nntp_opt = $self->{nntp_opt}->{$sec} //= {};
- my $host = $uri->host;
- # Net::NNTP and Net::Netrc both mishandle `0', so we pass `127.0.0.1'
- $host = '127.0.0.1' if $host eq '0';
- my $cred;
- my ($u, $p);
- if (defined(my $ui = $uri->userinfo)) {
- require PublicInbox::GitCredential;
- $cred = bless {
- url => $sec,
- protocol => uri_scheme($uri),
- host => $host,
- }, 'PublicInbox::GitCredential';
- ($u, $p) = split(/:/, $ui, 2);
- ($cred->{username}, $cred->{password}) = ($u, $p);
- $cred->check_netrc unless defined $p;
- }
- my $common = $nn_args->{$sec} // {};
- my $nn_arg = {
- Port => $uri->port,
- Host => $host,
- SSL => $uri->secure, # snews == nntps
- %$common, # may Debug ....
- };
- my $nn = nn_new($nn_arg, $nntp_opt, $url);
-
- if ($cred) {
- $cred->fill; # may prompt user here
- if ($nn->authinfo($u, $p)) {
- push @{$nntp_opt->{-postconn}}, [ 'authinfo', $u, $p ];
- } else {
- warn "E: <$url> AUTHINFO $u XXXX failed\n";
- $nn = undef;
- }
- }
-
- if ($nntp_opt->{compress}) {
- # https://rt.cpan.org/Ticket/Display.html?id=129967
- if ($nn->can('compress')) {
- if ($nn->compress) {
- push @{$nntp_opt->{-postconn}}, [ 'compress' ];
- } else {
- warn "W: <$url> COMPRESS failed\n";
- }
- } else {
- delete $nntp_opt->{compress};
- warn <<"";
-W: <$url> COMPRESS not supported by Net::NNTP
-W: see https://rt.cpan.org/Ticket/Display.html?id=129967 for updates
-
- }
- }
-
- $self->{nn_arg}->{$sec} = $nn_arg;
- $cred->run($nn ? 'approve' : 'reject') if $cred;
- $nn;
-}
-
-sub nntp_fetch_all ($$$) {
- my ($self, $nn, $url) = @_;
- my $uri = uri_new($url);
- my ($group, $num_a, $num_b) = $uri->group;
- my $sec = uri_section($uri);
- my ($nr, $beg, $end) = $nn->group($group);
- unless (defined($nr)) {
- chomp(my $msg = $nn->message);
- return "E: GROUP $group <$sec> $msg";
- }
-
- # IMAPTracker is also used for tracking NNTP, UID == article number
- # LIST.ACTIVE can get the equivalent of UIDVALIDITY, but that's
- # expensive. So we assume newsgroups don't change:
- my $itrk = PublicInbox::IMAPTracker->new($url);
- my (undef, $l_art) = $itrk->get_last;
- $l_art //= $beg; # initial import
-
- # allow users to specify articles to refetch
- # cf. https://tools.ietf.org/id/draft-gilman-news-url-01.txt
- # nntp://example.com/inbox.foo/$num_a-$num_b
- $l_art = $num_a if defined($num_a) && $num_a < $l_art;
- $end = $num_b if defined($num_b) && $num_b < $end;
-
- return if $l_art >= $end; # nothing to do
- $beg = $l_art + 1;
-
- warn "I: $url fetching ARTICLE $beg..$end\n";
- my $warn_cb = $SIG{__WARN__} || \&CORE::warn;
- my ($err, $art);
- local $SIG{__WARN__} = sub {
- my $pfx = ($_[0] // '') =~ /^([A-Z]: )/g ? $1 : '';
- $warn_cb->("$pfx$url ", $art ? ("ARTICLE $art") : (), "\n", @_);
- };
- my $inboxes = $self->{nntp}->{$url};
- my $last_art;
- my $n = $self->{max_batch};
- for ($beg..$end) {
- last if $self->{quit};
- $art = $_;
- if (--$n < 0) {
- _done_for_now($self);
- $itrk->update_last(0, $last_art);
- $n = $self->{max_batch};
- }
- my $raw = $nn->article($art);
- unless (defined($raw)) {
- my $msg = $nn->message;
- if ($nn->code == 421) { # pseudo response from Net::Cmd
- $err = "E: $msg";
- last;
- } else { # probably just a deleted message (spam)
- warn "W: $msg";
- next;
- }
- }
- s/\r\n/\n/ for @$raw;
- $raw = join('', @$raw);
- if (ref($inboxes)) {
- for my $ibx (@$inboxes) {
- my $eml = PublicInbox::Eml->new($raw);
- import_eml($self, $ibx, $eml);
- }
- } elsif ($inboxes eq 'watchspam') {
- my $eml = PublicInbox::Eml->new(\$raw);
- $self->{pi_cfg}->each_inbox(\&remove_eml_i,
- $self, $eml, "$url ARTICLE $art");
- } else {
- die "BUG: destination unknown $inboxes";
- }
- $last_art = $art;
- }
- _done_for_now($self);
- $itrk->update_last(0, $last_art);
- $err;
-}
-