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.20"; # $Id: //depot/libnet/Net/NNTP.pm#13 $
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] ];
518 if(defined $spec->[1])
521 if $spec->[1] != $spec->[0];
523 if $spec->[1] > $spec->[0];
538 my @g = reverse((gmtime($time))[0..5]);
541 sprintf "%02d%02d%02d %02d%02d%02d GMT", @g;
547 my $arr = $nntp->read_until_dot or
555 my @a = split(/[\s\n]+/,$ln);
556 $hash->{$a[0]} = [ @a[1,2,3] ];
565 my $arr = $nntp->read_until_dot or
573 my @a = split(/[\t\n]/,$ln);
575 $hash->{$m} = [ @a ];
584 my $arr = $nntp->read_until_dot;
595 my $arr = $nntp->read_until_dot or
606 if $ln =~ s/^\s*(\S+)\s*//o;
617 sub _ARTICLE { shift->command('ARTICLE',@_)->response == CMD_OK }
618 sub _AUTHINFO { shift->command('AUTHINFO',@_)->response }
619 sub _BODY { shift->command('BODY',@_)->response == CMD_OK }
620 sub _DATE { shift->command('DATE')->response == CMD_INFO }
621 sub _GROUP { shift->command('GROUP',@_)->response == CMD_OK }
622 sub _HEAD { shift->command('HEAD',@_)->response == CMD_OK }
623 sub _HELP { shift->command('HELP',@_)->response == CMD_INFO }
624 sub _IHAVE { shift->command('IHAVE',@_)->response == CMD_MORE }
625 sub _LAST { shift->command('LAST')->response == CMD_OK }
626 sub _LIST { shift->command('LIST',@_)->response == CMD_OK }
627 sub _LISTGROUP { shift->command('LISTGROUP',@_)->response == CMD_OK }
628 sub _NEWGROUPS { shift->command('NEWGROUPS',@_)->response == CMD_OK }
629 sub _NEWNEWS { shift->command('NEWNEWS',@_)->response == CMD_OK }
630 sub _NEXT { shift->command('NEXT')->response == CMD_OK }
631 sub _POST { shift->command('POST',@_)->response == CMD_MORE }
632 sub _QUIT { shift->command('QUIT',@_)->response == CMD_OK }
633 sub _SLAVE { shift->command('SLAVE',@_)->response == CMD_OK }
634 sub _STAT { shift->command('STAT',@_)->response == CMD_OK }
635 sub _MODE { shift->command('MODE',@_)->response == CMD_OK }
636 sub _XGTITLE { shift->command('XGTITLE',@_)->response == CMD_OK }
637 sub _XHDR { shift->command('XHDR',@_)->response == CMD_OK }
638 sub _XPAT { shift->command('XPAT',@_)->response == CMD_OK }
639 sub _XPATH { shift->command('XPATH',@_)->response == CMD_OK }
640 sub _XOVER { shift->command('XOVER',@_)->response == CMD_OK }
641 sub _XROVER { shift->command('XROVER',@_)->response == CMD_OK }
642 sub _XTHREAD { shift->unsupported }
643 sub _XSEARCH { shift->unsupported }
644 sub _XINDEX { shift->unsupported }
653 defined(fileno($nntp)) && $nntp->quit
663 Net::NNTP - NNTP Client class
669 $nntp = Net::NNTP->new("some.host.name");
674 C<Net::NNTP> is a class implementing a simple NNTP client in Perl as described
675 in RFC977. C<Net::NNTP> inherits its communication methods from C<Net::Cmd>
681 =item new ( [ HOST ] [, OPTIONS ])
683 This is the constructor for a new Net::NNTP object. C<HOST> is the
684 name of the remote host to which a NNTP connection is required. If not
685 given two environment variables are checked, first C<NNTPSERVER> then
686 C<NEWSHOST>, then C<Net::Config> is checked, and if a host is not found
687 then C<news> is used.
689 C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
690 Possible options are:
692 B<Timeout> - Maximum time, in seconds, to wait for a response from the
693 NNTP server, a value of zero will cause all IO operations to block.
696 B<Debug> - Enable the printing of debugging information to STDERR
698 B<Reader> - If the remote server is INN then initially the connection
699 will be to nnrpd, by default C<Net::NNTP> will issue a C<MODE READER> command
700 so that the remote server becomes innd. If the C<Reader> option is given
701 with a value of zero, then this command will not be sent and the
702 connection will be left talking to nnrpd.
708 Unless otherwise stated all methods return either a I<true> or I<false>
709 value, with I<true> meaning that the operation was a success. When a method
710 states that it returns a value, failure will be returned as I<undef> or an
715 =item article ( [ MSGID|MSGNUM ], [FH] )
717 Retrieve the header, a blank line, then the body (text) of the
720 If C<FH> is specified then it is expected to be a valid filehandle
721 and the result will be printed to it, on sucess a true value will be
722 returned. If C<FH> is not specified then the return value, on sucess,
723 will be a reference to an array containg the article requested, each
724 entry in the array will contain one line of the article.
726 If no arguments are passed then the current article in the currently
727 selected newsgroup is fetched.
729 C<MSGNUM> is a numeric id of an article in the current newsgroup, and
730 will change the current article pointer. C<MSGID> is the message id of
731 an article as shown in that article's header. It is anticipated that the
732 client will obtain the C<MSGID> from a list provided by the C<newnews>
733 command, from references contained within another article, or from the
734 message-id provided in the response to some other commands.
736 If there is an error then C<undef> will be returned.
738 =item body ( [ MSGID|MSGNUM ], [FH] )
740 Like C<article> but only fetches the body of the article.
742 =item head ( [ MSGID|MSGNUM ], [FH] )
744 Like C<article> but only fetches the headers for the article.
746 =item nntpstat ( [ MSGID|MSGNUM ] )
748 The C<nntpstat> command is similar to the C<article> command except that no
749 text is returned. When selecting by message number within a group,
750 the C<nntpstat> command serves to set the "current article pointer" without
753 Using the C<nntpstat> command to
754 select by message-id is valid but of questionable value, since a
755 selection by message-id does B<not> alter the "current article pointer".
757 Returns the message-id of the "current article".
759 =item group ( [ GROUP ] )
761 Set and/or get the current group. If C<GROUP> is not given then information
762 is returned on the current group.
764 In a scalar context it returns the group name.
766 In an array context the return value is a list containing, the number
767 of articles in the group, the number of the first article, the number
768 of the last article and the group name.
770 =item ihave ( MSGID [, MESSAGE ])
772 The C<ihave> command informs the server that the client has an article
773 whose id is C<MSGID>. If the server desires a copy of that
774 article, and C<MESSAGE> has been given the it will be sent.
776 Returns I<true> if the server desires the article and C<MESSAGE> was
777 successfully sent,if specified.
779 If C<MESSAGE> is not specified then the message must be sent using the
780 C<datasend> and C<dataend> methods from L<Net::Cmd>
782 C<MESSAGE> can be either an array of lines or a reference to an array.
786 Set the "current article pointer" to the previous article in the current
789 Returns the message-id of the article.
793 Returns the date on the remote server. This date will be in a UNIX time
794 format (seconds since 1970)
798 C<postok> will return I<true> if the servers initial response indicated
799 that it will allow posting.
801 =item authinfo ( USER, PASS )
805 Obtain information about all the active newsgroups. The results is a reference
806 to a hash where the key is a group name and each value is a reference to an
807 array. The elements in this array are:- the last article number in the group,
808 the first article number in the group and any information flags about the group.
810 =item newgroups ( SINCE [, DISTRIBUTIONS ])
812 C<SINCE> is a time value and C<DISTRIBUTIONS> is either a distribution
813 pattern or a reference to a list of distribution patterns.
814 The result is the same as C<list>, but the
815 groups return will be limited to those created after C<SINCE> and, if
816 specified, in one of the distribution areas in C<DISTRIBUTIONS>.
818 =item newnews ( SINCE [, GROUPS [, DISTRIBUTIONS ]])
820 C<SINCE> is a time value. C<GROUPS> is either a group pattern or a reference
821 to a list of group patterns. C<DISTRIBUTIONS> is either a distribution
822 pattern or a reference to a list of distribution patterns.
824 Returns a reference to a list which contains the message-ids of all news posted
825 after C<SINCE>, that are in a groups which matched C<GROUPS> and a
826 distribution which matches C<DISTRIBUTIONS>.
830 Set the "current article pointer" to the next article in the current
833 Returns the message-id of the article.
835 =item post ( [ MESSAGE ] )
837 Post a new article to the news server. If C<MESSAGE> is specified and posting
838 is allowed then the message will be sent.
840 If C<MESSAGE> is not specified then the message must be sent using the
841 C<datasend> and C<dataend> methods from L<Net::Cmd>
843 C<MESSAGE> can be either an array of lines or a reference to an array.
847 Tell the remote server that I am not a user client, but probably another
852 Quit the remote server and close the socket connection.
856 =head2 Extension methods
858 These methods use commands that are not part of the RFC977 documentation. Some
859 servers may not support all of them.
863 =item newsgroups ( [ PATTERN ] )
865 Returns a reference to a hash where the keys are all the group names which
866 match C<PATTERN>, or all of the groups if no pattern is specified, and
867 each value contains the description text for the group.
869 =item distributions ()
871 Returns a reference to a hash where the keys are all the possible
872 distribution names and the values are the distribution descriptions.
874 =item subscriptions ()
876 Returns a reference to a list which contains a list of groups which
877 are recommended for a new user to subscribe to.
879 =item overview_fmt ()
881 Returns a reference to an array which contain the names of the fields returned
884 =item active_times ()
886 Returns a reference to a hash where the keys are the group names and each
887 value is a reference to an array containing the time the groups was created
888 and an identifier, possibly an Email address, of the creator.
890 =item active ( [ PATTERN ] )
892 Similar to C<list> but only active groups that match the pattern are returned.
893 C<PATTERN> can be a group pattern.
895 =item xgtitle ( PATTERN )
897 Returns a reference to a hash where the keys are all the group names which
898 match C<PATTERN> and each value is the description text for the group.
900 =item xhdr ( HEADER, MESSAGE-SPEC )
902 Obtain the header field C<HEADER> for all the messages specified.
904 The return value will be a reference
905 to a hash where the keys are the message numbers and each value contains
906 the text of the requested header for that message.
908 =item xover ( MESSAGE-SPEC )
910 The return value will be a reference
911 to a hash where the keys are the message numbers and each value contains
912 a reference to an array which contains the overview fields for that
915 The names of the fields can be obtained by calling C<overview_fmt>.
917 =item xpath ( MESSAGE-ID )
919 Returns the path name to the file on the server which contains the specified
922 =item xpat ( HEADER, PATTERN, MESSAGE-SPEC)
924 The result is the same as C<xhdr> except the is will be restricted to
925 headers where the text of the header matches C<PATTERN>
929 The XROVER command returns reference information for the article(s)
932 Returns a reference to a HASH where the keys are the message numbers and the
933 values are the References: lines from the articles
935 =item listgroup ( [ GROUP ] )
937 Returns a reference to a list of all the active messages in C<GROUP>, or
938 the current group if C<GROUP> is not specified.
942 Tell the server that you are a reader and not another server.
944 This is required by some servers. For example if you are connecting to
945 an INN server and you have transfer permission your connection will
946 be connected to the transfer daemon, not the NNTP daemon. Issuing
947 this command will cause the transfer daemon to hand over control
950 Some servers do not understand this command, but issuing it and ignoring
951 the response is harmless.
957 The following NNTP command are unsupported by the package, and there are
971 C<MESSAGE-SPEC> is either a single message-id, a single message number, or
972 a reference to a list of two message numbers.
974 If C<MESSAGE-SPEC> is a reference to a list of two message numbers and the
975 second number in a range is less than or equal to the first then the range
976 represents all messages in the group after the first message number.
978 B<NOTE> For compatibility reasons only with earlier versions of Net::NNTP
979 a message spec can be passed as a list of two numbers, this is deprecated
980 and a reference to the list should now be passed
984 The C<NNTP> protocol uses the C<WILDMAT> format for patterns.
985 The WILDMAT format was first developed by Rich Salz based on
986 the format used in the UNIX "find" command to articulate
987 file names. It was developed to provide a uniform mechanism
988 for matching patterns in the same manner that the UNIX shell
991 Patterns are implicitly anchored at the
992 beginning and end of each string when testing for a match.
994 There are five pattern matching operations other than a strict
995 one-to-one match between the pattern and the source to be
998 The first is an asterisk C<*> to match any sequence of zero or more
1001 The second is a question mark C<?> to match any single character. The
1002 third specifies a specific set of characters.
1004 The set is specified as a list of characters, or as a range of characters
1005 where the beginning and end of the range are separated by a minus (or dash)
1006 character, or as any combination of lists and ranges. The dash can
1007 also be included in the set as a character it if is the beginning
1008 or end of the set. This set is enclosed in square brackets. The
1009 close square bracket C<]> may be used in a set if it is the first
1010 character in the set.
1012 The fourth operation is the same as the
1013 logical not of the third operation and is specified the same
1014 way as the third with the addition of a caret character C<^> at
1015 the beginning of the test string just inside the open square
1018 The final operation uses the backslash character to
1019 invalidate the special meaning of the a open square bracket C<[>,
1020 the asterisk, backslash or the question mark. Two backslashes in
1021 sequence will result in the evaluation of the backslash as a
1022 character with no special meaning.
1030 matches any single character other than a close square
1031 bracket or a minus sign/dash.
1035 matches any string that ends with the string "bdc"
1036 including the string "bdc" (without quotes).
1038 =item C<[0-9a-zA-Z]>
1040 matches any single printable alphanumeric ASCII character.
1044 matches any four character string which begins
1045 with a and ends with d.
1057 Graham Barr <gbarr@pobox.com>
1061 Copyright (c) 1995-1997 Graham Barr. All rights reserved.
1062 This program is free software; you can redistribute it and/or modify
1063 it under the same terms as Perl itself.
1067 I<$Id: //depot/libnet/Net/NNTP.pm#13 $>