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