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.19"; # $Id: //depot/libnet/Net/NNTP.pm#8$
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(($nntp->code == 350 && $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)
121 @_ == 3 or croak 'usage: $nntp->authinfo( USER, PASS )';
122 my($nntp,$user,$pass) = @_;
124 $nntp->_AUTHINFO("USER",$user) == CMD_MORE
125 && $nntp->_AUTHINFO("PASS",$pass) == CMD_OK;
130 @_ == 3 or croak 'usage: $nntp->authinfo( USER, PASS )';
131 my($nntp,$user,$pass) = @_;
133 $nntp->_AUTHINFO('SIMPLE') == CMD_MORE
134 && $nntp->command($user,$pass)->response == CMD_OK;
139 @_ >= 1 && @_ <= 3 or croak 'usage: $nntp->body( [ MSGID ], [ FH ] )';
143 @fh = (pop) if @_ == 2 || (@_ && ref($_[0]) || ref(\$_[0]) eq 'GLOB');
146 ? $nntp->read_until_dot(@fh)
152 @_ >= 1 && @_ <= 3 or croak 'usage: $nntp->head( [ MSGID ], [ FH ] )';
156 @fh = (pop) if @_ == 2 || (@_ && ref($_[0]) || ref(\$_[0]) eq 'GLOB');
159 ? $nntp->read_until_dot(@fh)
165 @_ == 1 || @_ == 2 or croak 'usage: $nntp->nntpstat( [ MSGID ] )';
168 $nntp->_STAT(@_) && $nntp->message =~ /(<[^>]+>)/o
176 @_ == 1 || @_ == 2 or croak 'usage: $nntp->group( [ GROUP ] )';
178 my $grp = ${*$nntp}{'net_nntp_group'} || undef;
181 unless(@_ || wantarray);
185 return wantarray ? () : undef
186 unless $nntp->_GROUP($newgrp || $grp || "")
187 && $nntp->message =~ /(\d+)\s+(\d+)\s+(\d+)\s+(\S+)/;
189 my($count,$first,$last,$group) = ($1,$2,$3,$4);
191 # group may be replied as '(current group)'
192 $group = ${*$nntp}{'net_nntp_group'}
195 ${*$nntp}{'net_nntp_group'} = $group;
198 ? ($count,$first,$last,$group)
204 @_ == 1 or croak 'usage: $nntp->help()';
208 ? $nntp->read_until_dot
214 @_ >= 2 or croak 'usage: $nntp->ihave( MESSAGE-ID [, MESSAGE ])';
218 $nntp->_IHAVE($mid) && $nntp->datasend(@_)
219 ? @_ == 0 || $nntp->dataend
225 @_ == 1 or croak 'usage: $nntp->last()';
228 $nntp->_LAST && $nntp->message =~ /(<[^>]+>)/o
235 @_ == 1 or croak 'usage: $nntp->list()';
245 @_ >= 2 or croak 'usage: $nntp->newgroups( SINCE [, DISTRIBUTIONS ])';
247 my $time = _timestr(shift);
248 my $dist = shift || "";
250 $dist = join(",", @{$dist})
253 $nntp->_NEWGROUPS($time,$dist)
260 @_ >= 2 && @_ <= 4 or
261 croak 'usage: $nntp->newnews( SINCE [, GROUPS [, DISTRIBUTIONS ]])';
263 my $time = _timestr(shift);
264 my $grp = @_ ? shift : $nntp->group;
265 my $dist = shift || "";
268 $grp = join(",", @{$grp})
271 $dist = join(",", @{$dist})
274 $nntp->_NEWNEWS($grp,$time,$dist)
275 ? $nntp->_articlelist
281 @_ == 1 or croak 'usage: $nntp->next()';
284 $nntp->_NEXT && $nntp->message =~ /(<[^>]+>)/o
291 @_ >= 1 or croak 'usage: $nntp->post( [ MESSAGE ] )';
294 $nntp->_POST() && $nntp->datasend(@_)
295 ? @_ == 0 || $nntp->dataend
301 @_ == 1 or croak 'usage: $nntp->quit()';
310 @_ == 1 or croak 'usage: $nntp->slave()';
317 ## The following methods are not implemented by all servers
322 @_ == 1 || @_ == 2 or croak 'usage: $nntp->active( [ PATTERN ] )';
325 $nntp->_LIST('ACTIVE',@_)
332 @_ == 1 or croak 'usage: $nntp->active_times()';
335 $nntp->_LIST('ACTIVE.TIMES')
342 @_ == 1 or croak 'usage: $nntp->distributions()';
345 $nntp->_LIST('DISTRIBUTIONS')
346 ? $nntp->_description
350 sub distribution_patterns
352 @_ == 1 or croak 'usage: $nntp->distributions()';
358 $nntp->_LIST('DISTRIB.PATS') && ($arr = $nntp->read_until_dot)
359 ? [grep { /^\d/ && (chomp, $_ = [ split /:/ ]) } @$arr]
365 @_ == 1 || @_ == 2 or croak 'usage: $nntp->newsgroups( [ PATTERN ] )';
368 $nntp->_LIST('NEWSGROUPS',@_)
369 ? $nntp->_description
375 @_ == 1 or croak 'usage: $nntp->overview_fmt()';
378 $nntp->_LIST('OVERVIEW.FMT')
379 ? $nntp->_articlelist
385 @_ == 1 or croak 'usage: $nntp->subscriptions()';
388 $nntp->_LIST('SUBSCRIPTIONS')
389 ? $nntp->_articlelist
395 @_ == 1 || @_ == 2 or croak 'usage: $nntp->listgroup( [ GROUP ] )';
398 $nntp->_LISTGROUP(@_)
399 ? $nntp->_articlelist
405 @_ == 1 or croak 'usage: $nntp->reader()';
408 $nntp->_MODE('READER');
413 @_ == 1 || @_ == 2 or croak 'usage: $nntp->xgtitle( [ PATTERN ] )';
417 ? $nntp->_description
423 @_ >= 2 && @_ <= 4 or croak 'usage: $nntp->xhdr( HEADER, [ MESSAGE-SPEC ] )';
426 my $arg = _msg_arg(@_);
428 $nntp->_XHDR($hdr, $arg)
429 ? $nntp->_description
435 @_ == 2 || @_ == 3 or croak 'usage: $nntp->xover( MESSAGE-SPEC )';
437 my $arg = _msg_arg(@_);
446 @_ == 4 || @_ == 5 or croak '$nntp->xpat( HEADER, PATTERN, MESSAGE-SPEC )';
450 my $arg = _msg_arg(@_);
452 $pat = join(" ", @$pat)
455 $nntp->_XPAT($hdr,$arg,$pat)
456 ? $nntp->_description
462 @_ == 2 or croak 'usage: $nntp->xpath( MESSAGE-ID )';
466 unless $nntp->_XPATH($mid);
468 my $m; ($m = $nntp->message) =~ s/^\d+\s+//o;
469 my @p = split /\s+/, $m;
471 wantarray ? @p : $p[0];
476 @_ == 2 || @_ == 3 or croak 'usage: $nntp->xrover( MESSAGE-SPEC )';
478 my $arg = _msg_arg(@_);
481 ? $nntp->_description
487 @_ == 1 or croak 'usage: $nntp->date()';
490 $nntp->_DATE && $nntp->message =~ /(\d{4})(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)/
491 ? timegm($6,$5,$4,$3,$2-1,$1 - 1900)
497 ## Private subroutines
507 carp "Depriciated passing of two message numbers, "
510 $spec = [ $spec, $_[0] ];
517 $arg = $spec->[0] . "-";
519 if defined $spec->[1] && $spec->[1] > $spec->[0];
533 my @g = reverse((gmtime($time))[0..5]);
536 sprintf "%02d%02d%02d %02d%02d%02d GMT", @g;
542 my $arr = $nntp->read_until_dot or
550 my @a = split(/[\s\n]+/,$ln);
551 $hash->{$a[0]} = [ @a[1,2,3] ];
560 my $arr = $nntp->read_until_dot or
568 my @a = split(/[\t\n]/,$ln);
570 $hash->{$m} = [ @a ];
579 my $arr = $nntp->read_until_dot;
590 my $arr = $nntp->read_until_dot or
601 if $ln =~ s/^\s*(\S+)\s*//o;
612 sub _ARTICLE { shift->command('ARTICLE',@_)->response == CMD_OK }
613 sub _AUTHINFO { shift->command('AUTHINFO',@_)->response }
614 sub _BODY { shift->command('BODY',@_)->response == CMD_OK }
615 sub _DATE { shift->command('DATE')->response == CMD_INFO }
616 sub _GROUP { shift->command('GROUP',@_)->response == CMD_OK }
617 sub _HEAD { shift->command('HEAD',@_)->response == CMD_OK }
618 sub _HELP { shift->command('HELP',@_)->response == CMD_INFO }
619 sub _IHAVE { shift->command('IHAVE',@_)->response == CMD_MORE }
620 sub _LAST { shift->command('LAST')->response == CMD_OK }
621 sub _LIST { shift->command('LIST',@_)->response == CMD_OK }
622 sub _LISTGROUP { shift->command('LISTGROUP',@_)->response == CMD_OK }
623 sub _NEWGROUPS { shift->command('NEWGROUPS',@_)->response == CMD_OK }
624 sub _NEWNEWS { shift->command('NEWNEWS',@_)->response == CMD_OK }
625 sub _NEXT { shift->command('NEXT')->response == CMD_OK }
626 sub _POST { shift->command('POST',@_)->response == CMD_MORE }
627 sub _QUIT { shift->command('QUIT',@_)->response == CMD_OK }
628 sub _SLAVE { shift->command('SLAVE',@_)->response == CMD_OK }
629 sub _STAT { shift->command('STAT',@_)->response == CMD_OK }
630 sub _MODE { shift->command('MODE',@_)->response == CMD_OK }
631 sub _XGTITLE { shift->command('XGTITLE',@_)->response == CMD_OK }
632 sub _XHDR { shift->command('XHDR',@_)->response == CMD_OK }
633 sub _XPAT { shift->command('XPAT',@_)->response == CMD_OK }
634 sub _XPATH { shift->command('XPATH',@_)->response == CMD_OK }
635 sub _XOVER { shift->command('XOVER',@_)->response == CMD_OK }
636 sub _XROVER { shift->command('XROVER',@_)->response == CMD_OK }
637 sub _XTHREAD { shift->unsupported }
638 sub _XSEARCH { shift->unsupported }
639 sub _XINDEX { shift->unsupported }
648 defined(fileno($nntp)) && $nntp->quit
658 Net::NNTP - NNTP Client class
664 $nntp = Net::NNTP->new("some.host.name");
669 C<Net::NNTP> is a class implementing a simple NNTP client in Perl as described
670 in RFC977. C<Net::NNTP> inherits its communication methods from C<Net::Cmd>
676 =item new ( [ HOST ] [, OPTIONS ])
678 This is the constructor for a new Net::NNTP object. C<HOST> is the
679 name of the remote host to which a NNTP connection is required. If not
680 given two environment variables are checked, first C<NNTPSERVER> then
681 C<NEWSHOST>, then C<Net::Config> is checked, and if a host is not found
682 then C<news> is used.
684 C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
685 Possible options are:
687 B<Timeout> - Maximum time, in seconds, to wait for a response from the
688 NNTP server, a value of zero will cause all IO operations to block.
691 B<Debug> - Enable the printing of debugging information to STDERR
693 B<Reader> - If the remote server is INN then initially the connection
694 will be to nnrpd, by default C<Net::NNTP> will issue a C<MODE READER> command
695 so that the remote server becomes innd. If the C<Reader> option is given
696 with a value of zero, then this command will not be sent and the
697 connection will be left talking to nnrpd.
703 Unless otherwise stated all methods return either a I<true> or I<false>
704 value, with I<true> meaning that the operation was a success. When a method
705 states that it returns a value, failure will be returned as I<undef> or an
710 =item article ( [ MSGID|MSGNUM ], [FH] )
712 Retrieve the header, a blank line, then the body (text) of the
715 If C<FH> is specified then it is expected to be a valid filehandle
716 and the result will be printed to it, on sucess a true value will be
717 returned. If C<FH> is not specified then the return value, on sucess,
718 will be a reference to an array containg the article requested, each
719 entry in the array will contain one line of the article.
721 If no arguments are passed then the current article in the currently
722 selected newsgroup is fetched.
724 C<MSGNUM> is a numeric id of an article in the current newsgroup, and
725 will change the current article pointer. C<MSGID> is the message id of
726 an article as shown in that article's header. It is anticipated that the
727 client will obtain the C<MSGID> from a list provided by the C<newnews>
728 command, from references contained within another article, or from the
729 message-id provided in the response to some other commands.
731 If there is an error then C<undef> will be returned.
733 =item body ( [ MSGID|MSGNUM ], [FH] )
735 Like C<article> but only fetches the body of the article.
737 =item head ( [ MSGID|MSGNUM ], [FH] )
739 Like C<article> but only fetches the headers for the article.
741 =item nntpstat ( [ MSGID|MSGNUM ] )
743 The C<nntpstat> command is similar to the C<article> command except that no
744 text is returned. When selecting by message number within a group,
745 the C<nntpstat> command serves to set the "current article pointer" without
748 Using the C<nntpstat> command to
749 select by message-id is valid but of questionable value, since a
750 selection by message-id does B<not> alter the "current article pointer".
752 Returns the message-id of the "current article".
754 =item group ( [ GROUP ] )
756 Set and/or get the current group. If C<GROUP> is not given then information
757 is returned on the current group.
759 In a scalar context it returns the group name.
761 In an array context the return value is a list containing, the number
762 of articles in the group, the number of the first article, the number
763 of the last article and the group name.
765 =item ihave ( MSGID [, MESSAGE ])
767 The C<ihave> command informs the server that the client has an article
768 whose id is C<MSGID>. If the server desires a copy of that
769 article, and C<MESSAGE> has been given the it will be sent.
771 Returns I<true> if the server desires the article and C<MESSAGE> was
772 successfully sent,if specified.
774 If C<MESSAGE> is not specified then the message must be sent using the
775 C<datasend> and C<dataend> methods from L<Net::Cmd>
777 C<MESSAGE> can be either an array of lines or a reference to an array.
781 Set the "current article pointer" to the previous article in the current
784 Returns the message-id of the article.
788 Returns the date on the remote server. This date will be in a UNIX time
789 format (seconds since 1970)
793 C<postok> will return I<true> if the servers initial response indicated
794 that it will allow posting.
796 =item authinfo ( USER, PASS )
800 Obtain information about all the active newsgroups. The results is a reference
801 to a hash where the key is a group name and each value is a reference to an
802 array. The elements in this array are:- the first article number in the group,
803 the last article number in the group and any information flags about the group.
805 =item newgroups ( SINCE [, DISTRIBUTIONS ])
807 C<SINCE> is a time value and C<DISTRIBUTIONS> is either a distribution
808 pattern or a reference to a list of distribution patterns.
809 The result is the same as C<list>, but the
810 groups return will be limited to those created after C<SINCE> and, if
811 specified, in one of the distribution areas in C<DISTRIBUTIONS>.
813 =item newnews ( SINCE [, GROUPS [, DISTRIBUTIONS ]])
815 C<SINCE> is a time value. C<GROUPS> is either a group pattern or a reference
816 to a list of group patterns. C<DISTRIBUTIONS> is either a distribution
817 pattern or a reference to a list of distribution patterns.
819 Returns a reference to a list which contains the message-ids of all news posted
820 after C<SINCE>, that are in a groups which matched C<GROUPS> and a
821 distribution which matches C<DISTRIBUTIONS>.
825 Set the "current article pointer" to the next article in the current
828 Returns the message-id of the article.
830 =item post ( [ MESSAGE ] )
832 Post a new article to the news server. If C<MESSAGE> is specified and posting
833 is allowed then the message will be sent.
835 If C<MESSAGE> is not specified then the message must be sent using the
836 C<datasend> and C<dataend> methods from L<Net::Cmd>
838 C<MESSAGE> can be either an array of lines or a reference to an array.
842 Tell the remote server that I am not a user client, but probably another
847 Quit the remote server and close the socket connection.
851 =head2 Extension methods
853 These methods use commands that are not part of the RFC977 documentation. Some
854 servers may not support all of them.
858 =item newsgroups ( [ PATTERN ] )
860 Returns a reference to a hash where the keys are all the group names which
861 match C<PATTERN>, or all of the groups if no pattern is specified, and
862 each value contains the description text for the group.
864 =item distributions ()
866 Returns a reference to a hash where the keys are all the possible
867 distribution names and the values are the distribution descriptions.
869 =item subscriptions ()
871 Returns a reference to a list which contains a list of groups which
872 are recommended for a new user to subscribe to.
874 =item overview_fmt ()
876 Returns a reference to an array which contain the names of the fields returned
879 =item active_times ()
881 Returns a reference to a hash where the keys are the group names and each
882 value is a reference to an array containing the time the groups was created
883 and an identifier, possibly an Email address, of the creator.
885 =item active ( [ PATTERN ] )
887 Similar to C<list> but only active groups that match the pattern are returned.
888 C<PATTERN> can be a group pattern.
890 =item xgtitle ( PATTERN )
892 Returns a reference to a hash where the keys are all the group names which
893 match C<PATTERN> and each value is the description text for the group.
895 =item xhdr ( HEADER, MESSAGE-SPEC )
897 Obtain the header field C<HEADER> for all the messages specified.
899 The return value will be a reference
900 to a hash where the keys are the message numbers and each value contains
901 the text of the requested header for that message.
903 =item xover ( MESSAGE-SPEC )
905 The return value will be a reference
906 to a hash where the keys are the message numbers and each value contains
907 a reference to an array which contains the overview fields for that
910 The names of the fields can be obtained by calling C<overview_fmt>.
912 =item xpath ( MESSAGE-ID )
914 Returns the path name to the file on the server which contains the specified
917 =item xpat ( HEADER, PATTERN, MESSAGE-SPEC)
919 The result is the same as C<xhdr> except the is will be restricted to
920 headers where the text of the header matches C<PATTERN>
924 The XROVER command returns reference information for the article(s)
927 Returns a reference to a HASH where the keys are the message numbers and the
928 values are the References: lines from the articles
930 =item listgroup ( [ GROUP ] )
932 Returns a reference to a list of all the active messages in C<GROUP>, or
933 the current group if C<GROUP> is not specified.
937 Tell the server that you are a reader and not another server.
939 This is required by some servers. For example if you are connecting to
940 an INN server and you have transfer permission your connection will
941 be connected to the transfer daemon, not the NNTP daemon. Issuing
942 this command will cause the transfer daemon to hand over control
945 Some servers do not understand this command, but issuing it and ignoring
946 the response is harmless.
952 The following NNTP command are unsupported by the package, and there are
966 C<MESSAGE-SPEC> is either a single message-id, a single message number, or
967 a reference to a list of two message numbers.
969 If C<MESSAGE-SPEC> is a reference to a list of two message numbers and the
970 second number in a range is less than or equal to the first then the range
971 represents all messages in the group after the first message number.
973 B<NOTE> For compatibility reasons only with earlier versions of Net::NNTP
974 a message spec can be passed as a list of two numbers, this is deprecated
975 and a reference to the list should now be passed
979 The C<NNTP> protocol uses the C<WILDMAT> format for patterns.
980 The WILDMAT format was first developed by Rich Salz based on
981 the format used in the UNIX "find" command to articulate
982 file names. It was developed to provide a uniform mechanism
983 for matching patterns in the same manner that the UNIX shell
986 Patterns are implicitly anchored at the
987 beginning and end of each string when testing for a match.
989 There are five pattern matching operations other than a strict
990 one-to-one match between the pattern and the source to be
993 The first is an asterisk C<*> to match any sequence of zero or more
996 The second is a question mark C<?> to match any single character. The
997 third specifies a specific set of characters.
999 The set is specified as a list of characters, or as a range of characters
1000 where the beginning and end of the range are separated by a minus (or dash)
1001 character, or as any combination of lists and ranges. The dash can
1002 also be included in the set as a character it if is the beginning
1003 or end of the set. This set is enclosed in square brackets. The
1004 close square bracket C<]> may be used in a set if it is the first
1005 character in the set.
1007 The fourth operation is the same as the
1008 logical not of the third operation and is specified the same
1009 way as the third with the addition of a caret character C<^> at
1010 the beginning of the test string just inside the open square
1013 The final operation uses the backslash character to
1014 invalidate the special meaning of the a open square bracket C<[>,
1015 the asterisk, backslash or the question mark. Two backslashes in
1016 sequence will result in the evaluation of the backslash as a
1017 character with no special meaning.
1025 matches any single character other than a close square
1026 bracket or a minus sign/dash.
1030 matches any string that ends with the string "bdc"
1031 including the string "bdc" (without quotes).
1033 =item C<[0-9a-zA-Z]>
1035 matches any single printable alphanumeric ASCII character.
1039 matches any four character string which begins
1040 with a and ends with d.
1052 Graham Barr <gbarr@pobox.com>
1056 Copyright (c) 1995-1997 Graham Barr. All rights reserved.
1057 This program is free software; you can redistribute it and/or modify
1058 it under the same terms as Perl itself.