🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: fj.lang.perl
Article #2402

incnews: news article incorporator

#2402
From: Kenji Nagahashi
Date: Sat, 27 Jun 1992 14:49
342 lines
10841 bytes
$B$J$,$O$7!wElBg>pJs9)$G$9!#(J

$B8&5f<<$N%m!<%+%k%K%e!<%9$r(J MH $B$GFI$`$?$a$K$3$&$$$&%9%/%j%W%H$r:n(J$B$j$^$7(J
$B$?!#(JNNTP $B%5!<%P$K@\B3$7$F(J .newsrc $B$rFI$s$GL$FI5-;v$r(Jinbox$B%U%)%k%@$K(J
incorporate $B$7$?$"$H(J .newsrc $B$r99?7$7$^$9!#(J

$B0lHLE*$J;H$$J}$O(J

	incnews [options] <nntpserver>

$B$G$9$,!"4D6-JQ?t(J NNTPSERVER $B$r8+(J$B$F$$$k$N$GIaDL$OC1$K(J incnews $B$G$9!#<g(J
$B$J%*%W%7%g%s$O(J
	-n : $B5-;v$r<h$C$F$/$k%K%e!<%9%0%k!<%W$N%Q%?!<%s(J
	-u : .newsrc $B$r99?7$7$J$$(J
	-s : $B3F5-;v$NBjL>$rI=<($9$k$@$1$G(J incorporate $B$7$J$$!#(J
	+<folder> : incorporate $B$9$k%U%)%k%@(J

$B%K%e!<%9%0%k!<%W$N%Q%?!<%s$O(J .newsrc $B$N(J options $BIw$K=q$-$^$9!#Nc$($P(J
	incnews -n !all,fj.sources
$B$N$h$&$K(J($B:G=i$N(J !all $B$O>JN,$G$-$^$9(J) .newsrc $B$N(J options $B$b8+$F$$$k$N(J
$B$G!"F1$8$J$i$P(J$B;XDj$OI,MW$"$j$^$;$s!#%3%^%s%I%i%$%s$K$b(J options $B$K$b;X(J
$BDj$,$J$$>l9g$K$OA4It$N%K%e!<%9%0%k!<%W$+$i5-;v(J$B$r;}$C$F$3$h$&$H$7$^$9!*!*(J
$B$4Cm0U$r!D(J ($B4m$J$$;EMM$+$b$7$l$J$R(J (^^;)

$B$h$m$7$1$l$P;H$C$F$d$C$F2<$5$$!#(J$B$J$K$7$mIaDL$G$J$$%1!<%9$X$NG[N8$J$I$O(J
$B$m$/$K$7$F$$$J$$$N$G(J X-)$B!"%P%0%l%]!<%H$d2~NIE@$J$I$$$?$@$1$k$H(J$B9,$$$G$9!#(J

----------snip-------------snip-----------------snip------------
#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of shell archive."
# Contents:  incnews
# Wrapped by nag@emeraldus.mtl.t.u-tokyo.ac.jp on Sat Jun 27 23:23:17 1992
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'incnews' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'incnews'\"
else
echo shar: Extracting \"'incnews'\" \(7126 characters\)
sed "s/^X//" >'incnews' <<'END_OF_FILE'
X#!/usr/local/bin/perl
X#
X# incnews: incorporate news articles from NNTP server
X# Author: Nagahashi Kenji <nag@mtl.t.u-tokyo.ac.jp>
X#
X# $Id: incnews.pl,v 1.2 1992/06/27 14:22:34 nag Exp $
X# $Log: incnews.pl,v $
X# Revision 1.2  1992/06/27  14:22:34  nag
X# *** empty log message ***
X#
X# Revision 1.1  1992/06/27  14:09:11  nag
X# Initial revision
X#
Xdo 'sys/socket.ph' || die "Can't do sys/socket.ph";
X
X# configuration params
X$MHBIN='/usr/local/bin/mh';	# for inc
X$MHLIB='/usr/local/lib/mh';	# for recvstore
X#
X$inctemp = "/tmp/inc$$";
X
X$useinc=1; $truncatetmp='-truncate';
X
Xsub usage {
X    print <<___;
XUsage: incnews [options] [nntpserver]
X    options:
X      -q : be quiet.
X      -n : newsgroup pattern to get article from (a la options line in .newsrc)
X      -p : NNTP port number
X      -u : do not update .newsrc
X      -s : just list Subject: lines (implies -u)
X___
X    exit(0);
X}
Xwhile($_=$ARGV[0], /^-/){
X    /^\+/ && ($folder=$_, shift, next);
X    /^-d/ && ($debug=1, $truncatetmp='', $|=1, shift, next);
X    /^-q/ && ($quiet=1, shift, next);
X    /^-n/ && do{
X      $_=$ARGV[1]; $_="!all," . $_ unless /^!all,/;
X      $limitng=do compile_ngpattern($_), shift, shift, next;
X    };
X    /^-p/ && ($port=$ARGV[1], shift, shift, next);
X    /^-u/ && ($noupdate=1, shift, next);
X    /^-s/ && ($justsubjects=1, $noupdate=1, shift, next);
X    /^-help/ && do usage();
X    #/^-i/ && ($useinc=1, shift, next);
X    die "Unknown option $_\n";
X}
X
X$HOME=$ENV{'HOME'};
X$dotdir=$ENV{'DOTDIR'} || $HOME;
X$nntpserver = $#ARGV == -1 ? $ENV{'NNTPSERVER'} : $ARGV[0];
X$nntpservice = $port || ($#ARGV >= 0 && $ARGV[1]) || 119;
X$newsrc = "$dotdir/.newsrc-$nntpserver";
X
Xdie "Which NNTP server to connect?\n" unless $nntpserver;
Xif(! -f $newsrc){ $newsrc = "$HOME/.newsrc"; }
X
X# open connection to the NNTP server host.
X$struct_sockaddr = 'Sna4x8';
Xsocket(S, &PF_INET, &SOCK_STREAM, 0) || die("socket: $!\n");
X$addr = (gethostbyname($nntpserver))[4];
Xdie("$nntpserver: Unknown host\n") unless $addr;
X$server = pack($struct_sockaddr, &AF_INET, $nntpservice, $addr);
Xprint "Trying to connect to $nntpserver\n" if $debug;
Xconnect(S, $server) || die("connect: $!\n");
Xprint "Connected to $nntpserver\n" if $debug;
Xselect(S); $|=1; select(stdout);
X
X# read newsrc
Xprint "reading $newsrc\n" if $debug;
Xopen(N, $newsrc) || die("$newsrc: $!\n");
Xwhile(<N>){
X    chop;
X    ?^options\s+? && ($optionsline = $_, do setoptions($'), next);
X    push(@newsrc, $_);
X}
Xclose(N);
X
X# get active newsgroup list.
Xprint "reading active list\n" if $debug;
X$_=<S>;
Xprint S "LIST\n";
X$_=<S>; die("$_\n") if ! /^215/;
X
X# for fast matching.
X$loopcode =<<'_';
Xwhile($_=<S>, $_ ne ".\r\n"){
X    chop; ($_, $l, $f) = split;
X_
X    $loopcode .=<<"_" if $limitng;
X    next unless $limitng;
X_
X    $loopcode .=<<'_' if $debug;
X    printf("%s[%d-%d]\n", $_, $f, $l);
X_
X    $loopcode .=<<'_';
X    $active{$_}=pack('I2',$f,$l);
X}
X_
X
Xprint $loopcode if $debug;
Xeval $loopcode;
X
Xprint "checking new news\n" if $debug;
X
X# main loop
Xforeach $line (@newsrc){
X    $_=$line;
X
X    next unless /(\S*)([:!])\s*(\S*)/;
X    next if $2 eq '!';		# user unscribes
X    next if !$active{$ng = $1};	# not exist or user excluded.
X    ($first,$last) = unpack('I2',$active{$ng});
X    next if $first > $last;	# all news has been expired.
X
X    if((@rl = split(/,/,($rl = $3)))){
X	$read = $rl[$#rl];
X	$read =~ /\d+-(\d+)/ && ($read = $1); $read++;
X    }
X    else{ $read = 1; }		# no article read.
X    print "$ng[$first-$last] $read\n" if $debug;
X    
X    $toread = $read > $first ? $read : $first;
X    next if $last < $toread;	# no article to get.
X
X    if((@_ = do setng($ng))){
X	# `first' in active does not always tell the truth.
X	next if $_[1] > $toread && ($toread = $_[1]) < $last;
X
X	if($justsubjects){
X	    do showxhdr($toread, $last) unless $cannot_xhdr;
X	    if($cannot_xhdr){
X		foreach $art ($toread..$last){
X		    do showsubject($art);
X		}
X	    }
X	}
X	else{
X	    foreach $art ($toread..$last){
X		do getarticle($art);
X	    }
X	}
X	print "\n";
X    }
X    next if $noupdate;
X
X    # update rl
X    if(@rl && $read == $toread){
X	$hyp = ($rl[$#rl] =~ /(\d+)-(\d+)/);
X	    $hyp ? ($rl[$#rl] = "$1-$last") : ($rl[$#rl] .= "-$last");
X    }
X    else{
X	push(@rl, $toread == $last ? $toread : "$toread-$last");
X    }
X    $rl=join(',', @rl);
X    $line="$ng: $rl";	# replace the line
X}
Xprint S "QUIT\n";
X$_=<S>; warn "$_\n" if ! /^205/;
Xclose(S);
X# incorporate article from saved tempfile.
X# -truncate ha 'inc' no "... not zeroed" toiu message wo osaeru tameni
X# tukete iru.
Xif($useinc && !$justsubjects && -f $inctemp){
X    $res = system "$MHBIN/inc $folder -file $inctemp $truncatetmp";
X    $res != 0 && do{
X	warn "inc failed.\n"; $noupdate = 1;
X    };
X}
Xunlink($inctemp) unless $debug;
Xprint "updating $newsrc\n" if $debug && !$noupdate;
Xdo update_newsrc() unless $noupdate;
Xexit(0);
X
X#----------------------------------------------------------------
Xsub setoptions {
X    local($opt)=@_;
X
X    print "options $opt\n" if $debug;
X    @options = split(/\s+/,$opt); 
X    while(($_=$options[0])){
X	/^-n/ && do{
X	    shift(@options);
X	    # ignore options line if user gives command line options.
X	    $limitng = do compile_ngpattern($options[0]) unless $limitng;
X	};
X	shift(@options);
X    }
X    next;
X}
X
Xsub setng {
X    local($ng)=@_;
X    local($res);
X
X    print "$ng: ";
X
X    print S "GROUP $ng\r\n";
X    $res=<S>;
X    if($res =~ /^211\s/){ (split(/\s+/, $'))[0,1,2]; }
X    else{ print $res; (); }
X}
X    
Xsub showxhdr {{
X    local($from, $to) = @_;
X    local($res);
X    
X    print S "XHDR subject $from-$to\r\n";
X    $res = <S>;
X    do { $cannot_xhdr = 1; last; } if $res =~ /^500/;
X    do { print $res; last; } if $res !~ /^2/;
X    while(<S>){
X	last if $_ eq ".\r\n";
X	s/\r\n$//;
X	print "\n  ",$_;
X    }
X}}
X
Xsub showsubject {{
X    local($art)=@_;
X    local($res);
X
X    print S "HEAD $art\r\n";
X    $res=<S>;
X    last if $res =~ /^423/;	# calceled
X    do { print $res; last; } if $res !~ /^2/;
X    while(<S>){
X	last if $_ eq ".\r\n";
X	/^Subject:\s*/ && do{
X	    ($_ = $') =~ s/\r\n$//;
X	    print "\n  $art: $_";
X	}
X    }
X}}
X
Xsub getarticle {{
X    local($art)=@_;
X    local($res);
X    
X    print S "ARTICLE $art\r\n";
X    $res=<S>;
X    last if $res =~ /^423/;	# canceled
X    do { print $res; last; } if $res !~ /^2/;
X    
X    print "$art ";
X    $rcvstore=$useinc ?
X	">>$inctemp" :
X	    "|$MHLIB/rcvstore";
X    open(INC, $rcvstore) || die "$rcvstore: $!\n";
X    print INC "From news\n" if $useinc; # dummy From
X    while($res=<S>){
X	last if $res eq ".\r\n";
X	$res =~ s/\r\n$/\n/;
X	print INC $res;
X    }
X    print INC "\n";
X    close(INC);
X}}
X
Xsub compile_ngpattern {
X    local($pattern)=@_;
X    local($code, @p, $pat, $not);
X    $code = '1';
X    foreach (split(/,/,$pattern)){
X	$not = s/^!//;
X	@p = split(/\./);
X	foreach (@p){ $_='\S+' if $_ eq 'all'; }
X	$pat = '/^' . join('.', @p) . '(\.|$)/';
X	if($not){ $code = "($code && !$pat)"; }
X	else{ $code = "($code || $pat)"; }
X    }
X    $code;
X}    
X		      
Xsub update_newsrc {
X    do{
X	open(N, ">$newsrc") || die("writing $newsrc: $!\n");
X	select(N);
X    } unless $debug;
X    print $optionsline,"\n" if $optionsline;
X    foreach (@newsrc){ print $_,"\n"; }
X    select(STDOUT);
X}
END_OF_FILE
if test 7126 -ne `wc -c <'incnews'`; then
    echo shar: \"'incnews'\" unpacked with wrong size!
fi
chmod +x 'incnews'
# end of 'incnews'
fi
echo shar: End of shell archive.
exit 0
------------snip------------snip--------------snip------------
--
$B""(J $BD966(J $B8-;y(J$B!'El5~Bg3XBg3X1!9)3X7O8&5f2J>pJs9)3X@l96(J $BEDCf1QI'8&5f<<(J $B#M#2(J
$B""(J E-mail: nag@mtl.t.u-tokyo.ac.jp
Technical Details
Message-ID: <NAG.92Jun27234944@arcadia.mtl.t.u-tokyo.ac.jp>
Path: arc1-ca.pugleaf.net!sparky!uunet!ccut!news.u-tokyo.ac.jp!enterprise!keisu3!nag

Show Full Headers
Complete Article Headers
X-Google-Language: Japanese,JIS
X-Google-Thread: 1043e7,235e2b58dbc1369b,start
X-Google-Attributes: gid1043e7,public
X-Google-ArrivalTime: 1992-06-27 04:05:44 PST
Path: arc1-ca.pugleaf.net!sparky!uunet!ccut!news.u-tokyo.ac.jp!enterprise!keisu3!nag
From: nag@mtl.t.u-tokyo.ac.jp (Kenji Nagahashi)
Newsgroups: fj.lang.perl
Subject: incnews: news article incorporator
Message-ID: <NAG.92Jun27234944@arcadia.mtl.t.u-tokyo.ac.jp>
Date: 27 Jun 92 14:49:44 GMT
Sender: news@keisu-s.t.u-tokyo.ac.jp
Reply-To: nag@mtl.t.u-tokyo.ac.jp
Distribution: fj
Organization: University of Tokyo, Tokyo, Japan.
Lines: 342
Nntp-Posting-Host: arcadia