3 # Copyright (c) 1995-1997 Graham Barr <gbarr@pobox.com>. All rights reserved.
4 # This program is free software; you can redistribute it and/or
5 # modify it under the same terms as Perl itself.
10 use vars qw(@ISA $VERSION $debug);
17 $VERSION = "2.22"; # $Id: //depot/libnet/Net/NNTP.pm#18 $
18 @ISA = qw(Net::Cmd IO::Socket::INET);
23 my $type = ref($self) || $self;
24 my $host = shift if @_ % 2;
28 $host ||= $ENV{NNTPSERVER} || $ENV{NEWSHOST};
30 my $hosts = defined $host ? [ $host ] : $NetConfig{nntp_hosts};
36 foreach $h (@{$hosts})
38 $obj = $type->SUPER::new(PeerAddr => ($host = $h),
39 PeerPort => $arg{Port} || 'nntp(119)',
41 Timeout => defined $arg{Timeout}
50 ${*$obj}{'net_nntp_host'} = $host;
53 $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);
55 unless ($obj->response() == CMD_OK)
62 my @m = $obj->message;
64 unless(exists $arg{Reader} && $arg{Reader} == 0) {
65 # if server is INN and we have transfer rights the we are currently
66 # talking to innd not nnrpd
69 # If reader suceeds the we need to consider this code to determine postok
74 # I want to ignore this failure, so restore the previous status.
75 $obj->set_status($c,\@m);
79 ${*$obj}{'net_nntp_post'} = $c == 200 ? 1 : 0;
90 if((ref($nntp) and $nntp->code == 350 and $text =~ /^(\S+)/)
91 || ($text =~ /^(authinfo\s+pass)/io))
101 @_ == 1 or croak 'usage: $nntp->postok()';
103 ${*$nntp}{'net_nntp_post'} || 0;
108 @_ >= 1 && @_ <= 3 or croak 'usage: $nntp->article( [ MSGID ], [ FH ] )';
112 @fh = (pop) if @_ == 2 || (@_ && ref($_[0]) || ref(\$_[0]) eq 'GLOB');
115 ? $nntp->read_until_dot(@fh)
120 @_ >= 1 && @_ <= 2 or croak 'usage: $nntp->articlefh( [ MSGID ] )';
123 return unless $nntp->_ARTICLE(@_);
124 return $nntp->tied_fh;
129 @_ == 3 or croak 'usage: $nntp->authinfo( USER, PASS )';
130 my($nntp,$user,$pass) = @_;
132 $nntp->_AUTHINFO("USER",$user) == CMD_MORE
133 && $nntp->_AUTHINFO("PASS",$pass) == CMD_OK;
138 @_ == 3 or croak 'usage: $nntp->authinfo( USER, PASS )';
139 my($nntp,$user,$pass) = @_;
141 $nntp->_AUTHINFO('SIMPLE') == CMD_MORE
142 && $nntp->command($user,$pass)->response == CMD_OK;
147 @_ >= 1 && @_ <= 3 or croak 'usage: $nntp->body( [ MSGID ], [ FH ] )';
151 @fh = (pop) if @_ == 2 || (@_ && ref($_[0]) || ref(\$_[0]) eq 'GLOB');
154 ? $nntp->read_until_dot(@fh)
160 @_ >= 1 && @_ <= 2 or croak 'usage: $nntp->bodyfh( [ MSGID ] )';
162 return unless $nntp->_BODY(@_);
163 return $nntp->tied_fh;
168 @_ >= 1 && @_ <= 3 or croak 'usage: $nntp->head( [ MSGID ], [ FH ] )';
172 @fh = (pop) if @_ == 2 || (@_ && ref($_[0]) || ref(\$_[0]) eq 'GLOB');
175 ? $nntp->read_until_dot(@fh)
181 @_ >= 1 && @_ <= 2 or croak 'usage: $nntp->headfh( [ MSGID ] )';
183 return unless $nntp->_HEAD(@_);
184 return $nntp->tied_fh;
189 @_ == 1 || @_ == 2 or croak 'usage: $nntp->nntpstat( [ MSGID ] )';
192 $nntp->_STAT(@_) && $nntp->message =~ /(<[^>]+>)/o
200 @_ == 1 || @_ == 2 or croak 'usage: $nntp->group( [ GROUP ] )';
202 my $grp = ${*$nntp}{'net_nntp_group'} || undef;
205 unless(@_ || wantarray);
209 return wantarray ? () : undef
210 unless $nntp->_GROUP($newgrp || $grp || "")
211 && $nntp->message =~ /(\d+)\s+(\d+)\s+(\d+)\s+(\S+)/;
213 my($count,$first,$last,$group) = ($1,$2,$3,$4);
215 # group may be replied as '(current group)'
216 $group = ${*$nntp}{'net_nntp_group'}
219 ${*$nntp}{'net_nntp_group'} = $group;
222 ? ($count,$first,$last,$group)
228 @_ == 1 or croak 'usage: $nntp->help()';
232 ? $nntp->read_until_dot
238 @_ >= 2 or croak 'usage: $nntp->ihave( MESSAGE-ID [, MESSAGE ])';
242 $nntp->_IHAVE($mid) && $nntp->datasend(@_)
243 ? @_ == 0 || $nntp->dataend
249 @_ == 1 or croak 'usage: $nntp->last()';
252 $nntp->_LAST && $nntp->message =~ /(<[^>]+>)/o
259 @_ == 1 or croak 'usage: $nntp->list()';
269 @_ >= 2 or croak 'usage: $nntp->newgroups( SINCE [, DISTRIBUTIONS ])';
271 my $time = _timestr(shift);
272 my $dist = shift || "";
274 $dist = join(",", @{$dist})
277 $nntp->_NEWGROUPS($time,$dist)
284 @_ >= 2 && @_ <= 4 or
285 croak 'usage: $nntp->newnews( SINCE [, GROUPS [, DISTRIBUTIONS ]])';
287 my $time = _timestr(shift);
288 my $grp = @_ ? shift : $nntp->group;
289 my $dist = shift || "";
292 $grp = join(",", @{$grp})
295 $dist = join(",", @{$dist})
298 $nntp->_NEWNEWS($grp,$time,$dist)
299 ? $nntp->_articlelist
305 @_ == 1 or croak 'usage: $nntp->next()';
308 $nntp->_NEXT && $nntp->message =~ /(<[^>]+>)/o
315 @_ >= 1 or croak 'usage: $nntp->post( [ MESSAGE ] )';
318 $nntp->_POST() && $nntp->datasend(@_)
319 ? @_ == 0 || $nntp->dataend
325 return unless $nntp->_POST();
326 return $nntp->tied_fh;
331 @_ == 1 or croak 'usage: $nntp->quit()';
340 @_ == 1 or croak 'usage: $nntp->slave()';
347 ## The following methods are not implemented by all servers
352 @_ == 1 || @_ == 2 or croak 'usage: $nntp->active( [ PATTERN ] )';
355 $nntp->_LIST('ACTIVE',@_)
362 @_ == 1 or croak 'usage: $nntp->active_times()';
365 $nntp->_LIST('ACTIVE.TIMES')
372 @_ == 1 or croak 'usage: $nntp->distributions()';
375 $nntp->_LIST('DISTRIBUTIONS')
376 ? $nntp->_description
380 sub distribution_patterns
382 @_ == 1 or croak 'usage: $nntp->distributions()';
388 $nntp->_LIST('DISTRIB.PATS') && ($arr = $nntp->read_until_dot)
389 ? [grep { /^\d/ && (chomp, $_ = [ split /:/ ]) } @$arr]
395 @_ == 1 || @_ == 2 or croak 'usage: $nntp->newsgroups( [ PATTERN ] )';
398 $nntp->_LIST('NEWSGROUPS',@_)
399 ? $nntp->_description
405 @_ == 1 or croak 'usage: $nntp->overview_fmt()';
408 $nntp->_LIST('OVERVIEW.FMT')
409 ? $nntp->_articlelist
415 @_ == 1 or croak 'usage: $nntp->subscriptions()';
418 $nntp->_LIST('SUBSCRIPTIONS')
419 ? $nntp->_articlelist
425 @_ == 1 || @_ == 2 or croak 'usage: $nntp->listgroup( [ GROUP ] )';
428 $nntp->_LISTGROUP(@_)
429 ? $nntp->_articlelist
435 @_ == 1 or croak 'usage: $nntp->reader()';
438 $nntp->_MODE('READER');
443 @_ == 1 || @_ == 2 or croak 'usage: $nntp->xgtitle( [ PATTERN ] )';
447 ? $nntp->_description
453 @_ >= 2 && @_ <= 4 or croak 'usage: $nntp->xhdr( HEADER, [ MESSAGE-SPEC ] )';
456 my $arg = _msg_arg(@_);
458 $nntp->_XHDR($hdr, $arg)
459 ? $nntp->_description
465 @_ == 2 || @_ == 3 or croak 'usage: $nntp->xover( MESSAGE-SPEC )';
467 my $arg = _msg_arg(@_);
476 @_ == 4 || @_ == 5 or croak '$nntp->xpat( HEADER, PATTERN, MESSAGE-SPEC )';
480 my $arg = _msg_arg(@_);
482 $pat = join(" ", @$pat)
485 $nntp->_XPAT($hdr,$arg,$pat)
486 ? $nntp->_description
492 @_ == 2 or croak 'usage: $nntp->xpath( MESSAGE-ID )';
496 unless $nntp->_XPATH($mid);
498 my $m; ($m = $nntp->message) =~ s/^\d+\s+//o;
499 my @p = split /\s+/, $m;
501 wantarray ? @p : $p[0];
506 @_ == 2 || @_ == 3 or croak 'usage: $nntp->xrover( MESSAGE-SPEC )';
508 my $arg = _msg_arg(@_);
511 ? $nntp->_description
517 @_ == 1 or croak 'usage: $nntp->date()';
520 $nntp->_DATE && $nntp->message =~ /(\d{4})(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)/
521 ? timegm($6,$5,$4,$3,$2-1,$1 - 1900)
527 ## Private subroutines
537 carp "Depriciated passing of two message numbers, "
540 $spec = [ $spec, $_[0] ];
548 if(defined $spec->[1])
551 if $spec->[1] != $spec->[0];
553 if $spec->[1] > $spec->[0];
568 my @g = reverse((gmtime($time))[0..5]);
571 sprintf "%02d%02d%02d %02d%02d%02d GMT", @g;
577 my $arr = $nntp->read_until_dot or
585 my @a = split(/[\s\n]+/,$ln);
586 $hash->{$a[0]} = [ @a[1,2,3] ];
595 my $arr = $nntp->read_until_dot or
603 my @a = split(/[\t\n]/,$ln);
605 $hash->{$m} = [ @a ];
614 my $arr = $nntp->read_until_dot;
625 my $arr = $nntp->read_until_dot or
636 if $ln =~ s/^\s*(\S+)\s*//o;
647 sub _ARTICLE { shift->command('ARTICLE',@_)->response == CMD_OK }
648 sub _AUTHINFO { shift->command('AUTHINFO',@_)->response }
649 sub _BODY { shift->command('BODY',@_)->response == CMD_OK }
650 sub _DATE { shift->command('DATE')->response == CMD_INFO }
651 sub _GROUP { shift->command('GROUP',@_)->response == CMD_OK }
652 sub _HEAD { shift->command('HEAD',@_)->response == CMD_OK }
653 sub _HELP { shift->command('HELP',@_)->response == CMD_INFO }
654 sub _IHAVE { shift->command('IHAVE',@_)->response == CMD_MORE }
655 sub _LAST { shift->command('LAST')->response == CMD_OK }
656 sub _LIST { shift->command('LIST',@_)->response == CMD_OK }
657 sub _LISTGROUP { shift->command('LISTGROUP',@_)->response == CMD_OK }
658 sub _NEWGROUPS { shift->command('NEWGROUPS',@_)->response == CMD_OK }
659 sub _NEWNEWS { shift->command('NEWNEWS',@_)->response == CMD_OK }
660 sub _NEXT { shift->command('NEXT')->response == CMD_OK }
661 sub _POST { shift->command('POST',@_)->response == CMD_MORE }
662 sub _QUIT { shift->command('QUIT',@_)->response == CMD_OK }
663 sub _SLAVE { shift->command('SLAVE',@_)->response == CMD_OK }
664 sub _STAT { shift->command('STAT',@_)->response == CMD_OK }
665 sub _MODE { shift->command('MODE',@_)->response == CMD_OK }
666 sub _XGTITLE { shift->command('XGTITLE',@_)->response == CMD_OK }
667 sub _XHDR { shift->command('XHDR',@_)->response == CMD_OK }
668 sub _XPAT { shift->command('XPAT',@_)->response == CMD_OK }
669 sub _XPATH { shift->command('XPATH',@_)->response == CMD_OK }
670 sub _XOVER { shift->command('XOVER',@_)->response == CMD_OK }
671 sub _XROVER { shift->command('XROVER',@_)->response == CMD_OK }
672 sub _XTHREAD { shift->unsupported }
673 sub _XSEARCH { shift->unsupported }
674 sub _XINDEX { shift->unsupported }
683 defined(fileno($nntp)) && $nntp->quit
693 Net::NNTP - NNTP Client class
699 $nntp = Net::NNTP->new("some.host.name");
704 C<Net::NNTP> is a class implementing a simple NNTP client in Perl as described
705 in RFC977. C<Net::NNTP> inherits its communication methods from C<Net::Cmd>
711 =item new ( [ HOST ] [, OPTIONS ])
713 This is the constructor for a new Net::NNTP object. C<HOST> is the
714 name of the remote host to which a NNTP connection is required. If not
715 given two environment variables are checked, first C<NNTPSERVER> then
716 C<NEWSHOST>, then C<Net::Config> is checked, and if a host is not found
717 then C<news> is used.
719 C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
720 Possible options are:
722 B<Timeout> - Maximum time, in seconds, to wait for a response from the
723 NNTP server, a value of zero will cause all IO operations to block.
726 B<Debug> - Enable the printing of debugging information to STDERR
728 B<Reader> - If the remote server is INN then initially the connection
729 will be to nnrpd, by default C<Net::NNTP> will issue a C<MODE READER> command
730 so that the remote server becomes innd. If the C<Reader> option is given
731 with a value of zero, then this command will not be sent and the
732 connection will be left talking to nnrpd.
738 Unless otherwise stated all methods return either a I<true> or I<false>
739 value, with I<true> meaning that the operation was a success. When a method
740 states that it returns a value, failure will be returned as I<undef> or an
745 =item article ( [ MSGID|MSGNUM ], [FH] )
747 Retrieve the header, a blank line, then the body (text) of the
750 If C<FH> is specified then it is expected to be a valid filehandle
751 and the result will be printed to it, on success a true value will be
752 returned. If C<FH> is not specified then the return value, on success,
753 will be a reference to an array containg the article requested, each
754 entry in the array will contain one line of the article.
756 If no arguments are passed then the current article in the currently
757 selected newsgroup is fetched.
759 C<MSGNUM> is a numeric id of an article in the current newsgroup, and
760 will change the current article pointer. C<MSGID> is the message id of
761 an article as shown in that article's header. It is anticipated that the
762 client will obtain the C<MSGID> from a list provided by the C<newnews>
763 command, from references contained within another article, or from the
764 message-id provided in the response to some other commands.
766 If there is an error then C<undef> will be returned.
768 =item body ( [ MSGID|MSGNUM ], [FH] )
770 Like C<article> but only fetches the body of the article.
772 =item head ( [ MSGID|MSGNUM ], [FH] )
774 Like C<article> but only fetches the headers for the article.
776 =item articlefh ( [ MSGID|MSGNUM ] )
778 =item bodyfh ( [ MSGID|MSGNUM ] )
780 =item headfh ( [ MSGID|MSGNUM ] )
782 These are similar to article(), body() and head(), but rather than
783 returning the requested data directly, they return a tied filehandle
784 from which to read the article.
786 =item nntpstat ( [ MSGID|MSGNUM ] )
788 The C<nntpstat> command is similar to the C<article> command except that no
789 text is returned. When selecting by message number within a group,
790 the C<nntpstat> command serves to set the "current article pointer" without
793 Using the C<nntpstat> command to
794 select by message-id is valid but of questionable value, since a
795 selection by message-id does B<not> alter the "current article pointer".
797 Returns the message-id of the "current article".
799 =item group ( [ GROUP ] )
801 Set and/or get the current group. If C<GROUP> is not given then information
802 is returned on the current group.
804 In a scalar context it returns the group name.
806 In an array context the return value is a list containing, the number
807 of articles in the group, the number of the first article, the number
808 of the last article and the group name.
810 =item ihave ( MSGID [, MESSAGE ])
812 The C<ihave> command informs the server that the client has an article
813 whose id is C<MSGID>. If the server desires a copy of that
814 article, and C<MESSAGE> has been given the it will be sent.
816 Returns I<true> if the server desires the article and C<MESSAGE> was
817 successfully sent,if specified.
819 If C<MESSAGE> is not specified then the message must be sent using the
820 C<datasend> and C<dataend> methods from L<Net::Cmd>
822 C<MESSAGE> can be either an array of lines or a reference to an array.
826 Set the "current article pointer" to the previous article in the current
829 Returns the message-id of the article.
833 Returns the date on the remote server. This date will be in a UNIX time
834 format (seconds since 1970)
838 C<postok> will return I<true> if the servers initial response indicated
839 that it will allow posting.
841 =item authinfo ( USER, PASS )
845 Obtain information about all the active newsgroups. The results is a reference
846 to a hash where the key is a group name and each value is a reference to an
847 array. The elements in this array are:- the last article number in the group,
848 the first article number in the group and any information flags about the group.
850 =item newgroups ( SINCE [, DISTRIBUTIONS ])
852 C<SINCE> is a time value and C<DISTRIBUTIONS> is either a distribution
853 pattern or a reference to a list of distribution patterns.
854 The result is the same as C<list>, but the
855 groups return will be limited to those created after C<SINCE> and, if
856 specified, in one of the distribution areas in C<DISTRIBUTIONS>.
858 =item newnews ( SINCE [, GROUPS [, DISTRIBUTIONS ]])
860 C<SINCE> is a time value. C<GROUPS> is either a group pattern or a reference
861 to a list of group patterns. C<DISTRIBUTIONS> is either a distribution
862 pattern or a reference to a list of distribution patterns.
864 Returns a reference to a list which contains the message-ids of all news posted
865 after C<SINCE>, that are in a groups which matched C<GROUPS> and a
866 distribution which matches C<DISTRIBUTIONS>.
870 Set the "current article pointer" to the next article in the current
873 Returns the message-id of the article.
875 =item post ( [ MESSAGE ] )
877 Post a new article to the news server. If C<MESSAGE> is specified and posting
878 is allowed then the message will be sent.
880 If C<MESSAGE> is not specified then the message must be sent using the
881 C<datasend> and C<dataend> methods from L<Net::Cmd>
883 C<MESSAGE> can be either an array of lines or a reference to an array.
885 The message, either sent via C<datasend> or as the C<MESSAGE>
886 parameter, must be in the format as described by RFC822 and must
887 contain From:, Newsgroups: and Subject: headers.
891 Post a new article to the news server using a tied filehandle. If
892 posting is allowed, this method will return a tied filehandle that you
893 can print() the contents of the article to be posted. You must
894 explicitly close() the filehandle when you are finished posting the
895 article, and the return value from the close() call will indicate
896 whether the message was successfully posted.
900 Tell the remote server that I am not a user client, but probably another
905 Quit the remote server and close the socket connection.
909 =head2 Extension methods
911 These methods use commands that are not part of the RFC977 documentation. Some
912 servers may not support all of them.
916 =item newsgroups ( [ PATTERN ] )
918 Returns a reference to a hash where the keys are all the group names which
919 match C<PATTERN>, or all of the groups if no pattern is specified, and
920 each value contains the description text for the group.
922 =item distributions ()
924 Returns a reference to a hash where the keys are all the possible
925 distribution names and the values are the distribution descriptions.
927 =item subscriptions ()
929 Returns a reference to a list which contains a list of groups which
930 are recommended for a new user to subscribe to.
932 =item overview_fmt ()
934 Returns a reference to an array which contain the names of the fields returned
937 =item active_times ()
939 Returns a reference to a hash where the keys are the group names and each
940 value is a reference to an array containing the time the groups was created
941 and an identifier, possibly an Email address, of the creator.
943 =item active ( [ PATTERN ] )
945 Similar to C<list> but only active groups that match the pattern are returned.
946 C<PATTERN> can be a group pattern.
948 =item xgtitle ( PATTERN )
950 Returns a reference to a hash where the keys are all the group names which
951 match C<PATTERN> and each value is the description text for the group.
953 =item xhdr ( HEADER, MESSAGE-SPEC )
955 Obtain the header field C<HEADER> for all the messages specified.
957 The return value will be a reference
958 to a hash where the keys are the message numbers and each value contains
959 the text of the requested header for that message.
961 =item xover ( MESSAGE-SPEC )
963 The return value will be a reference
964 to a hash where the keys are the message numbers and each value contains
965 a reference to an array which contains the overview fields for that
968 The names of the fields can be obtained by calling C<overview_fmt>.
970 =item xpath ( MESSAGE-ID )
972 Returns the path name to the file on the server which contains the specified
975 =item xpat ( HEADER, PATTERN, MESSAGE-SPEC)
977 The result is the same as C<xhdr> except the is will be restricted to
978 headers where the text of the header matches C<PATTERN>
982 The XROVER command returns reference information for the article(s)
985 Returns a reference to a HASH where the keys are the message numbers and the
986 values are the References: lines from the articles
988 =item listgroup ( [ GROUP ] )
990 Returns a reference to a list of all the active messages in C<GROUP>, or
991 the current group if C<GROUP> is not specified.
995 Tell the server that you are a reader and not another server.
997 This is required by some servers. For example if you are connecting to
998 an INN server and you have transfer permission your connection will
999 be connected to the transfer daemon, not the NNTP daemon. Issuing
1000 this command will cause the transfer daemon to hand over control
1003 Some servers do not understand this command, but issuing it and ignoring
1004 the response is harmless.
1010 The following NNTP command are unsupported by the package, and there are
1024 C<MESSAGE-SPEC> is either a single message-id, a single message number, or
1025 a reference to a list of two message numbers.
1027 If C<MESSAGE-SPEC> is a reference to a list of two message numbers and the
1028 second number in a range is less than or equal to the first then the range
1029 represents all messages in the group after the first message number.
1031 B<NOTE> For compatibility reasons only with earlier versions of Net::NNTP
1032 a message spec can be passed as a list of two numbers, this is deprecated
1033 and a reference to the list should now be passed
1037 The C<NNTP> protocol uses the C<WILDMAT> format for patterns.
1038 The WILDMAT format was first developed by Rich Salz based on
1039 the format used in the UNIX "find" command to articulate
1040 file names. It was developed to provide a uniform mechanism
1041 for matching patterns in the same manner that the UNIX shell
1044 Patterns are implicitly anchored at the
1045 beginning and end of each string when testing for a match.
1047 There are five pattern matching operations other than a strict
1048 one-to-one match between the pattern and the source to be
1049 checked for a match.
1051 The first is an asterisk C<*> to match any sequence of zero or more
1054 The second is a question mark C<?> to match any single character. The
1055 third specifies a specific set of characters.
1057 The set is specified as a list of characters, or as a range of characters
1058 where the beginning and end of the range are separated by a minus (or dash)
1059 character, or as any combination of lists and ranges. The dash can
1060 also be included in the set as a character it if is the beginning
1061 or end of the set. This set is enclosed in square brackets. The
1062 close square bracket C<]> may be used in a set if it is the first
1063 character in the set.
1065 The fourth operation is the same as the
1066 logical not of the third operation and is specified the same
1067 way as the third with the addition of a caret character C<^> at
1068 the beginning of the test string just inside the open square
1071 The final operation uses the backslash character to
1072 invalidate the special meaning of an open square bracket C<[>,
1073 the asterisk, backslash or the question mark. Two backslashes in
1074 sequence will result in the evaluation of the backslash as a
1075 character with no special meaning.
1083 matches any single character other than a close square
1084 bracket or a minus sign/dash.
1088 matches any string that ends with the string "bdc"
1089 including the string "bdc" (without quotes).
1091 =item C<[0-9a-zA-Z]>
1093 matches any single printable alphanumeric ASCII character.
1097 matches any four character string which begins
1098 with a and ends with d.
1110 Graham Barr <gbarr@pobox.com>
1114 Copyright (c) 1995-1997 Graham Barr. All rights reserved.
1115 This program is free software; you can redistribute it and/or modify
1116 it under the same terms as Perl itself.
1120 I<$Id: //depot/libnet/Net/NNTP.pm#18 $>