Perl script to automate switching between NNTP servers
Case Larsen
clarsen at lbl.gov
Wed Jun 12 02:34:35 AEST 1991
This Perl script (as the subject line says) allows a user to switch
between NNTP servers and keep unread articles unread, read articles
read.
Usage is:
mapnews old-news-server new-news-server < .newsrc > .newnewsrc
cp .newnewsrc .newsrc
e.g. mapnews slojoe.lbl.gov csam.lbl.gov < .newsrc > .newnewsrc
Comments:
You will want to create a file socket.pl from the header file
<sys/socket.h>. Just do:
h2ph < /usr/include/sys/socket.h > socket.pl
You probably want to customize the $libdir variable (where the
message-ID caches for the newsgroups are placed).
If you are only going to run this program once, you can remove the
dbmopen and dbmclose commands to 'turn off' caching.
Please send me any fixes, suggestions, or improvements that you make.
#!/bin/perl
#$Header: mapnews,v 1.4 91/06/11 11:23:16 clarsen Exp $
#$Log: mapnews,v $
#Revision 1.4 91/06/11 11:23:16 clarsen
#comments, indentation, lockfile
#
#Revision 1.3 91/06/11 10:46:30 clarsen
#Use DBM cache
#
#Revision 1.2 91/06/10 18:12:26 clarsen
#added log&header
#
#print "@ARGV\n";
$oldserver = "@ARGV[0]";
$newserver = "@ARGV[1]";
$nntpport = 119;
$libdir = "/home/ux5/ux5c/opern/clarsen/rnadmin/nntpids";
# create socket.pl with 'h2ph < /usr/include/sys/socket.h > socket.pl'
require 'socket.pl'; # include protocol constants
$sockaddr = 'S n a4 x8';
#Algorithm:
# For each newsgroup in .newsrc,
# For each unread article in .newsrc,
# get Message-ID of unread article from old NNTP server.
# find unread article with Message-ID on new NNTP server.
# save the new article number as unread.
# Connect to old nntp server
# Connect to new nntp server
# Loop;
# Get group name from .newsrc
# If group is not subscribed, just copy line to .newsrc
# ELSE
# print "group_name: " in new .newsrc
# send "group group_name" to old server
# Loop;
# get range for group
# For each article in range
# send "xhdr Message-Id article#"
# get "article# Message-Id" from old
# stash message-id in list of oldids
# end rangeloop
# send "group group_name" to new server
# get "retcode #articles low_art high_art group_name" from new
# send "xhdr Message-Id low_art-high_art"
# while input from new is not '.'
# get "article# message-id" from new
# associate article# and message-id
# for art in low_art to high_art
# if message-id is in list of oldids and low_range not set, then
# set low_range to art
# if message-id is not in list of oldids, and low_range is set, then
# write low_range-art
# unset low_range
# end loop on group_name
($name,$aliases,$type,$len,$localaddr) = gethostbyname(`hostname`);
($name,$aliases,$type,$len,$remoteaddrold) = gethostbyname($oldserver);
($name,$aliases,$type,$len,$remoteaddrnew) = gethostbyname($newserver);
$localold = pack($sockaddr,&AF_INET,0,$localaddr);
$localnew = pack($sockaddr,&AF_INET,0,$localaddr);
$remoteold = pack($sockaddr,&AF_INET,$nntpport,$remoteaddrold);
$remotenew = pack($sockaddr,&AF_INET,$nntpport,$remoteaddrnew);
socket(LOnntp,&AF_INET,&SOCK_STREAM,0) || die "socket: $!";
bind(LOnntp,$localold) || die "bind: $!";
connect(LOnntp,$remoteold) || die "connect: $!";
socket(LNnntp,&AF_INET,&SOCK_STREAM,0) || die "socket: $!";
bind(LNnntp,$localnew) || die "bind: $!";
connect(LNnntp,$remotenew) || die "connect: $!";
select(LNnntp); $|=1;
select(LOnntp); $|=1;
select(stdout); $|=1;
$connmsg = <LNnntp>;
$conomsg = <LOnntp>;
#print $connmsg;
#print $conomsg;
while(<stdin>) { # For each newsgroup
if (/.*:.*/) { # If subscribed
($groupname, at grouparts) = split(/[!:,]/,$_);
print LOnntp "group ", $groupname, "\n";
($retcode,$narts,$low,$high) = split(/ /,<LOnntp>); #get range info
if ($retcode == 211) { # Group exists on old server
$dbname = &mkdbname_msgkey($oldserver,$groupname);
$l1 = &acquire_lock($dbname);
dbmopen(OldMsgAssoc,$dbname,0644);
&update_cache_msgkey(OldMsgAssoc,$low,$high,LOnntp);
$dbname = &mkdbname_artkey($oldserver,$groupname);
$l2 = &acquire_lock($dbname);
dbmopen(OldMsgAssocArt,$dbname,0644);
&update_cache_artkey(OldMsgAssocArt,$low,$high,LOnntp);
print LNnntp "group ", $groupname, "\n";
($retcode,$narts,$low,$high) = split(/ /,<LNnntp>);
if ($retcode == 211) { # Group exists on new server
$dbname = &mkdbname_artkey($newserver,$groupname);
$l3 = &acquire_lock($dbname);
dbmopen(NewMsgAssoc,$dbname,0644);
&update_cache_artkey(NewMsgAssoc,$low,$high,LNnntp);
reset 'read';
# Determine which messages are read.
foreach $range (@grouparts) {
$e = &endrange($range);
$b = &beginrange($range);
if ($b < $OldMsgAssocArt{"low"}) {
$b = $OldMsgAssocArt{"low"};
}
for ($art = "$b"; $art <= "$e"; $art++) {
if ($art == 1) { $art = "1"; }
if (defined($msgid = $OldMsgAssocArt{$art}) ) {
$read{$msgid} = 1;
}
}
}
print $groupname,": ";
# Remap read message ids to new article #'s
$lowrange = -1;
$notfirst = 0;
for ($art = "$low"; $art <= "$high"; $art++) {
if ($art == 1) { $art = "1"; }
# if $art has been read already,
if ( defined($read{$NewMsgAssoc{$art}})
&& ($lowrange < 0) ) {
$lowrange = $art;
} elsif ( (!defined($read{$NewMsgAssoc{$art}})) && ($lowrange > 0)) {
&writerange($notfirst,$lowrange,$art - 1);
$notfirst = 1;
$lowrange = -1;
}
}
if ($lowrange > 0) {
&writerange($notfirst,$lowrange,$high);
}
print "\n";
dbmclose(NewMsgAssoc);
} else { # Group doesn't exist on new server
print stderr "group $groupname does not exist on $newserver\n";
}
dbmclose(OldMsgAssoc);
dbmclose(OldMsgAssocArt);
&remove_lock($l1);
&remove_lock($l2);
&remove_lock($l3);
}
} else { # If unsubscribed
print $_;
}
}
sub beginrange { # usage beginrange range
local($begin); local($end);
if (@_[0] =~ /-/) {
($begin,$end) = split(/-/, at _[0]);
} else {
$begin = @_[0];
}
$begin;
}
sub endrange { # usage beginrange range
local($begin); local($end);
if (@_[0] =~ /-/) {
($begin,$end) = split(/-/, at _[0]);
} else {
$end = @_[0];
}
$end;
}
# insert msgid/articles keyed by article num
sub readmsgids_artkey { # usage readmsgids input-file assoc-array
local($in) = "";
local(*infile) = @_[0];
local(*msgarray1) = @_[1];
local($art);
while( ($in = <infile> ) !~ /^\./ ) { # end of transmission
($art,$msgid,$rest) = split(/ /,$in);
if (!($art % 50)) { print stderr $art, ".."; }
# print "Article ",$art," Msg-ID: ", $msgid;
$msgarray1{$art} = $msgid;
}
}
# insert msgid/articles keyed by msgid
sub readmsgids_msgkey { # usage readmsgids input-file assoc-array
local($in) = "";
local(*infile) = @_[0];
local(*msgarray1) = @_[1];
local($art);
while( ($in = <infile> ) !~ /^\./ ) { # end of transmission
($art,$msgid,$rest) = split(/ /,$in);
if (!($art % 50)) { print stderr $art, ".."; }
# print "Article ",$art," Msg-ID: ", $msgid;
$msgarray1{$msgid} = $art;
}
}
sub writerange { # usage writerange write-separator low high
local($write_sep) = @_[0];
local($low) = @_[1];
local($high) = @_[2];
if ($write_sep) {
print ",";
}
if ($low == $high) {
print $low;
} else {
print $low, "-", $high;
}
}
# Update the cache keyed on message id
# usage update_cache cache-name low-art high-art nntp-connection
sub update_cache_msgkey {
local(*msgarray) = @_[0];
local($low) = @_[1];
local($high) = @_[2];
local(*nntp) = @_[3];
if (defined($msgarray{"high"}) && ($msgarray{"high"} < $high)) {
#update cache
print nntp "xhdr Message-Id ",$msgarray{"high"},"-",$high, "\n";
$junk = <nntp>; # skip english response
&readmsgids_msgkey(nntp,msgarray);
} elsif (! defined($msgarray{"high"})) {
#create cache
print nntp "xhdr Message-Id ",$low,"-",$high, "\n";
$junk = <nntp>; # skip english response
&readmsgids_msgkey(nntp,msgarray);
}
$msgarray{"low"} = $low;
$msgarray{"high"} = $high;
}
# Update the cache keyed on article number
# usage update_cache cache-name low-art high-art nntp-connection
sub update_cache_artkey {
local(*msgarray) = @_[0];
local($low) = @_[1];
local($high) = @_[2];
local(*nntp) = @_[3];
if (defined($msgarray{"high"}) && ($msgarray{"high"} < $high)) {
#update cache
print nntp "xhdr Message-Id ",$msgarray{"high"},"-",$high, "\n";
$junk = <nntp>; # skip english response
&readmsgids_artkey(nntp,msgarray);
} elsif (! defined($msgarray{"high"})) {
#create cache
print nntp "xhdr Message-Id ",$low,"-",$high, "\n";
$junk = <nntp>; # skip english response
&readmsgids_artkey(nntp,msgarray);
}
$msgarray{"low"} = $low;
$msgarray{"high"} = $high;
}
sub mkdbname_msgkey { #usage mkdbname server group-name
$libdir . "/bymsg/" . @_[0] . "/" . @_[1];
}
sub mkdbname_artkey { #usage mkdbname server group-name
$libdir . "/byart/" . @_[0] . "/" . @_[1];
}
$LOCK_EX = 2;
$LOCK_UN = 8;
sub acquire_lock { #usage filename
open(LOCKFILE,">" . @_[0] . "lock");
flock(LOCKFILE,$LOCK_EX);
$lockarray{@_[0]} = LOCKFILE;
@_[0];
}
sub remove_lock { #usage lockhandle
local($handle) = $lockarray{@_[0]};
flock($handle,$LOCK_UN);
close($handle);
}
--
Case Larsen
clarsen at lbl.gov uunet!ucbvax!lbl-csam!clarsen
Voice: (415) 486-5601 Fax: 486-5548
Lawrence Berkeley Laboratory,
One Cyclotron Road -- MS 50F, Berkeley CA 94720
--
Case Larsen
clarsen at lbl.gov uunet!ucbvax!lbl-csam!clarsen
Voice: (415) 486-5601 Fax: 486-5548
Lawrence Berkeley Laboratory,
One Cyclotron Road -- MS 50F, Berkeley CA 94720
More information about the Alt.sources
mailing list