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