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