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