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