#/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 = <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";
<NNTP>;

$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 = <CHECKPOINT>;
	close CHECKPOINT;
	while (<TMP>) {
	    last if $_ eq $did;
	}
	seek(TMP,0,0) unless $_ eq $did;
    }

    &start;
    select(RNEWS); $| = 1; select(STDOUT);

    $pct = 0;
    $pos = 0;
    while (<TMP>) {
	$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);
	$_ = <NNTP>;
	$_ ne '' || &croak("NNTP connection to $SERVER shut down");

	/^220/ || (warn("Not 220 on $article: $_\n"),next);

	$art = '';
	while (<NNTP>) {
	    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 (<NNTP>) {
    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";
}