#/usr/local/bin/dbzperl ($SERVER) = @ARGV; $CNEWS = 1; $TIMEOUT = 15 * 60; $LIB = '/usr/lib/news'; $INCOMING = '/usr/spool/news/in.coming'; $CHOKE = 10240; # allow at least 10M in partition $todo = "todo.$SERVER"; dbmopen(dhist,"$LIB/history",0666) || die "Can't open history dbm file: $!\n"; chdir $INCOMING || die "Can't cd to $INCOMING: $!\n"; require "$LIB/available.pl"; &available('.', $CHOKE) || &croak("not enough disk space"); if (open(PID, "$todo/.fetch2pid")) { chop($pid = ); if (`/bin/ps ww$pid` =~ /fetch/) { die "locked " . `date`; } } open(PID, ">$todo/.fetch2pid"); print PID $$,"\n"; close PID; open(STDOUT,">>$todo/fetch2.log"); open(STDERR,">&STDOUT"); @todo = &read_todo; exit 0 unless @todo; # Open the connection. $pat = 'S n C4 x8'; $af_unix = 1; $af_inet = 2; $stream = 1; $datagram = 2; ($name,$aliases,$proto) = getprotobyname('tcp'); $tcp = $proto; ($name,$aliase,$port,$proto) = getservbyname('nntp','tcp'); $nntp = $port; if ($SERVER =~ /^\d+\./) { @bytes = split(/\./,$SERVER); } else { ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($SERVER); die "Can't lookup $SERVER\n" unless $name; @bytes = unpack("C4",$addrs[0]); } $this = pack($pat,$af_inet,0, 0,0,0,0); $that = pack($pat,$af_inet,$nntp,@bytes); socket(NNTP,$af_inet,$stream,$tcp) || die "socket: $!\n"; bind(NNTP,$this) || die "bind: $!\n"; connect(NNTP,$that) || die "connect: $!\n"; ; $SIG{HUP} = HUP; $SIG{PIPE} = PIPE; $SIG{ALRM} = ALRM; $SIG{TERM} = 'croak'; select(NNTP); $| = 1; select(STDERR); $| = 1; select(STDOUT); $| = 1; print STDERR "\nConnected to NNTP server at $SERVER (",join('.',@bytes),").\n"; while ((@todo = &read_todo)) { $totalsize = 0; for (@todo) { $totalsize += -s "$todo/$_"; } $batch = shift(@todo); open(TMP,"$todo/$batch") || die "Can't open $todo/$batch: $!"; $tmpsize = -s TMP; $^T = time; $age = sprintf("%.2f", -M TMP); print STDERR "Starting $batch: ",`date`; if (open(CHECKPOINT, "$todo/.lastfetch")) { $did = ; close CHECKPOINT; while () { last if $_ eq $did; } seek(TMP,0,0) unless $_ eq $did; } &start; select(RNEWS); $| = 1; select(STDOUT); $pct = 0; $pos = 0; while () { $line = $.; chop; $article = $_; $remainingsize = $totalsize - $pos; $remainingarts = int($remainingsize / 34.35); $0 = "(fetch2 $remainingarts to do, $age days old, $pct% thru $batch)"; if ($dhist{"$article\0"} ne '') { print STDERR "DONE $article\n"; next; } print NNTP "article $_\r\n"; alarm($TIMEOUT); $_ = ; $_ ne '' || &croak("NNTP connection to $SERVER shut down"); /^220/ || (warn("Not 220 on $article: $_\n"),next); $art = ''; while () { s/\r\n$/\n/; last if $_ eq ".\n"; s/^\.\././; $art .= $_; } $_ ne '' || &croak("NNTP connection to $SERVER shut down"); print RNEWS "#! rnews ", length($art), " ", $SERVER, "\n"; print(RNEWS $art) || &croak("I/O error on print to batch: $!"); print STDERR "OK $article\n"; $size += length($art); if (++$arts >= 50 || $size > 300000) { &finish; &checkpoint; &start; } $pos = tell(TMP); $pct = int($pos / $tmpsize * 100); } &finish; &uncheckpoint; } alarm(60); print NNTP "quit\n"; while () { last if /^205/; } &croak("done " . `date`); ############################################################################ sub PIPE { &croak("Died on SIGPIPE"); } sub HUP { &croak("Died on SIGHUP"); } sub ALRM { &croak("NNTP connection timed out"); } sub finish { $now = time; close(RNEWS); if (-f "fetch.$$") { until (link("fetch.$$", $now)) { $now++; } } print STDERR "BATCH $now ($batch line $line), $arts articles, $size bytes \n", `date`; unlink "fetch.$$"; $arts = 0; $size = 0; } sub checkpoint { open(CHECKPOINT, ">.lastfetch"); print CHECKPOINT $article,"\n"; close CHECKPOINT; } sub uncheckpoint { unlink ".lastfetch", "$todo/$batch"; } sub start { &available('.', 400) || &croak("not enough disk space"); open(RNEWS, ">fetch.$$"); $arts = 0; $size = 0; } sub read_todo { opendir(TODO, $todo) || die "Can't read $INCOMING/$todo: $!\n"; local(@list) = readdir(TODO); closedir(TODO); grep(/^\d+$/, sort @list); } sub croak { warn $_[0] . "\n"; &finish if $arts; unlink "$todo/.fetch2pid"; exec "/usr/lib/news/fetch2" if $_[0] =~ /HUP/; exit $_[0] ne "done"; }