From: lwall@netlabs.com (Larry Wall)
Newsgroups: news.software.nntp
Subject: Re: Scritps for down loading news groups
Date: 13 Aug 92 17:19:23 GMT
Organization: NetLabs, Inc.

In article <16b4vbINNqs5@uk-news.UK.Sun.COM> simonb@playpen.uk.sun.com writes:
: Hi,
: 
: I am trying to get hold of any interesting sh,csh or perl scripts that will
: allow me to pull a number of files from a news server using NNTP. I have some
: thing called grabnews but I was wondering if there are any other ones I should
: be aware of.

These scripts are what we use to fetch news from NNTP and feed it to Cnews.
They're pretty bulletproof, and go to great pains to avoid fetching
articles that are already here.  The only catch is that you have to install
a version of Perl that has the dbz routines linked in, but that isn't
too hard.  Just put dbz.h and dbz.o in the right place and say "make dbzperl"
in the Perl source directory.

Larry Wall
lwall@netlabs.com

#!/bin/sh
: make a subdirectory, cd to it, and run this through sh.
echo 'If this kit is complete, "End of kit" will echo at the end'
echo Extracting fetch1
sed >fetch1 <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/local/bin/dbzperl
X
X($SERVER) = @ARGV;
X
X$CNEWS = 1;
X$TIMEOUT = 15 * 60;
X$LIB = '/usr/lib/news';
X$INCOMING = '/usr/spool/news/in.coming';
X$NEWSGROUPS = 'news.*,comp.*,sci.*,ba.*,biz.*,ca.*,ddn.*,gnu.*,info.*,la.*,misc.*,news.*,rec.*,soc.*,talk.*,trial.*,alt.*,control';
X$CHOKE = 400;	# allow at least 400K in partition
X
X$start = time;
X$todo = "todo.$SERVER";
X
Xchdir $INCOMING || die "Can't chdir to $INCOMING: $!\n";
X
Xrequire "$LIB/available.pl";
X&available(".", $CHOKE) || die "not enough disk space\n";
X
Xif (open(PID, "$todo/.fetch1pid")) {
X    chop($pid = <PID>);
X    if (`/bin/ps ww$pid` =~ /fetch/) {
X	print STDERR "locked " . `date`;
X	exit 1;
X    }
X}
Xopen(PID, ">$todo/.fetch1pid");
Xprint PID $$,"\n";
Xclose PID;
X
Xopen(STDOUT,">>$todo/fetch1.log");
Xopen(STDERR,">&STDOUT");
X
Xopen(LAST, "$todo/.lasttime") || die "Can't open $INCOMING/$todo/.lasttime: $!\n";
X$_ = <LAST>;
Xclose LAST;
X(($date, $time) = /^(9\d[01]\d[0123]\d)\s+([012]\d[0-5]\d[0-5]\d)$/)
X    || die "Format of $INCOMING/$todo/.lasttime isn't yymmdd hhmmss\n";
X
Xopendir(TODO, "$todo") || die "Can't opendir $todo: $!\n";
Xwhile ($_ = readdir(TODO)) {
X    $last = $_ if /^\d+$/ && $_ > $last;
X}
Xclosedir(TODO);
X
Xif ($last =~ /^\d+$/ && open(LAST, "$todo/$last")) {
X    $Lastmessid = $_ while <LAST>;
X    chop($Lastmessid);
X    close LAST;
X}
Xprint STDERR "LAST\t$Lastmessid\t", `date`;
X
X# Connect to the server.
X
X$pat = 'S n C4 x8';
X
X$af_unix = 1;
X$af_inet = 2;
X
X$stream = 1;
X$datagram = 2;
X
X($name,$aliases,$proto) = getprotobyname('tcp');
X$tcp = $proto;
X
X($name,$aliase,$port,$proto) = getservbyname('nntp','tcp');
X$nntp = $port;
X
Xif ($SERVER =~ /^\d+\./) {
X    @bytes = split(/\./,$SERVER);
X}
Xelse {
X    ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($SERVER);
X    die "Can't lookup $SERVER\n" unless $name;
X    @bytes = unpack("C4",$addrs[0]);
X}
X
X$this = pack($pat,$af_inet,0,      0,0,0,0);
X$that = pack($pat,$af_inet,$nntp,@bytes);
X
Xsocket(NNTP,$af_inet,$stream,$tcp) || die "socket: $!\n";
Xbind(NNTP,$this) || die "bind: $!\n";
Xconnect(NNTP,$that) || die "connect: $!\n";
X
X$SIG{PIPE} = PIPE;
X$SIG{ALRM} = ALRM;
X
Xselect(NNTP); $| = 1; select(STDERR); $| = 1; select(STDOUT); $| = 1;
X
Xprint STDERR "\nConnected to NNTP server at $SERVER (",join('.',@bytes),").\n";
X
Xif ($CNEWS) {
X    require "timelocal.pl";
X
X    @tm = reverse unpack(A2A2A2A2A2A2, $date . $time);
X    $tm[4]--;
X    $cmpdate = &timegm(@tm);
X    print "(time = $cmpdate)\n";
X}
Xelse {
X    $cmpdate = $date;
X}
X
Xprint "Starting: ",`date`;
X
Xselect(STDERR); $| = 1;
Xselect(STDOUT); $| = 1;
X
Xdbmopen(DHIST,"$LIB/history",0666) || die "Can't open history dbm file: $!\n";
X
Xprint STDERR "Loading history...";
Xopen(HIST,'/usr/lib/news/history') || die "Can't open history file";
X($st_dev,$st_ino,$st_mode,$st_nlink,$st_uid,$st_gid,$st_rdev,$st_size,
X    $st_atime,$st_mtime,$st_ctime,$st_blksize,$st_blocks) = stat(HIST);
Xfor ($offset = $st_size - 100000; $offset > 0; $offset -= 100000) {
X    if (seek(HIST,$offset,0)) {
X	$_ = <HIST>;		# probably starts in middle of a line
X	$_ = <HIST>;
X	if ($CNEWS) {
X	    m|	(\d+)| || next;
X	    last if $1 < $cmpdate;
X	}
X	else {
X	    m|	(\d+)/(\d+)/(\d+)| || next;
X	    last if $3 * 10000 + $1 * 100 + $2 < $cmpdate;
X	}
X    }
X    else {
X	$offset = -1;
X    }
X}
Xseek(HIST,0,0) if $offset < 0;
Xwhile (<HIST>) {
X    if ($CNEWS) {
X	m|	(\d+)| || next;
X	last if $1 >= $cmpdate;
X    } else {
X	m|	(\d+)/(\d+)/(\d+)| || next;
X	last if $3 * 10000 + $1 * 100 + $2 >= $cmpdate;
X    }
X}
X$pct = int(tell(HIST) * 100 / $st_size);
Xprint STDERR "starting at $pct%...";
X$pos = tell(HIST);
Xwhile (<HIST>) {
X    /^(<[^>]*>)/ && ($history{$1} = $pos + 0);
X    $pos = tell(HIST);
X}
Xprint STDERR "done\n";
X
Xprint STDERR "newnews $NEWSGROUPS $date $time GMT\n";
Xprint NNTP "newnews $NEWSGROUPS $date $time GMT\n";
X
Xopen(TMP,">$todo/fetch.$start") || die "Can't open tmp file";
X
Xwhile (<NNTP>) {
X    print STDERR;
X    last if /^230/;
X}
X
Xchdir "/usr/spool/news" || die "Can't cd to /usr/spool/news: $!\n";
X
Xwhile (<NNTP>) {
X    alarm($TIMEOUT);
X    chop;
X    chop;
X    $Messid = $_;
X    y/A-Z/a-z/;
X    last if $_ eq '.';
X    if ($history{$Messid}) {
X	$loc = $DHIST{$_ . "\000"};
X	$loc = $DHIST{$Messid . "\000"} if $loc eq '';
X	if ($loc eq '') {
X	    $loc = $history{$Messid};
X	    print STDERR "???d\t",$Messid,"\n";
X	}
X	else {
X	    ($loc) = unpack("l",$loc);
X	    if ($loc != $history{$Messid}) {
X		print STDERR "???\t$loc != $history{$Messid}\n";
X		$loc = $history{$Messid};
X	    }
X	}
X	seek(HIST,$loc,0);
X	$histline = <HIST>;
X	($messid,$date,$artlist) = split(/\t/,$histline);
X	if ($messid =~ /^</) {
X	    if ($messid ne $Messid) {
X		#delete $DHIST{$_ . "\000"};
X		print STDERR ">>>m$messid\t",$Messid,"\n";
X		&got_one;
X		next;
X	    }
X	    @artlist = split(' ',$artlist);
X	    $exists = 0;
X	    for (@artlist) {
X		y|.|/|;
X		if (-e $_) {
X		    if (-z _) {
X			--$exists;
X			unlink $_;
X			print STDERR "\t\t$Messid $_ zero size\n";
X		    }
X		    else {
X			print STDERR "\t\t$Messid $_ exists\n";
X			++$exists;
X			last;
X		    }
X		}
X		else {
X		    print STDERR "\t\t$Messid $_ doesn't exist\n";
X		}
X	    }
X	    if ($exists < 1) {
X		#delete $DHIST{$_ . "\000"};
X		if ($exists < 0) {
X		    print STDERR ">>>z\t",$Messid,"\n";
X		}
X		else {
X		    print STDERR ">>>e\t",$Messid,"\n";
X		}
X		&got_one;
X		next;
X	    }
X	}
X	else {
X	    #delete $DHIST{$_ . "\000"};
X	    print STDERR ">>>s\t$Messid\t",$_,"\n";
X	    &got_one;
X	    next;
X	}
X	print STDERR "\t",$Messid,"\n";
X    }
X    else {
X	#delete $DHIST{$_ . "\000"};
X	print STDERR ">>>h\t",$Messid,"\n";
X	&got_one;
X    }
X}
Xclose TMP;
X
Xchdir $INCOMING || die "Can't chdir to $INCOMING: $!\n";
X
Xif ($_ eq '.') {
X    rename("$todo/fetch.$start", "$todo/$start");
X    $next_start = $start - 10 * 50;	# allow 10 minutes clock disparity
X    ($sec,$min,$hr,$mday,$mo,$yr) = gmtime($next_start);
X    open(LAST, ">$todo/.newlasttime") || die "Can't create .newlasttime: $!\n";
X    $mo++;
X    printf LAST "%02d%02d%02d %02d%02d%02d\n", $yr,$mo,$mday, $hr,$min,$sec;
X    close LAST;
X    rename("$todo/.newlasttime", "$todo/.lasttime");
X}
Xelse {
X    warn "NNTP closed connection prematurely\n";
X}
X
Xunlink "$todo/.fetch1pid";
X
X##########################################################################
X
Xsub PIPE { die "Died on SIGPIPE\n"; }
Xsub ALRM { die "NNTP connection timed out\n"; }
X
Xsub got_one {
X    print TMP $Messid,"\n";
X    if ($Messid eq $Lastmessid) {
X	seek(TMP,0,0);
X	truncate(TMP,0);
X	print STDERR "Truncating\n";
X    }
X}
!STUFFY!FUNK!
echo Extracting fetch2
sed >fetch2 <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/local/bin/dbzperl
X
X($SERVER) = @ARGV;
X
X$CNEWS = 1;
X$TIMEOUT = 15 * 60;
X$LIB = '/usr/lib/news';
X$INCOMING = '/usr/spool/news/in.coming';
X$CHOKE = 10240;   # allow at least 10M in partition
X
X$todo = "todo.$SERVER";
X
Xdbmopen(dhist,"$LIB/history",0666) || die "Can't open history dbm file: $!\n";
X
Xchdir $INCOMING || die "Can't cd to $INCOMING: $!\n";
X
Xrequire "$LIB/available.pl";
X&available('.', $CHOKE) || &croak("not enough disk space");
X
Xif (open(PID, "$todo/.fetch2pid")) {
X    chop($pid = <PID>);
X    if (`/bin/ps ww$pid` =~ /fetch/) {
X	die "locked " . `date`;
X    }
X}
Xopen(PID, ">$todo/.fetch2pid");
Xprint PID $$,"\n";
Xclose PID;
X
Xopen(STDOUT,">>$todo/fetch2.log");
Xopen(STDERR,">&STDOUT");
X
X@todo = &read_todo;
Xexit 0 unless @todo;
X
X# Open the connection.
X
X$pat = 'S n C4 x8';
X
X$af_unix = 1;
X$af_inet = 2;
X
X$stream = 1;
X$datagram = 2;
X
X($name,$aliases,$proto) = getprotobyname('tcp');
X$tcp = $proto;
X
X($name,$aliase,$port,$proto) = getservbyname('nntp','tcp');
X$nntp = $port;
X
Xif ($SERVER =~ /^\d+\./) {
X    @bytes = split(/\./,$SERVER);
X}
Xelse {
X    ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($SERVER);
X    die "Can't lookup $SERVER\n" unless $name;
X    @bytes = unpack("C4",$addrs[0]);
X}
X
X$this = pack($pat,$af_inet,0,      0,0,0,0);
X$that = pack($pat,$af_inet,$nntp,@bytes);
X
Xsocket(NNTP,$af_inet,$stream,$tcp) || die "socket: $!\n";
Xbind(NNTP,$this) || die "bind: $!\n";
Xconnect(NNTP,$that) || die "connect: $!\n";
X<NNTP>;
X
X$SIG{HUP} = HUP;
X$SIG{PIPE} = PIPE;
X$SIG{ALRM} = ALRM;
X$SIG{TERM} = 'croak';
X
Xselect(NNTP); $| = 1; select(STDERR); $| = 1; select(STDOUT); $| = 1;
X
Xprint STDERR "\nConnected to NNTP server at $SERVER (",join('.',@bytes),").\n";
X
Xwhile ((@todo = &read_todo)) {
X
X    $totalsize = 0;
X    for (@todo) {
X	$totalsize += -s "$todo/$_";
X    }
X
X    $batch = shift(@todo);
X
X    open(TMP,"$todo/$batch") || die "Can't open $todo/$batch: $!";
X    $tmpsize = -s TMP;
X    $^T = time;
X    $age = sprintf("%.2f", -M TMP);
X
X    print STDERR "Starting $batch: ",`date`;
X    if (open(CHECKPOINT, "$todo/.lastfetch")) {
X	$did = <CHECKPOINT>;
X	close CHECKPOINT;
X	while (<TMP>) {
X	    last if $_ eq $did;
X	}
X	seek(TMP,0,0) unless $_ eq $did;
X    }
X
X    &start;
X    select(RNEWS); $| = 1; select(STDOUT);
X
X    $pct = 0;
X    $pos = 0;
X    while (<TMP>) {
X	$line = $.;
X	chop;
X	$article = $_;
X	$remainingsize = $totalsize - $pos;
X	$remainingarts = int($remainingsize / 34.35);
X	$0 = "(fetch2 $remainingarts to do, $age days old, $pct% thru $batch)";
X	if ($dhist{"$article\0"} ne '') {
X	    print STDERR "DONE	$article\n";
X	    next;
X	}
X
X	print NNTP "article $_\r\n";
X	alarm($TIMEOUT);
X	$_ = <NNTP>;
X	$_ ne '' || &croak("NNTP connection to $SERVER shut down");
X
X	/^220/ || (warn("Not 220 on $article: $_\n"),next);
X
X	$art = '';
X	while (<NNTP>) {
X	    s/\r\n$/\n/;
X	    last if $_ eq ".\n";
X	    s/^\.\././;
X	    $art .= $_;
X	}
X	$_ ne '' || &croak("NNTP connection to $SERVER shut down");
X
X	print RNEWS "#! rnews ", length($art), " ", $SERVER, "\n";
X	print(RNEWS $art) || &croak("I/O error on print to batch: $!");
X	print STDERR "OK	$article\n";
X
X	$size += length($art);
X	if (++$arts >= 50 || $size > 300000) {
X	    &finish;
X	    &checkpoint;
X	    &start;
X	}
X	$pos = tell(TMP);
X	$pct = int($pos / $tmpsize * 100);
X    }
X
X    &finish;
X    &uncheckpoint;
X}
X
Xalarm(60);
Xprint NNTP "quit\n";
Xwhile (<NNTP>) {
X    last if /^205/;
X}
X
X&croak("done " . `date`);
X
X############################################################################
X
Xsub PIPE { &croak("Died on SIGPIPE"); }
Xsub HUP { &croak("Died on SIGHUP"); }
Xsub ALRM { &croak("NNTP connection timed out"); }
X
Xsub finish {
X    $now = time;
X    close(RNEWS);
X    if (-f "fetch.$$") {
X	until (link("fetch.$$", $now)) {
X	    $now++;
X	}
X    }
X    print STDERR "BATCH $now ($batch line $line), $arts articles, $size bytes \n", `date`;
X    unlink "fetch.$$";
X    $arts = 0;
X    $size = 0;
X}
X
Xsub checkpoint {
X    open(CHECKPOINT, ">.lastfetch");
X    print CHECKPOINT $article,"\n";
X    close CHECKPOINT;
X}
X
Xsub uncheckpoint {
X    unlink ".lastfetch", "$todo/$batch";
X}
X
Xsub start {
X    &available('.', 400) || &croak("not enough disk space");
X    open(RNEWS, ">fetch.$$");
X    $arts = 0;
X    $size = 0;
X}
X
Xsub read_todo {
X    opendir(TODO, $todo) || die "Can't read $INCOMING/$todo: $!\n";
X    local(@list) = readdir(TODO);
X    closedir(TODO);
X    grep(/^\d+$/, sort @list);
X}
X
Xsub croak {
X    warn $_[0] . "\n";
X    &finish if $arts;
X    unlink "$todo/.fetch2pid";
X    exec "/usr/lib/news/fetch2" if $_[0] =~ /HUP/;
X    exit $_[0] ne "done";
X}
!STUFFY!FUNK!
echo ""
echo "End of kit"
: I do not append .signature, but someone might mail this.
exit
Newsgroups: news.software.nntp