This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Synch with CPAN distribution libnet-3.12
[perl5.git] / cpan / libnet / lib / Net / NNTP.pm
1 # Net::NNTP.pm
2 #
3 # Copyright (C) 1995-1997 Graham Barr.  All rights reserved.
4 # Copyright (C) 2013-2016, 2020 Steve Hay.  All rights reserved.
5 # This module is free software; you can redistribute it and/or modify it under
6 # the same terms as Perl itself, i.e. under the terms of either the GNU General
7 # Public License or the Artistic License, as specified in the F<LICENCE> file.
8
9 package Net::NNTP;
10
11 use 5.008001;
12
13 use strict;
14 use warnings;
15
16 use Carp;
17 use IO::Socket;
18 use Net::Cmd;
19 use Net::Config;
20 use Time::Local;
21
22 our $VERSION = "3.12";
23
24 # Code for detecting if we can use SSL
25 my $ssl_class = eval {
26   require IO::Socket::SSL;
27   # first version with default CA on most platforms
28   no warnings 'numeric';
29   IO::Socket::SSL->VERSION(2.007);
30 } && 'IO::Socket::SSL';
31
32 my $nossl_warn = !$ssl_class &&
33   'To use SSL please install IO::Socket::SSL with version>=2.007';
34
35 # Code for detecting if we can use IPv6
36 my $family_key = 'Domain';
37 my $inet6_class = eval {
38   require IO::Socket::IP;
39   no warnings 'numeric';
40   IO::Socket::IP->VERSION(0.25) || die;
41   $family_key = 'Family';
42 } && 'IO::Socket::IP' || eval {
43   require IO::Socket::INET6;
44   no warnings 'numeric';
45   IO::Socket::INET6->VERSION(2.62);
46 } && 'IO::Socket::INET6';
47
48
49 sub can_ssl   { $ssl_class };
50 sub can_inet6 { $inet6_class };
51
52 our @ISA = ('Net::Cmd', $inet6_class || 'IO::Socket::INET');
53
54
55 sub new {
56   my $self = shift;
57   my $type = ref($self) || $self;
58   my ($host, %arg);
59   if (@_ % 2) {
60     $host = shift;
61     %arg  = @_;
62   }
63   else {
64     %arg  = @_;
65     $host = delete $arg{Host};
66   }
67   my $obj;
68
69   $host ||= $ENV{NNTPSERVER} || $ENV{NEWSHOST};
70
71   my $hosts = defined $host ? [$host] : $NetConfig{nntp_hosts};
72
73   @{$hosts} = qw(news)
74     unless @{$hosts};
75
76   my %connect = ( Proto => 'tcp');
77
78   if ($arg{SSL}) {
79     # SSL from start
80     die $nossl_warn if ! $ssl_class;
81     $arg{Port} ||= 563;
82     $connect{$_} = $arg{$_} for(grep { m{^SSL_} } keys %arg);
83   }
84
85   foreach my $o (qw(LocalAddr LocalPort Timeout)) {
86     $connect{$o} = $arg{$o} if exists $arg{$o};
87   }
88   $connect{$family_key} = $arg{Domain} || $arg{Family};
89   $connect{Timeout} = 120 unless defined $connect{Timeout};
90   $connect{PeerPort} = $arg{Port} || 'nntp(119)';
91   foreach my $h (@{$hosts}) {
92     $connect{PeerAddr} = $h;
93     $obj = $type->SUPER::new(%connect) or next;
94     ${*$obj}{'net_nntp_host'} = $h;
95     ${*$obj}{'net_nntp_arg'} = \%arg;
96     if ($arg{SSL}) {
97       Net::NNTP::_SSL->start_SSL($obj,%arg) or next;
98     }
99   }
100
101   return
102     unless defined $obj;
103
104   $obj->autoflush(1);
105   $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);
106
107   unless ($obj->response() == CMD_OK) {
108     $obj->close;
109     return;
110   }
111
112   my $c = $obj->code;
113   my @m = $obj->message;
114
115   unless (exists $arg{Reader} && $arg{Reader} == 0) {
116
117     # if server is INN and we have transfer rights the we are currently
118     # talking to innd not nnrpd
119     if ($obj->reader) {
120
121       # If reader succeeds the we need to consider this code to determine postok
122       $c = $obj->code;
123     }
124     else {
125
126       # I want to ignore this failure, so restore the previous status.
127       $obj->set_status($c, \@m);
128     }
129   }
130
131   ${*$obj}{'net_nntp_post'} = $c == 200 ? 1 : 0;
132
133   $obj;
134 }
135
136
137 sub host {
138   my $me = shift;
139   ${*$me}{'net_nntp_host'};
140 }
141
142
143 sub debug_text {
144   my $nntp  = shift;
145   my $inout = shift;
146   my $text  = shift;
147
148   if ( (ref($nntp) and $nntp->code == 350 and $text =~ /^(\S+)/)
149     || ($text =~ /^(authinfo\s+pass)/io))
150   {
151     $text = "$1 ....\n";
152   }
153
154   $text;
155 }
156
157
158 sub postok {
159   @_ == 1 or croak 'usage: $nntp->postok()';
160   my $nntp = shift;
161   ${*$nntp}{'net_nntp_post'} || 0;
162 }
163
164
165 sub starttls {
166   my $self = shift;
167   $ssl_class or die $nossl_warn;
168   $self->_STARTTLS or return;
169   Net::NNTP::_SSL->start_SSL($self,
170     %{ ${*$self}{'net_nntp_arg'} }, # (ssl) args given in new
171     @_   # more (ssl) args
172   ) or return;
173   return 1;
174 }
175
176
177 sub article {
178   @_ >= 1 && @_ <= 3 or croak 'usage: $nntp->article([{$msgid|$msgnum}[, $fh]])';
179   my $nntp = shift;
180   my @fh;
181
182   @fh = (pop) if @_ == 2 || (@_ && (ref($_[0]) || ref(\$_[0]) eq 'GLOB'));
183
184   $nntp->_ARTICLE(@_)
185     ? $nntp->read_until_dot(@fh)
186     : undef;
187 }
188
189
190 sub articlefh {
191   @_ >= 1 && @_ <= 2 or croak 'usage: $nntp->articlefh([{$msgid|$msgnum}])';
192   my $nntp = shift;
193
194   return unless $nntp->_ARTICLE(@_);
195   return $nntp->tied_fh;
196 }
197
198
199 sub authinfo {
200   @_ == 3 or croak 'usage: $nntp->authinfo($user, $pass)';
201   my ($nntp, $user, $pass) = @_;
202
203   $nntp->_AUTHINFO("USER",      $user) == CMD_MORE
204     && $nntp->_AUTHINFO("PASS", $pass) == CMD_OK;
205 }
206
207
208 sub authinfo_simple {
209   @_ == 3 or croak 'usage: $nntp->authinfo_simple($user, $pass)';
210   my ($nntp, $user, $pass) = @_;
211
212   $nntp->_AUTHINFO('SIMPLE') == CMD_MORE
213     && $nntp->command($user, $pass)->response == CMD_OK;
214 }
215
216
217 sub body {
218   @_ >= 1 && @_ <= 3 or croak 'usage: $nntp->body([{$msgid|$msgnum}[, $fh]])';
219   my $nntp = shift;
220   my @fh;
221
222   @fh = (pop) if @_ == 2 || (@_ && ref($_[0]) || ref(\$_[0]) eq 'GLOB');
223
224   $nntp->_BODY(@_)
225     ? $nntp->read_until_dot(@fh)
226     : undef;
227 }
228
229
230 sub bodyfh {
231   @_ >= 1 && @_ <= 2 or croak 'usage: $nntp->bodyfh([{$msgid|$msgnum}])';
232   my $nntp = shift;
233   return unless $nntp->_BODY(@_);
234   return $nntp->tied_fh;
235 }
236
237
238 sub head {
239   @_ >= 1 && @_ <= 3 or croak 'usage: $nntp->head([{$msgid|$msgnum}[, $fh]])';
240   my $nntp = shift;
241   my @fh;
242
243   @fh = (pop) if @_ == 2 || (@_ && ref($_[0]) || ref(\$_[0]) eq 'GLOB');
244
245   $nntp->_HEAD(@_)
246     ? $nntp->read_until_dot(@fh)
247     : undef;
248 }
249
250
251 sub headfh {
252   @_ >= 1 && @_ <= 2 or croak 'usage: $nntp->headfh([{$msgid|$msgnum}])';
253   my $nntp = shift;
254   return unless $nntp->_HEAD(@_);
255   return $nntp->tied_fh;
256 }
257
258
259 sub nntpstat {
260   @_ == 1 || @_ == 2 or croak 'usage: $nntp->nntpstat([{$msgid|$msgnum}])';
261   my $nntp = shift;
262
263   $nntp->_STAT(@_) && $nntp->message =~ /(<[^>]+>)/o
264     ? $1
265     : undef;
266 }
267
268
269 sub group {
270   @_ == 1 || @_ == 2 or croak 'usage: $nntp->group([$group])';
271   my $nntp = shift;
272   my $grp  = ${*$nntp}{'net_nntp_group'};
273
274   return $grp
275     unless (@_ || wantarray);
276
277   my $newgrp = shift;
278
279   $newgrp = (defined($grp) and length($grp)) ? $grp : ""
280     unless defined($newgrp) and length($newgrp);
281
282   return 
283     unless $nntp->_GROUP($newgrp) and $nntp->message =~ /(\d+)\s+(\d+)\s+(\d+)\s+(\S+)/;
284
285   my ($count, $first, $last, $group) = ($1, $2, $3, $4);
286
287   # group may be replied as '(current group)'
288   $group = ${*$nntp}{'net_nntp_group'}
289     if $group =~ /\(/;
290
291   ${*$nntp}{'net_nntp_group'} = $group;
292
293   wantarray
294     ? ($count, $first, $last, $group)
295     : $group;
296 }
297
298
299 sub help {
300   @_ == 1 or croak 'usage: $nntp->help()';
301   my $nntp = shift;
302
303   $nntp->_HELP
304     ? $nntp->read_until_dot
305     : undef;
306 }
307
308
309 sub ihave {
310   @_ >= 2 or croak 'usage: $nntp->ihave($msgid[, $message])';
311   my $nntp  = shift;
312   my $msgid = shift;
313
314   $nntp->_IHAVE($msgid) && $nntp->datasend(@_)
315     ? @_ == 0 || $nntp->dataend
316     : undef;
317 }
318
319
320 sub last {
321   @_ == 1 or croak 'usage: $nntp->last()';
322   my $nntp = shift;
323
324   $nntp->_LAST && $nntp->message =~ /(<[^>]+>)/o
325     ? $1
326     : undef;
327 }
328
329
330 sub list {
331   @_ == 1 or croak 'usage: $nntp->list()';
332   my $nntp = shift;
333
334   $nntp->_LIST
335     ? $nntp->_grouplist
336     : undef;
337 }
338
339
340 sub newgroups {
341   @_ >= 2 or croak 'usage: $nntp->newgroups($since[, $distributions])';
342   my $nntp = shift;
343   my $since = _timestr(shift);
344   my $distributions = shift || "";
345
346   $distributions = join(",", @{$distributions})
347     if ref($distributions);
348
349   $nntp->_NEWGROUPS($since, $distributions)
350     ? $nntp->_grouplist
351     : undef;
352 }
353
354
355 sub newnews {
356   @_ >= 2 && @_ <= 4
357     or croak 'usage: $nntp->newnews($since[, $groups[, $distributions]])';
358   my $nntp = shift;
359   my $since = _timestr(shift);
360   my $groups = @_ ? shift : $nntp->group;
361   my $distributions = shift || "";
362
363   $groups ||= "*";
364   $groups = join(",", @{$groups})
365     if ref($groups);
366
367   $distributions = join(",", @{$distributions})
368     if ref($distributions);
369
370   $nntp->_NEWNEWS($groups, $since, $distributions)
371     ? $nntp->_articlelist
372     : undef;
373 }
374
375
376 sub next {
377   @_ == 1 or croak 'usage: $nntp->next()';
378   my $nntp = shift;
379
380   $nntp->_NEXT && $nntp->message =~ /(<[^>]+>)/o
381     ? $1
382     : undef;
383 }
384
385
386 sub post {
387   @_ >= 1 or croak 'usage: $nntp->post([$message])';
388   my $nntp = shift;
389
390   $nntp->_POST() && $nntp->datasend(@_)
391     ? @_ == 0 || $nntp->dataend
392     : undef;
393 }
394
395
396 sub postfh {
397   my $nntp = shift;
398   return unless $nntp->_POST();
399   return $nntp->tied_fh;
400 }
401
402
403 sub quit {
404   @_ == 1 or croak 'usage: $nntp->quit()';
405   my $nntp = shift;
406
407   $nntp->_QUIT;
408   $nntp->close;
409 }
410
411
412 sub slave {
413   @_ == 1 or croak 'usage: $nntp->slave()';
414   my $nntp = shift;
415
416   $nntp->_SLAVE;
417 }
418
419 ##
420 ## The following methods are not implemented by all servers
421 ##
422
423
424 sub active {
425   @_ == 1 || @_ == 2 or croak 'usage: $nntp->active([$pattern])';
426   my $nntp = shift;
427
428   $nntp->_LIST('ACTIVE', @_)
429     ? $nntp->_grouplist
430     : undef;
431 }
432
433
434 sub active_times {
435   @_ == 1 or croak 'usage: $nntp->active_times()';
436   my $nntp = shift;
437
438   $nntp->_LIST('ACTIVE.TIMES')
439     ? $nntp->_grouplist
440     : undef;
441 }
442
443
444 sub distributions {
445   @_ == 1 or croak 'usage: $nntp->distributions()';
446   my $nntp = shift;
447
448   $nntp->_LIST('DISTRIBUTIONS')
449     ? $nntp->_description
450     : undef;
451 }
452
453
454 sub distribution_patterns {
455   @_ == 1 or croak 'usage: $nntp->distribution_patterns()';
456   my $nntp = shift;
457
458   my $arr;
459   local $_;
460
461   ## no critic (ControlStructures::ProhibitMutatingListFunctions)
462   $nntp->_LIST('DISTRIB.PATS')
463     && ($arr = $nntp->read_until_dot)
464     ? [grep { /^\d/ && (chomp, $_ = [split /:/]) } @$arr]
465     : undef;
466 }
467
468
469 sub newsgroups {
470   @_ == 1 || @_ == 2 or croak 'usage: $nntp->newsgroups([$pattern])';
471   my $nntp = shift;
472
473   $nntp->_LIST('NEWSGROUPS', @_)
474     ? $nntp->_description
475     : undef;
476 }
477
478
479 sub overview_fmt {
480   @_ == 1 or croak 'usage: $nntp->overview_fmt()';
481   my $nntp = shift;
482
483   $nntp->_LIST('OVERVIEW.FMT')
484     ? $nntp->_articlelist
485     : undef;
486 }
487
488
489 sub subscriptions {
490   @_ == 1 or croak 'usage: $nntp->subscriptions()';
491   my $nntp = shift;
492
493   $nntp->_LIST('SUBSCRIPTIONS')
494     ? $nntp->_articlelist
495     : undef;
496 }
497
498
499 sub listgroup {
500   @_ == 1 || @_ == 2 or croak 'usage: $nntp->listgroup([$group])';
501   my $nntp = shift;
502
503   $nntp->_LISTGROUP(@_)
504     ? $nntp->_articlelist
505     : undef;
506 }
507
508
509 sub reader {
510   @_ == 1 or croak 'usage: $nntp->reader()';
511   my $nntp = shift;
512
513   $nntp->_MODE('READER');
514 }
515
516
517 sub xgtitle {
518   @_ == 1 || @_ == 2 or croak 'usage: $nntp->xgtitle([$pattern])';
519   my $nntp = shift;
520
521   $nntp->_XGTITLE(@_)
522     ? $nntp->_description
523     : undef;
524 }
525
526
527 sub xhdr {
528   @_ >= 2 && @_ <= 4 or croak 'usage: $nntp->xhdr($header[, $message_spec])';
529   my $nntp = shift;
530   my $header = shift;
531   my $arg = _msg_arg(@_);
532
533   $nntp->_XHDR($header, $arg)
534     ? $nntp->_description
535     : undef;
536 }
537
538
539 sub xover {
540   @_ == 2 || @_ == 3 or croak 'usage: $nntp->xover($message_spec)';
541   my $nntp = shift;
542   my $arg  = _msg_arg(@_);
543
544   $nntp->_XOVER($arg)
545     ? $nntp->_fieldlist
546     : undef;
547 }
548
549
550 sub xpat {
551   @_ == 4 || @_ == 5 or croak 'usage: $nntp->xpat($header, $pattern, $message_spec )';
552   my $nntp = shift;
553   my $header = shift;
554   my $pattern = shift;
555   my $arg = _msg_arg(@_);
556
557   $pattern = join(" ", @$pattern)
558     if ref($pattern);
559
560   $nntp->_XPAT($header, $arg, $pattern)
561     ? $nntp->_description
562     : undef;
563 }
564
565
566 sub xpath {
567   @_ == 2 or croak 'usage: $nntp->xpath($message_id)';
568   my ($nntp, $message_id) = @_;
569
570   return
571     unless $nntp->_XPATH($message_id);
572
573   my $m;
574   ($m = $nntp->message) =~ s/^\d+\s+//o;
575   my @p = split /\s+/, $m;
576
577   wantarray ? @p : $p[0];
578 }
579
580
581 sub xrover {
582   @_ == 2 || @_ == 3 or croak 'usage: $nntp->xrover($message_spec)';
583   my $nntp = shift;
584   my $arg  = _msg_arg(@_);
585
586   $nntp->_XROVER($arg)
587     ? $nntp->_description
588     : undef;
589 }
590
591
592 sub date {
593   @_ == 1 or croak 'usage: $nntp->date()';
594   my $nntp = shift;
595
596   $nntp->_DATE
597     && $nntp->message =~ /(\d{4})(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)/
598     ? timegm($6, $5, $4, $3, $2 - 1, $1)
599     : undef;
600 }
601
602
603 ##
604 ## Private subroutines
605 ##
606
607
608 sub _msg_arg {
609   my $spec = shift;
610   my $arg  = "";
611
612   if (@_) {
613     carp "Depriciated passing of two message numbers, " . "pass a reference"
614       if $^W;
615     $spec = [$spec, $_[0]];
616   }
617
618   if (defined $spec) {
619     if (ref($spec)) {
620       $arg = $spec->[0];
621       if (defined $spec->[1]) {
622         $arg .= "-"
623           if $spec->[1] != $spec->[0];
624         $arg .= $spec->[1]
625           if $spec->[1] > $spec->[0];
626       }
627     }
628     else {
629       $arg = $spec;
630     }
631   }
632
633   $arg;
634 }
635
636
637 sub _timestr {
638   my $time = shift;
639   my @g    = reverse((gmtime($time))[0 .. 5]);
640   $g[1] += 1;
641   $g[0] %= 100;
642   sprintf "%02d%02d%02d %02d%02d%02d GMT", @g;
643 }
644
645
646 sub _grouplist {
647   my $nntp = shift;
648   my $arr  = $nntp->read_until_dot
649     or return;
650
651   my $hash = {};
652
653   foreach my $ln (@$arr) {
654     my @a = split(/[\s\n]+/, $ln);
655     $hash->{$a[0]} = [@a[1, 2, 3]];
656   }
657
658   $hash;
659 }
660
661
662 sub _fieldlist {
663   my $nntp = shift;
664   my $arr  = $nntp->read_until_dot
665     or return;
666
667   my $hash = {};
668
669   foreach my $ln (@$arr) {
670     my @a = split(/[\t\n]/, $ln);
671     my $m = shift @a;
672     $hash->{$m} = [@a];
673   }
674
675   $hash;
676 }
677
678
679 sub _articlelist {
680   my $nntp = shift;
681   my $arr  = $nntp->read_until_dot;
682
683   chomp(@$arr)
684     if $arr;
685
686   $arr;
687 }
688
689
690 sub _description {
691   my $nntp = shift;
692   my $arr  = $nntp->read_until_dot
693     or return;
694
695   my $hash = {};
696
697   foreach my $ln (@$arr) {
698     chomp($ln);
699
700     $hash->{$1} = $ln
701       if $ln =~ s/^\s*(\S+)\s*//o;
702   }
703
704   $hash;
705
706 }
707
708 ##
709 ## The commands
710 ##
711
712
713 sub _ARTICLE  { shift->command('ARTICLE',  @_)->response == CMD_OK }
714 sub _AUTHINFO { shift->command('AUTHINFO', @_)->response }
715 sub _BODY     { shift->command('BODY',     @_)->response == CMD_OK }
716 sub _DATE      { shift->command('DATE')->response == CMD_INFO }
717 sub _GROUP     { shift->command('GROUP', @_)->response == CMD_OK }
718 sub _HEAD      { shift->command('HEAD', @_)->response == CMD_OK }
719 sub _HELP      { shift->command('HELP', @_)->response == CMD_INFO }
720 sub _IHAVE     { shift->command('IHAVE', @_)->response == CMD_MORE }
721 sub _LAST      { shift->command('LAST')->response == CMD_OK }
722 sub _LIST      { shift->command('LIST', @_)->response == CMD_OK }
723 sub _LISTGROUP { shift->command('LISTGROUP', @_)->response == CMD_OK }
724 sub _NEWGROUPS { shift->command('NEWGROUPS', @_)->response == CMD_OK }
725 sub _NEWNEWS   { shift->command('NEWNEWS', @_)->response == CMD_OK }
726 sub _NEXT      { shift->command('NEXT')->response == CMD_OK }
727 sub _POST      { shift->command('POST', @_)->response == CMD_MORE }
728 sub _QUIT      { shift->command('QUIT', @_)->response == CMD_OK }
729 sub _SLAVE     { shift->command('SLAVE', @_)->response == CMD_OK }
730 sub _STARTTLS  { shift->command("STARTTLS")->response() == CMD_MORE }
731 sub _STAT      { shift->command('STAT', @_)->response == CMD_OK }
732 sub _MODE      { shift->command('MODE', @_)->response == CMD_OK }
733 sub _XGTITLE   { shift->command('XGTITLE', @_)->response == CMD_OK }
734 sub _XHDR      { shift->command('XHDR', @_)->response == CMD_OK }
735 sub _XPAT      { shift->command('XPAT', @_)->response == CMD_OK }
736 sub _XPATH     { shift->command('XPATH', @_)->response == CMD_OK }
737 sub _XOVER     { shift->command('XOVER', @_)->response == CMD_OK }
738 sub _XROVER    { shift->command('XROVER', @_)->response == CMD_OK }
739 sub _XTHREAD   { shift->unsupported }
740 sub _XSEARCH   { shift->unsupported }
741 sub _XINDEX    { shift->unsupported }
742
743 ##
744 ## IO/perl methods
745 ##
746
747
748 sub DESTROY {
749   my $nntp = shift;
750   defined(fileno($nntp)) && $nntp->quit;
751 }
752
753 {
754   package Net::NNTP::_SSL;
755   our @ISA = ( $ssl_class ? ($ssl_class):(), 'Net::NNTP' );
756   sub starttls { die "NNTP connection is already in SSL mode" }
757   sub start_SSL {
758     my ($class,$nntp,%arg) = @_;
759     delete @arg{ grep { !m{^SSL_} } keys %arg };
760     ( $arg{SSL_verifycn_name} ||= $nntp->host )
761         =~s{(?<!:):[\w()]+$}{}; # strip port
762     $arg{SSL_hostname} = $arg{SSL_verifycn_name}
763         if ! defined $arg{SSL_hostname} && $class->can_client_sni;
764     my $ok = $class->SUPER::start_SSL($nntp,
765       SSL_verifycn_scheme => 'nntp',
766       %arg
767     );
768     $@ = $ssl_class->errstr if !$ok;
769     return $ok;
770   }
771 }
772
773
774
775
776 1;
777
778 __END__
779
780 =head1 NAME
781
782 Net::NNTP - NNTP Client class
783
784 =head1 SYNOPSIS
785
786     use Net::NNTP;
787
788     $nntp = Net::NNTP->new("some.host.name");
789     $nntp->quit;
790
791     # start with SSL, e.g. nntps
792     $nntp = Net::NNTP->new("some.host.name", SSL => 1);
793
794     # start with plain and upgrade to SSL
795     $nntp = Net::NNTP->new("some.host.name");
796     $nntp->starttls;
797
798
799 =head1 DESCRIPTION
800
801 C<Net::NNTP> is a class implementing a simple NNTP client in Perl as described
802 in RFC977 and RFC4642.
803 With L<IO::Socket::SSL> installed it also provides support for implicit and
804 explicit TLS encryption, i.e. NNTPS or NNTP+STARTTLS.
805
806 The Net::NNTP class is a subclass of Net::Cmd and (depending on avaibility) of
807 IO::Socket::IP, IO::Socket::INET6 or IO::Socket::INET.
808
809 =head2 Class Methods
810
811 =over 4
812
813 =item C<new([$host][, %options])>
814
815 This is the constructor for a new Net::NNTP object. C<$host> is the
816 name of the remote host to which a NNTP connection is required. If not
817 given then it may be passed as the C<Host> option described below. If no host is passed
818 then two environment variables are checked, first C<NNTPSERVER> then
819 C<NEWSHOST>, then C<Net::Config> is checked, and if a host is not found
820 then C<news> is used.
821
822 C<%options> are passed in a hash like fashion, using key and value pairs.
823 Possible options are:
824
825 B<Host> - NNTP host to connect to. It may be a single scalar, as defined for
826 the C<PeerAddr> option in L<IO::Socket::INET>, or a reference to
827 an array with hosts to try in turn. The L</host> method will return the value
828 which was used to connect to the host.
829
830 B<Port> - port to connect to.
831 Default - 119 for plain NNTP and 563 for immediate SSL (nntps).
832
833 B<SSL> - If the connection should be done from start with SSL, contrary to later
834 upgrade with C<starttls>.
835 You can use SSL arguments as documented in L<IO::Socket::SSL>, but it will
836 usually use the right arguments already.
837
838 B<Timeout> - Maximum time, in seconds, to wait for a response from the
839 NNTP server, a value of zero will cause all IO operations to block.
840 (default: 120)
841
842 B<Debug> - Enable the printing of debugging information to STDERR
843
844 B<Reader> - If the remote server is INN then initially the connection
845 will be to innd, by default C<Net::NNTP> will issue a C<MODE READER> command
846 so that the remote server becomes nnrpd. If the C<Reader> option is given
847 with a value of zero, then this command will not be sent and the
848 connection will be left talking to innd.
849
850 B<LocalAddr> and B<LocalPort> - These parameters are passed directly
851 to IO::Socket to allow binding the socket to a specific local address and port.
852
853 B<Domain> - This parameter is passed directly to IO::Socket and makes it
854 possible to enforce IPv4 connections even if L<IO::Socket::IP> is used as super
855 class. Alternatively B<Family> can be used.
856
857 =back
858
859 =head2 Object Methods
860
861 Unless otherwise stated all methods return either a I<true> or I<false>
862 value, with I<true> meaning that the operation was a success. When a method
863 states that it returns a value, failure will be returned as I<undef> or an
864 empty list.
865
866 C<Net::NNTP> inherits from C<Net::Cmd> so methods defined in C<Net::Cmd> may
867 be used to send commands to the remote NNTP server in addition to the methods
868 documented here.
869
870 =over 4
871
872 =item C<host()>
873
874 Returns the value used by the constructor, and passed to IO::Socket::INET,
875 to connect to the host.
876
877 =item C<starttls()>
878
879 Upgrade existing plain connection to SSL.
880 Any arguments necessary for SSL must be given in C<new> already.
881
882 =item C<article([{$msgid|$msgnum}[, $fh]])>
883
884 Retrieve the header, a blank line, then the body (text) of the
885 specified article. 
886
887 If C<$fh> is specified then it is expected to be a valid filehandle
888 and the result will be printed to it, on success a true value will be
889 returned. If C<$fh> is not specified then the return value, on success,
890 will be a reference to an array containing the article requested, each
891 entry in the array will contain one line of the article.
892
893 If no arguments are passed then the current article in the currently
894 selected newsgroup is fetched.
895
896 C<$msgnum> is a numeric id of an article in the current newsgroup, and
897 will change the current article pointer.  C<$msgid> is the message id of
898 an article as shown in that article's header.  It is anticipated that the
899 client will obtain the C<$msgid> from a list provided by the C<newnews>
900 command, from references contained within another article, or from the
901 message-id provided in the response to some other commands.
902
903 If there is an error then C<undef> will be returned.
904
905 =item C<body([{$msgid|$msgnum}[, [$fh]])>
906
907 Like C<article> but only fetches the body of the article.
908
909 =item C<head([{$msgid|$msgnum}[, [$fh]])>
910
911 Like C<article> but only fetches the headers for the article.
912
913 =item C<articlefh([{$msgid|$msgnum}])>
914
915 =item C<bodyfh([{$msgid|$msgnum}])>
916
917 =item C<headfh([{$msgid|$msgnum}])>
918
919 These are similar to article(), body() and head(), but rather than
920 returning the requested data directly, they return a tied filehandle
921 from which to read the article.
922
923 =item C<nntpstat([{$msgid|$msgnum}])>
924
925 The C<nntpstat> command is similar to the C<article> command except that no
926 text is returned.  When selecting by message number within a group,
927 the C<nntpstat> command serves to set the "current article pointer" without
928 sending text.
929
930 Using the C<nntpstat> command to
931 select by message-id is valid but of questionable value, since a
932 selection by message-id does B<not> alter the "current article pointer".
933
934 Returns the message-id of the "current article".
935
936 =item C<group([$group])>
937
938 Set and/or get the current group. If C<$group> is not given then information
939 is returned on the current group.
940
941 In a scalar context it returns the group name.
942
943 In an array context the return value is a list containing, the number
944 of articles in the group, the number of the first article, the number
945 of the last article and the group name.
946
947 =item C<help()>
948
949 Request help text (a short summary of commands that are understood by this
950 implementation) from the server. Returns the text or undef upon failure.
951
952 =item C<ihave($msgid[, $message])>
953
954 The C<ihave> command informs the server that the client has an article
955 whose id is C<$msgid>.  If the server desires a copy of that
956 article and C<$message> has been given then it will be sent.
957
958 Returns I<true> if the server desires the article and C<$message> was
959 successfully sent, if specified.
960
961 If C<$message> is not specified then the message must be sent using the
962 C<datasend> and C<dataend> methods from L<Net::Cmd>
963
964 C<$message> can be either an array of lines or a reference to an array
965 and must be encoded by the caller to octets of whatever encoding is required,
966 e.g. by using the Encode module's C<encode()> function.
967
968 =item C<last()>
969
970 Set the "current article pointer" to the previous article in the current
971 newsgroup.
972
973 Returns the message-id of the article.
974
975 =item C<date()>
976
977 Returns the date on the remote server. This date will be in a UNIX time
978 format (seconds since 1970)
979
980 =item C<postok()>
981
982 C<postok> will return I<true> if the servers initial response indicated
983 that it will allow posting.
984
985 =item C<authinfo($user, $pass)>
986
987 Authenticates to the server (using the original AUTHINFO USER / AUTHINFO PASS
988 form, defined in RFC2980) using the supplied username and password.  Please
989 note that the password is sent in clear text to the server.  This command
990 should not be used with valuable passwords unless the connection to the server
991 is somehow protected.
992
993 =item C<authinfo_simple($user, $pass)>
994
995 Authenticates to the server (using the proposed NNTP V2 AUTHINFO SIMPLE form,
996 defined and deprecated in RFC2980) using the supplied username and password.
997 As with L</authinfo> the password is sent in clear text.
998
999 =item C<list()>
1000
1001 Obtain information about all the active newsgroups. The results is a reference
1002 to a hash where the key is a group name and each value is a reference to an
1003 array. The elements in this array are:- the last article number in the group,
1004 the first article number in the group and any information flags about the group.
1005
1006 =item C<newgroups($since[, $distributions])>
1007
1008 C<$since> is a time value and C<$distributions> is either a distribution
1009 pattern or a reference to a list of distribution patterns.
1010 The result is the same as C<list>, but the
1011 groups return will be limited to those created after C<$since> and, if
1012 specified, in one of the distribution areas in C<$distributions>. 
1013
1014 =item C<newnews($since[, $groups[, $distributions]])>
1015
1016 C<$since> is a time value. C<$groups> is either a group pattern or a reference
1017 to a list of group patterns. C<$distributions> is either a distribution
1018 pattern or a reference to a list of distribution patterns.
1019
1020 Returns a reference to a list which contains the message-ids of all news posted
1021 after C<$since>, that are in a groups which matched C<$groups> and a
1022 distribution which matches C<$distributions>.
1023
1024 =item C<next()>
1025
1026 Set the "current article pointer" to the next article in the current
1027 newsgroup.
1028
1029 Returns the message-id of the article.
1030
1031 =item C<post([$message])>
1032
1033 Post a new article to the news server. If C<$message> is specified and posting
1034 is allowed then the message will be sent.
1035
1036 If C<$message> is not specified then the message must be sent using the
1037 C<datasend> and C<dataend> methods from L<Net::Cmd>
1038
1039 C<$message> can be either an array of lines or a reference to an array
1040 and must be encoded by the caller to octets of whatever encoding is required,
1041 e.g. by using the Encode module's C<encode()> function.
1042
1043 The message, either sent via C<datasend> or as the C<$message>
1044 parameter, must be in the format as described by RFC822 and must
1045 contain From:, Newsgroups: and Subject: headers.
1046
1047 =item C<postfh()>
1048
1049 Post a new article to the news server using a tied filehandle.  If
1050 posting is allowed, this method will return a tied filehandle that you
1051 can print() the contents of the article to be posted.  You must
1052 explicitly close() the filehandle when you are finished posting the
1053 article, and the return value from the close() call will indicate
1054 whether the message was successfully posted.
1055
1056 =item C<slave()>
1057
1058 Tell the remote server that I am not a user client, but probably another
1059 news server.
1060
1061 =item C<quit()>
1062
1063 Quit the remote server and close the socket connection.
1064
1065 =item C<can_inet6()>
1066
1067 Returns whether we can use IPv6.
1068
1069 =item C<can_ssl()>
1070
1071 Returns whether we can use SSL.
1072
1073 =back
1074
1075 =head2 Extension Methods
1076
1077 These methods use commands that are not part of the RFC977 documentation. Some
1078 servers may not support all of them.
1079
1080 =over 4
1081
1082 =item C<newsgroups([$pattern])>
1083
1084 Returns a reference to a hash where the keys are all the group names which
1085 match C<$pattern>, or all of the groups if no pattern is specified, and
1086 each value contains the description text for the group.
1087
1088 =item C<distributions()>
1089
1090 Returns a reference to a hash where the keys are all the possible
1091 distribution names and the values are the distribution descriptions.
1092
1093 =item C<distribution_patterns()>
1094
1095 Returns a reference to an array where each element, itself an array
1096 reference, consists of the three fields of a line of the distrib.pats list
1097 maintained by some NNTP servers, namely: a weight, a wildmat and a value
1098 which the client may use to construct a Distribution header.
1099
1100 =item C<subscriptions()>
1101
1102 Returns a reference to a list which contains a list of groups which
1103 are recommended for a new user to subscribe to.
1104
1105 =item C<overview_fmt()>
1106
1107 Returns a reference to an array which contain the names of the fields returned
1108 by C<xover>.
1109
1110 =item C<active_times()>
1111
1112 Returns a reference to a hash where the keys are the group names and each
1113 value is a reference to an array containing the time the groups was created
1114 and an identifier, possibly an Email address, of the creator.
1115
1116 =item C<active([$pattern])>
1117
1118 Similar to C<list> but only active groups that match the pattern are returned.
1119 C<$pattern> can be a group pattern.
1120
1121 =item C<xgtitle($pattern)>
1122
1123 Returns a reference to a hash where the keys are all the group names which
1124 match C<$pattern> and each value is the description text for the group.
1125
1126 =item C<xhdr($header, $message_spec)>
1127
1128 Obtain the header field C<$header> for all the messages specified. 
1129
1130 The return value will be a reference
1131 to a hash where the keys are the message numbers and each value contains
1132 the text of the requested header for that message.
1133
1134 =item C<xover($message_spec)>
1135
1136 The return value will be a reference
1137 to a hash where the keys are the message numbers and each value contains
1138 a reference to an array which contains the overview fields for that
1139 message.
1140
1141 The names of the fields can be obtained by calling C<overview_fmt>.
1142
1143 =item C<xpath($message_id)>
1144
1145 Returns the path name to the file on the server which contains the specified
1146 message.
1147
1148 =item C<xpat($header, $pattern, $message_spec)>
1149
1150 The result is the same as C<xhdr> except the is will be restricted to
1151 headers where the text of the header matches C<$pattern>
1152
1153 =item C<xrover($message_spec)>
1154
1155 The XROVER command returns reference information for the article(s)
1156 specified.
1157
1158 Returns a reference to a HASH where the keys are the message numbers and the
1159 values are the References: lines from the articles
1160
1161 =item C<listgroup([$group])>
1162
1163 Returns a reference to a list of all the active messages in C<$group>, or
1164 the current group if C<$group> is not specified.
1165
1166 =item C<reader()>
1167
1168 Tell the server that you are a reader and not another server.
1169
1170 This is required by some servers. For example if you are connecting to
1171 an INN server and you have transfer permission your connection will
1172 be connected to the transfer daemon, not the NNTP daemon. Issuing
1173 this command will cause the transfer daemon to hand over control
1174 to the NNTP daemon.
1175
1176 Some servers do not understand this command, but issuing it and ignoring
1177 the response is harmless.
1178
1179 =back
1180
1181 =head2 Unsupported
1182
1183 The following NNTP command are unsupported by the package, and there are
1184 no plans to do so.
1185
1186     AUTHINFO GENERIC
1187     XTHREAD
1188     XSEARCH
1189     XINDEX
1190
1191 =head2 Definitions
1192
1193 =over 4
1194
1195 =item $message_spec
1196
1197 C<$message_spec> is either a single message-id, a single message number, or
1198 a reference to a list of two message numbers.
1199
1200 If C<$message_spec> is a reference to a list of two message numbers and the
1201 second number in a range is less than or equal to the first then the range
1202 represents all messages in the group after the first message number.
1203
1204 B<NOTE> For compatibility reasons only with earlier versions of Net::NNTP
1205 a message spec can be passed as a list of two numbers, this is deprecated
1206 and a reference to the list should now be passed
1207
1208 =item $pattern
1209
1210 The C<NNTP> protocol uses the C<WILDMAT> format for patterns.
1211 The WILDMAT format was first developed by Rich Salz based on
1212 the format used in the UNIX "find" command to articulate
1213 file names. It was developed to provide a uniform mechanism
1214 for matching patterns in the same manner that the UNIX shell
1215 matches filenames.
1216
1217 Patterns are implicitly anchored at the
1218 beginning and end of each string when testing for a match.
1219
1220 There are five pattern matching operations other than a strict
1221 one-to-one match between the pattern and the source to be
1222 checked for a match.
1223
1224 The first is an asterisk C<*> to match any sequence of zero or more
1225 characters.
1226
1227 The second is a question mark C<?> to match any single character. The
1228 third specifies a specific set of characters.
1229
1230 The set is specified as a list of characters, or as a range of characters
1231 where the beginning and end of the range are separated by a minus (or dash)
1232 character, or as any combination of lists and ranges. The dash can
1233 also be included in the set as a character it if is the beginning
1234 or end of the set. This set is enclosed in square brackets. The
1235 close square bracket C<]> may be used in a set if it is the first
1236 character in the set.
1237
1238 The fourth operation is the same as the
1239 logical not of the third operation and is specified the same
1240 way as the third with the addition of a caret character C<^> at
1241 the beginning of the test string just inside the open square
1242 bracket.
1243
1244 The final operation uses the backslash character to
1245 invalidate the special meaning of an open square bracket C<[>,
1246 the asterisk, backslash or the question mark. Two backslashes in
1247 sequence will result in the evaluation of the backslash as a
1248 character with no special meaning.
1249
1250 =over 4
1251
1252 =item Examples
1253
1254 =item C<[^]-]>
1255
1256 matches any single character other than a close square
1257 bracket or a minus sign/dash.
1258
1259 =item C<*bdc>
1260
1261 matches any string that ends with the string "bdc"
1262 including the string "bdc" (without quotes).
1263
1264 =item C<[0-9a-zA-Z]>
1265
1266 matches any single printable alphanumeric ASCII character.
1267
1268 =item C<a??d>
1269
1270 matches any four character string which begins
1271 with a and ends with d.
1272
1273 =back
1274
1275 =back
1276
1277 =head1 EXPORTS
1278
1279 I<None>.
1280
1281 =head1 KNOWN BUGS
1282
1283 See L<https://rt.cpan.org/Dist/Display.html?Status=Active&Queue=libnet>.
1284
1285 =head1 SEE ALSO
1286
1287 L<Net::Cmd>,
1288 L<IO::Socket::SSL>.
1289
1290 =head1 AUTHOR
1291
1292 Graham Barr E<lt>L<gbarr@pobox.com|mailto:gbarr@pobox.com>E<gt>.
1293
1294 Steve Hay E<lt>L<shay@cpan.org|mailto:shay@cpan.org>E<gt> is now maintaining
1295 libnet as of version 1.22_02.
1296
1297 =head1 COPYRIGHT
1298
1299 Copyright (C) 1995-1997 Graham Barr.  All rights reserved.
1300
1301 Copyright (C) 2013-2016, 2020 Steve Hay.  All rights reserved.
1302
1303 =head1 LICENCE
1304
1305 This module is free software; you can redistribute it and/or modify it under the
1306 same terms as Perl itself, i.e. under the terms of either the GNU General Public
1307 License or the Artistic License, as specified in the F<LICENCE> file.
1308
1309 =head1 VERSION
1310
1311 Version 3.12
1312
1313 =head1 DATE
1314
1315 09 Dec 2020
1316
1317 =head1 HISTORY
1318
1319 See the F<Changes> file.
1320
1321 =cut