1# -*-Perl-*-
2################################################################
3###
4###			       Nntp.pm
5###
6### Author:  Internet Message Group <img@mew.org>
7### Created: Apr 23, 1997
8### Revised: Apr 23, 2007
9###
10
11my $PM_VERSION = "IM::Nntp.pm version 20161010(IM153)";
12
13package IM::Nntp;
14require 5.003;
15require Exporter;
16
17use Fcntl;
18use IM::Config qw(nntphistoryfile nntpservers nntpauthuser set_nntpauthuser
19	nntp_timeout);
20use IM::TcpTransaction;
21use IM::Util;
22use integer;
23use strict;
24use vars qw(@ISA @EXPORT);
25
26@ISA = qw(Exporter);
27@EXPORT = qw(
28    nntp_open
29    nntp_close
30    nntp_transaction
31    nntp_article
32    nntp_list
33    nntp_command
34    nntp_command_response
35    nntp_next_response
36    nntp_get_message
37    nntp_get_msg
38    nntp_head_as_string
39    nntp_spec
40);
41
42use vars qw($Nntp_opened *NNTPd $NntpErrTitle);
43
44##### NNTP SESSION OPENING #####
45#
46# nntp_open(server_list)
47#	server_list:
48#	return value:
49#		 0: success
50#		 1: recoverable error (should be retried)
51#		-1: unrecoverable error
52#
53sub nntp_open($$) {
54    my($servers, $logging) = @_;
55    my $rc;
56
57    if ($Nntp_opened) {
58	return 0 if (grep(&get_cur_server_original_form() eq $_, @$servers));
59	&nntp_close;
60    }
61    &tcp_logging($logging);
62    *NNTPd = &connect_server($servers, 'nntp', 0);
63    return 1 if ($NNTPd eq '');
64    $NntpErrTitle = "(while talking to " . &get_cur_server() . " with nntp)\n";
65    if ($rc = &tcp_command(\*NNTPd, '', '')) {
66	return $rc;
67    }
68    my(@resp) = &command_response;
69    if ($resp[0] =~ /InterNetNews server INN/) {
70	return 1 if (&tcp_command(\*NNTPd, 'MODE reader', ''));
71    }
72    $Nntp_opened = 1;
73    return 0;
74}
75
76##### NNTP SESSION CLOSING #####
77#
78# nntp_close()
79#	return value:
80#		 0: success
81#		 1: recoverable error (should be retried)
82#		-1: unrecoverable error
83#
84sub nntp_close() {
85    return 0 unless ($Nntp_opened);
86    $Nntp_opened = 0;
87    im_notice("closing NNTP session.\n");
88    return 1 if (&tcp_command(\*NNTPd, 'QUIT', ''));
89    close(NNTPd);
90    return 0;
91}
92
93##### NNTP TRANSACTION MANAGEMENT #####
94#
95# nntp_transaction(server_list, header, body, group, part, total, authuser)
96#	server_list: list of NNTP servers
97#	group: news group to be posted in
98#	part: part number to be sent in partial message mode
99#	total: total number of partial messages
100#	authuser: User name for NNTP authentication
101#	return value:
102#		 0: success
103#		 1: recoverable error (should be retried)
104#		-1: unrecoverable error
105#
106sub nntp_transaction($$$$$$$) {
107    my($servers, $Header, $Body, $group, $part, $total, $authuser) = @_;
108    my $rc;
109
110    require IM::Log && import IM::Log;
111
112    &set_nntpauthuser($authuser);
113    do {
114	$rc = &nntp_transact_sub($servers, $Header, $Body, $part, $total);
115	my(@resp) = &command_response;
116	if ($rc) {
117	    &im_warn($NntpErrTitle . join("\n", @resp) . "\n");
118	    $NntpErrTitle = '';
119	    &nntp_close;
120	    &log_action('nntp', &get_cur_server(), $group,
121			($#$servers >= 0) ? 'skipped' : 'failed', @resp);
122	    return -1 if ($rc < 0);
123            return -1 if (grep(/^(435|437|440|441)/, @resp) > 0);
124	} else {
125	    &log_action('nntp', &get_cur_server(), $group, 'sent', @resp);
126	}
127    } while ($rc > 0 && $#$servers >= 0);
128    return $rc;
129}
130
131##### NNTP TRANSACTION MANAGEMENT SUBROUTINE #####
132#
133# nntp_transact_sub(server_list, part, total)
134#	server_list: list of NNTP servers
135#	part: part number to be sent in partial message mode
136#	total: total number of partial messages
137#	return value:
138#		 0: success
139#		 1: recoverable error (should be retried)
140#		-1: unrecoverable error
141#
142sub nntp_transact_sub($$$$$) {
143    my($servers, $Header, $Body, $part, $total) = @_;
144    my $rc;
145
146    return $rc if ($rc = &nntp_open($servers, 1));
147    return -1 if (($rc = &nntp_command("POST")) < 0);
148
149    select (NNTPd); $| = 0; select (STDOUT);
150
151    require IM::Message && import IM::Message;
152
153    &set_crlf("\r\n");
154    if ($part == 0) {
155	return 1 if (&put_header(\*NNTPd, $Header, 'nntp', 'all') < 0);
156	return 1 if (&put_body(\*NNTPd, $Body, 1, 0) < 0);
157    } else {
158	return 1 if (&put_mimed_partial(\*NNTPd, $Header, $Body,
159	  'nntp', 1, $part, $total) < 0);
160    }
161    select (NNTPd); $| = 1; select (STDOUT);
162    return $rc if ($rc = &tcp_command(\*NNTPd, '.', ''));
163    return 0;
164}
165
166sub nntp_head_as_string($) {
167    my $i = shift;
168    my($rc, $count) = ('', 0);
169    local $_;
170
171    im_notice("getting article $i.\n");
172    $rc = &tcp_command(\*NNTPd, "HEAD $i", '');
173    if ($rc != 0) {
174	im_warn("HEAD command failed.\n");
175	return -1;
176    }
177    $count++;
178    my($found, $f) = (0, '');
179    alarm(nntp_timeout()) unless win95p();
180    while (<NNTPd>) {
181	alarm(0) unless win95p();
182	s/\r\n$/\n/;
183	last if ($_ =~ /^\.\n$/);
184	s/^\.//;
185	im_debug($_) if (&debug('nntp'));
186	$f .= $_;
187    }
188    alarm(0) unless win95p();
189    if (!defined($_)) {
190	# may be channel trouble
191	im_warn("lost connection for HEAD.\n");
192	return -1;
193    }
194    return $f;
195}
196
197sub nntp_head($$) {
198    my($art_start, $art_end) = @_;
199    local $_;
200    my $count = 0;
201
202    my $i;
203    for ($i = $art_start; $i <= $art_end; $i++) {
204	im_notice("getting article $i.\n");
205	my $rc = &tcp_command(\*NNTPd, "HEAD $i", '');
206	next if ($rc > 0);
207	if ($rc < 0) {
208	    im_warn("HEAD command failed.\n");
209	    return -1;
210	}
211	$count++;
212	my($found, $f) = (0, '');
213	alarm(nntp_timeout()) unless win95p();
214	while (<NNTPd>) {
215	    alarm(0) unless win95p();
216	    s/\r\n$/\n/;
217	    last if ($_ =~ /^\.\n$/);
218	    s/^\.//;
219	    im_debug($_) if (&debug('nntp'));
220	    if ($f eq '' && /^From:\s*(.*)/i) {
221		$found = 1;
222		$f = $1;
223	    } elsif (/^\s/ && $found) {
224		$f .= $_;
225	    } else {
226		$found = 0;
227	    }
228	}
229	alarm(0) unless win95p();
230	if (!defined($_)) {
231	    # may be channel trouble
232	    im_warn("lost connection for HEAD.\n");
233	    return -1;
234	}
235	$f =~ s/\n[ \t]*/ /g;
236	$f = '(sender unknown)' unless ($f);
237	print "From $f\n";
238    }
239    return $count;
240}
241
242sub nntp_xover($$) {
243    my($art_start, $art_end) = @_;
244    my $rc = &tcp_command(\*NNTPd, "XOVER $art_start-$art_end", '');
245
246    if ($rc) {
247	im_warn("XOVER command failed.\n");
248	return -1;
249    }
250    my $count = 0;
251    my($resp);
252    while (($resp = &next_response(\*NNTPd)) !~ /^\.$/) {
253	$count++;
254	my @overview = split('\t', $resp);
255
256	# 0: article number
257	# 1: Subject:
258	# 2: From:
259	# 3: Date:
260	# 4: Message-ID:
261	# 5: References:
262	# 6: Bytes:
263	# 7: Lines:
264
265	print "From $overview[2]\n";
266    }
267    return $count;
268}
269
270sub nntp_article($) {
271    my $num = shift;
272    local $_;
273#   local(@Article);
274
275    im_debug("getting article $num.\n") if (&debug('nntp'));
276    my $rc = &tcp_command(\*NNTPd, "ARTICLE $num", '');
277    return(1, '') if ($rc > 0);
278    if ($rc < 0) {
279	im_warn("ARTICLE command failed.\n");
280	return(-1, '');
281    }
282    my @Article = ();
283    alarm(nntp_timeout()) unless win95p();
284    while (<NNTPd>) {
285	alarm(0) unless win95p();
286	s/\r\n$/\n/;
287	last if ($_ =~ /^\.\n$/);
288	s/^\.//;
289	push (@Article, $_);
290	im_debug($_) if (&debug('nntp'));
291    }
292    alarm(0) unless win95p();
293    if (!defined($_)) {
294	# may be channel trouble
295	im_warn("lost connection for ARTICLE.\n");
296	return(-1, '');
297    }
298    return(0, \@Article);
299}
300
301sub nntp_articles($$$$) {
302    my($art_start, $art_end, $dst, $limit) = @_;
303    my($rc, $article);
304    my $count = 0;
305    my $last = 0;
306
307    my $i;
308    require IM::MsgStore && import IM::MsgStore;
309    for ($i = $art_start; $i <= $art_end; $i++) {
310	($rc, $article) = &nntp_article($i);
311	next if ($rc > 0);
312	if ($rc < 0) {
313	    return -1 if ($i == $art_start);
314	    im_warn("some articles left due to failure.\n");
315	    $last = $i-1;
316	    nntp_close();
317	    last;
318	}
319	$count++;
320
321	return -1 if (&store_message($article, $dst) < 0);
322	$last = $i;
323	last if ($limit && --$limit == 0);
324    }
325    &exec_getsbrfile($dst);
326    return($count, $last);
327}
328
329sub nntp_list($) {
330    my $group = shift;
331    local $_;
332    my $rc;
333
334    return -1 if (($rc = &nntp_command("LIST ACTIVE")) < 0);
335    if ($rc) {
336	im_warn("LIST command failed.\n");
337	return -1;
338    }
339    my $count = 0;
340    my $resp;
341    while (($resp = &next_response(\*NNTPd)) !~ /^\.$/) {
342	next unless (/^$group/);
343	$count++;
344	print "$resp\n";
345    }
346    return $count;
347}
348
349sub nntp_command($) {
350    my $cmd = shift;
351    my $rc = &tcp_command(\*NNTPd, $cmd, '');
352
353    return -1 if ($rc < 0);
354    if ($rc > 0) {
355	my($res) = &command_response();
356	if ($res =~ /^480/) {
357	    require IM::GetPass && import IM::GetPass;
358
359#	    print "Username: ";
360#	    my $user = <STDIN>;
361#	    chomp($user);
362	    my $user = &nntpauthuser() ||
363		$ENV{'USER'} || $ENV{'LOGNAME'} || im_getlogin();
364	    my $host = get_cur_server();
365	    my($pass, $agtfound, $interact)
366		= getpass('nntp', 'PASS', $host, $user);
367
368	    # authenticate for posting
369	    return $rc
370	      if ($rc = &tcp_command(\*NNTPd, "AUTHINFO USER $user", ''));
371	    return $rc
372	      if ($rc = &tcp_command(\*NNTPd, "AUTHINFO PASS $pass",
373		"AUTHINFO PASS " . "*" x length($pass)));
374	    $rc = &tcp_command(\*NNTPd, $cmd, '');
375	    return -1 if ($rc < 0);
376	}
377    }
378    return $rc;
379}
380
381sub nntp_command_response() {
382    return &command_response;
383}
384
385sub nntp_next_response() {
386    return &next_response(\*NNTPd);
387}
388
389sub set_last_article_number($$$) {
390    my($server, $group, $number) = @_;
391    my($pos, $last, $size) = (0, 0, 0);
392
393    $server =~ s!\%\d+$!!;
394    $server =~ s!/\d+$!!;
395    my $nntphist = &nntphistoryfile() . '-' . $server;
396    if (-f $nntphist) {
397	im_open(\*NEWSHIST, "+<$nntphist");
398	while ($pos = tell(NEWSHIST), $_ = <NEWSHIST>) {
399	    /^([^:]+):\s*(\d+)/;
400	    if ($group eq $1) {
401		$last = $2;
402		im_debug("$last articles in $group ($nntphist)\n")
403		  if (&debug('nntp'));
404		seek(NEWSHIST, $pos, 0);
405		$size = length($_) - length("$group: 0000000\n");
406		if ($size < 0) {
407		    # no room to rewrite it
408		    s/^./#/;
409		    print NEWSHIST $_;
410		    seek(NEWSHIST, 0, 2);
411		    $size = 0;
412		}
413		printf NEWSHIST "$group: %${size}s%07d\n", '', $number;
414		close (NEWSHIST);
415		return $last;
416	    }
417	  }
418    } else {
419#	open (NEWSHIST, ">$nntphist");
420	im_sysopen(\*NEWSHIST, $nntphist, O_RDWR()|O_CREAT());
421    }
422    seek(NEWSHIST, 0, 2);
423    printf NEWSHIST "$group: %${size}s%07d\n", '', $number;
424    close (NEWSHIST);
425    return $last;
426}
427
428sub get_last_article_number($$) {
429    my($server, $group) = @_;
430    local $_;
431    my $number = 0;
432
433    $server =~ s!\%\d+$!!;
434    $server =~ s!/\d+$!!;
435    my $nntphist = &nntphistoryfile() . '-' . $server;
436    if (im_open(\*NEWSHIST, "<$nntphist")) {
437	while (<NEWSHIST>) {
438	    /^([^:]+):\s*(\d+)/;
439	    if ($group eq $1) {
440		$number = $2;
441		last;
442	    }
443	}
444	close (NEWSHIST);
445    }
446    return $number;
447}
448
449
450sub nntp_get_message($$) {
451    my($src, $msg) = @_;
452    my($rc, $art);
453    my($group, $srvs) = nntp_spec($src, nntpservers());
454    my @servers = split(',', $srvs);
455    im_notice("accessing to $group on $srvs.\n");
456    do {
457	if (($rc = nntp_open(\@servers, 0)) < 0) {
458	    return(-1, "cannot connect $srvs.\n");
459	}
460	if (($group ne '') && ($rc = nntp_command("GROUP $group")) < 0) {
461	    return(-1, "cannot access $group.\n");
462	}
463    } while (@servers > 0 && $rc > 0);
464    return(-1, "cannot access $group on $srvs.\n") if ($rc);
465    ($rc, $art) = nntp_article($msg);
466    nntp_close();
467    return(-1, "no message $msg in -$group.\n") if ($rc);
468    return(0, $art);
469}
470
471# returns number of got articles
472# -1 if error
473sub nntp_get_msg($$$$) {
474    my($src, $dst, $how, $limit) = @_;
475    my($rc, $group, $error, $art_start, $art_end);
476    my($servers, @servers);
477
478    if ($src =~ /^nntp:(.*)/i || $src =~ /^news:(.*)/i) {
479	($group, $servers) = &nntp_spec($1, nntpservers());
480	@servers = split(',', $servers);
481    } else {
482	im_warn("no news group specified ($src).\n");
483	return -1;
484    }
485
486    im_notice("accessing to $group at $servers.\n");
487
488    do {
489	if (($rc = &nntp_open(\@servers, 0)) < 0) {
490	    im_warn("Connection failed to $servers.\n");
491	    return -1;
492	}
493	return -1 if (($rc = &nntp_command("GROUP $group")) < 0);
494    } while (@servers > 0 && $rc > 0);
495    return -1 if ($rc);
496
497    my(@resp) = &command_response;
498    $error = 0;
499    my $i;
500    for ($i = 0; $i <= $#resp; $i++) {
501	if ($resp[0] =~ /^211 (\d+) (\d+) (\d+) (\S+)/) {
502	    if ($4 ne $group) {
503		# Should not occur
504		$error = 1;
505	    } else {
506		$art_start = $2;
507		$art_end = $3;
508	    }
509	    last;
510	}
511    }
512
513    if ($error) {
514	&nntp_close;
515	return -1;
516    }
517
518    my($art_last, $msgs);
519    $art_last = &get_last_article_number($servers, $group);
520    if ($art_end > $art_last) {
521	# new articles
522	if ($art_start < $art_last) {
523	    $art_start = $art_last + 1;
524	}
525	$msgs = $art_end - $art_start + 1;
526    } else {
527	$msgs = 0;
528    }
529
530    if ($how eq 'skip') {
531#	&nntp_close;
532	my $last = &set_last_article_number($servers, $group, $art_end);
533	if ($last < $art_end) {
534	    my $num = $art_end - $last;
535	    im_info("$num article(s) have been marked "
536	      ."as read in $group at $servers.\n");
537	} else {
538	    im_info("no news in $group at $servers.\n");
539	}
540	return $msgs;
541    }
542
543    if ($how eq 'check') {
544	if ($msgs > 0) {
545	    im_info("$msgs news in $group at $servers.\n");
546	} else {
547	    im_info("no news in $group at $servers.\n");
548	}
549#	&nntp_close;
550	return $msgs;
551    }
552
553    if ($how eq 'from') {
554	if ($msgs > 0) {
555	    $msgs = &nntp_xover($art_start, $art_end);
556	    $msgs = &nntp_head($art_start, $art_end) if ($msgs < 0);
557	    if ($msgs < 0) {
558		im_warn("cannot get article poster information.\n");
559		return -1;
560	    }
561	    im_info("$msgs article(s) in $group at $servers.\n");
562	} else {
563	    im_info("no news in $group at $servers.\n");
564	}
565#	&nntp_close;
566	return $msgs;
567    }
568
569    if ($how eq 'get') {
570	my($last);
571	if ($msgs > 0) {
572	    im_info("Getting new messages from $group at $servers into $dst...\n");
573	    ($msgs, $last) = &nntp_articles($art_start, $art_end, $dst, $limit);
574	    if ($msgs < 0) {
575		im_warn("cannot get articles.\n");
576		return -1;
577	    }
578	    im_info("$msgs message(s).\n");
579	} else {
580	    im_info("no messages in $group at $servers.\n");
581	}
582#	&nntp_close;
583	&set_last_article_number($servers, $group, $last) if ($last);
584	return $msgs;
585    }
586
587    return -1;
588}
589
590# News group (-group[@server])
591sub nntp_spec($$) {
592    my($spec, $server) = @_;
593    my $group;
594
595    if ($spec =~ /^-(.*)/) {
596	$group = $1;
597    } elsif ($spec =~ /([^@]*)\@(.*)/) {
598	$group = $1;
599	$server = $2;
600    } else {
601	$group = $spec;
602    }
603    return($group, $server);
604}
605
6061;
607
608__END__
609
610=head1 NAME
611
612IM::Nntp - NNTP hanlder
613
614=head1 SYNOPSIS
615
616 use IM::Nntp;
617
618 $return_code = &nntp_transaction(server_list, newsgroups,
619     part_current, part_total, authuser);
620 $return_code = &nntp_close;
621
622Other subroutines:
623nntp_open
624nntp_article
625nntp_list
626nntp_command
627nntp_command_response
628nntp_next_response
629nntp_get_message
630nntp_get_msg
631nntp_head_as_string
632nntp_spec
633
634=head1 DESCRIPTION
635
636The I<IM::Nntp> module handles NNTP.
637
638This modules is provided by IM (Internet Message).
639
640=head1 COPYRIGHT
641
642IM (Internet Message) is copyrighted by IM developing team.
643You can redistribute it and/or modify it under the modified BSD
644license.  See the copyright file for more details.
645
646=cut
647
648### Copyright (C) 1997, 1998, 1999 IM developing team
649### All rights reserved.
650###
651### Redistribution and use in source and binary forms, with or without
652### modification, are permitted provided that the following conditions
653### are met:
654###
655### 1. Redistributions of source code must retain the above copyright
656###    notice, this list of conditions and the following disclaimer.
657### 2. Redistributions in binary form must reproduce the above copyright
658###    notice, this list of conditions and the following disclaimer in the
659###    documentation and/or other materials provided with the distribution.
660### 3. Neither the name of the team nor the names of its contributors
661###    may be used to endorse or promote products derived from this software
662###    without specific prior written permission.
663###
664### THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
665### ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
666### IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
667### PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE
668### LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
669### CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
670### SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
671### BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
672### WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
673### OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
674### IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
675