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