home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / usenet / altsrcs / 3 / 3480 < prev    next >
Encoding:
Internet Message Format  |  1991-06-12  |  9.8 KB
  1. From: clarsen@lbl.gov (Case Larsen)
  2. Newsgroups: alt.sources
  3. Subject: Perl script to automate switching between NNTP servers
  4. Message-ID: <CLARSEN.91Jun11113435@intruder.lbl.gov>
  5. Date: 11 Jun 91 16:34:35 GMT
  6.  
  7.  
  8. This Perl script (as the subject line says) allows a user to switch
  9. between NNTP servers and keep unread articles unread, read articles
  10. read.
  11.  
  12. Usage is:
  13.     mapnews old-news-server new-news-server < .newsrc > .newnewsrc
  14.     cp .newnewsrc .newsrc
  15.  
  16. e.g.    mapnews slojoe.lbl.gov csam.lbl.gov < .newsrc > .newnewsrc
  17.  
  18. Comments:
  19. You will want to create a file socket.pl from the header file
  20. <sys/socket.h>.  Just do:
  21.     h2ph < /usr/include/sys/socket.h > socket.pl
  22.  
  23. You probably want to customize the $libdir variable (where the
  24. message-ID caches for the newsgroups are placed).
  25.  
  26. If you are only going to run this program once, you can remove the
  27. dbmopen and dbmclose commands to 'turn off' caching.
  28.  
  29. Please send me any fixes, suggestions, or improvements that you make.
  30.  
  31. #!/bin/perl
  32. #$Header: mapnews,v 1.4 91/06/11 11:23:16 clarsen Exp $
  33. #$Log:    mapnews,v $
  34. #Revision 1.4  91/06/11  11:23:16  clarsen
  35. #comments, indentation, lockfile
  36. #
  37. #Revision 1.3  91/06/11  10:46:30  clarsen
  38. #Use DBM cache
  39. #
  40. #Revision 1.2  91/06/10  18:12:26  clarsen
  41. #added log&header
  42. #
  43.  
  44. #print "@ARGV\n";
  45. $oldserver = "@ARGV[0]";
  46. $newserver = "@ARGV[1]";
  47. $nntpport = 119;
  48. $libdir = "/home/ux5/ux5c/opern/clarsen/rnadmin/nntpids";
  49.  
  50. # create socket.pl with 'h2ph < /usr/include/sys/socket.h > socket.pl'
  51. require 'socket.pl';   # include protocol constants
  52. $sockaddr = 'S n a4 x8';
  53.  
  54. #Algorithm:
  55. #   For each newsgroup in .newsrc,
  56. #      For each unread article in .newsrc,
  57. #          get Message-ID of unread article from old NNTP server.
  58. #          find unread article with Message-ID on new NNTP server.
  59. #       save the new article number as unread.
  60. # Connect to old nntp server
  61. # Connect to new nntp server
  62. # Loop;
  63. #   Get group name from .newsrc
  64. #   If group is not subscribed, just copy line to .newsrc
  65. #   ELSE
  66. #     print "group_name: " in new .newsrc
  67. #     send "group group_name" to old server
  68. #     Loop; 
  69. #       get range for group
  70. #       For each article in range
  71. #           send "xhdr Message-Id article#"
  72. #           get  "article# Message-Id" from old
  73. #           stash message-id in list of oldids
  74. #     end rangeloop
  75. #     send "group group_name" to new server
  76. #     get "retcode #articles low_art high_art group_name" from new
  77. #     send "xhdr Message-Id low_art-high_art"
  78. #     while input from new is not '.'
  79. #        get "article# message-id" from new
  80. #        associate article# and message-id
  81. #     for art in low_art to high_art
  82. #        if message-id is in list of oldids and low_range not set, then
  83. #         set low_range to art
  84. #        if message-id is not in list of oldids, and low_range is set, then
  85. #         write low_range-art
  86. #          unset low_range
  87. # end loop on group_name
  88.  
  89. ($name,$aliases,$type,$len,$localaddr) = gethostbyname(`hostname`);
  90. ($name,$aliases,$type,$len,$remoteaddrold) = gethostbyname($oldserver);
  91. ($name,$aliases,$type,$len,$remoteaddrnew) = gethostbyname($newserver);
  92.  
  93. $localold = pack($sockaddr,&AF_INET,0,$localaddr);
  94. $localnew = pack($sockaddr,&AF_INET,0,$localaddr);
  95. $remoteold = pack($sockaddr,&AF_INET,$nntpport,$remoteaddrold);
  96. $remotenew = pack($sockaddr,&AF_INET,$nntpport,$remoteaddrnew);
  97.  
  98. socket(LOnntp,&AF_INET,&SOCK_STREAM,0) || die "socket: $!";
  99. bind(LOnntp,$localold) || die "bind: $!";
  100. connect(LOnntp,$remoteold) || die "connect: $!";
  101.  
  102. socket(LNnntp,&AF_INET,&SOCK_STREAM,0) || die "socket: $!";
  103. bind(LNnntp,$localnew) || die "bind: $!";
  104. connect(LNnntp,$remotenew) || die "connect: $!";
  105.  
  106. select(LNnntp); $|=1;
  107. select(LOnntp); $|=1;
  108. select(stdout); $|=1;
  109. $connmsg = <LNnntp>;
  110. $conomsg = <LOnntp>;
  111. #print $connmsg;
  112. #print $conomsg;
  113.  
  114. while(<stdin>) {        # For each newsgroup
  115.     if (/.*:.*/) {        # If subscribed
  116.     ($groupname,@grouparts) = split(/[!:,]/,$_);
  117.  
  118.     print LOnntp "group ", $groupname, "\n";
  119.     ($retcode,$narts,$low,$high) = split(/ /,<LOnntp>); #get range info
  120.  
  121.     if ($retcode == 211) {    # Group exists on old server
  122.         $dbname = &mkdbname_msgkey($oldserver,$groupname);
  123.         $l1 = &acquire_lock($dbname);
  124.         dbmopen(OldMsgAssoc,$dbname,0644);
  125.         &update_cache_msgkey(OldMsgAssoc,$low,$high,LOnntp);
  126.  
  127.         $dbname = &mkdbname_artkey($oldserver,$groupname);
  128.         $l2 = &acquire_lock($dbname);
  129.         dbmopen(OldMsgAssocArt,$dbname,0644);
  130.         &update_cache_artkey(OldMsgAssocArt,$low,$high,LOnntp);
  131.  
  132.         print LNnntp "group ", $groupname, "\n";
  133.         ($retcode,$narts,$low,$high) = split(/ /,<LNnntp>);
  134.         if ($retcode == 211) { # Group exists on new server
  135.         $dbname = &mkdbname_artkey($newserver,$groupname);
  136.         $l3 = &acquire_lock($dbname);
  137.         dbmopen(NewMsgAssoc,$dbname,0644);
  138.         &update_cache_artkey(NewMsgAssoc,$low,$high,LNnntp);
  139.  
  140.         reset 'read';
  141.                 # Determine which messages are read.
  142.         foreach $range (@grouparts) {
  143.             $e = &endrange($range);
  144.             $b = &beginrange($range);
  145.             if ($b < $OldMsgAssocArt{"low"}) {
  146.             $b = $OldMsgAssocArt{"low"};
  147.             }
  148.             for ($art = "$b"; $art <= "$e"; $art++) {
  149.             if ($art == 1) { $art = "1"; }
  150.             if (defined($msgid = $OldMsgAssocArt{$art}) ) {
  151.                 $read{$msgid} = 1;
  152.             }
  153.             }
  154.         }
  155.  
  156.         print $groupname,": ";
  157.                 # Remap read message ids to new article #'s
  158.         $lowrange = -1;
  159.         $notfirst = 0;
  160.  
  161.         for ($art = "$low"; $art <= "$high"; $art++) {
  162.             if ($art == 1) { $art = "1"; }
  163.                 # if $art has been read already, 
  164.             if ( defined($read{$NewMsgAssoc{$art}})
  165.             && ($lowrange < 0) ) {
  166.             $lowrange = $art;
  167.             } elsif ( (!defined($read{$NewMsgAssoc{$art}})) && ($lowrange > 0)) {
  168.             &writerange($notfirst,$lowrange,$art - 1);
  169.             $notfirst = 1;
  170.             $lowrange = -1;
  171.             }
  172.         }
  173.         if ($lowrange > 0) {
  174.             &writerange($notfirst,$lowrange,$high);
  175.         }
  176.         print "\n";
  177.         dbmclose(NewMsgAssoc);
  178.         } else {        # Group doesn't exist on new server
  179.         print stderr "group $groupname does not exist on $newserver\n";
  180.         }
  181.         dbmclose(OldMsgAssoc);
  182.         dbmclose(OldMsgAssocArt);
  183.         &remove_lock($l1);
  184.         &remove_lock($l2);
  185.         &remove_lock($l3);
  186.     }
  187.     } else {            # If unsubscribed
  188.     print $_;
  189.     }
  190. }
  191.  
  192. sub beginrange {        # usage beginrange range
  193.     local($begin); local($end);
  194.     if (@_[0] =~ /-/) {
  195.     ($begin,$end) = split(/-/,@_[0]);
  196.     } else {    
  197.     $begin = @_[0];
  198.     }
  199.     $begin;
  200. }
  201.  
  202. sub endrange {            # usage beginrange range
  203.     local($begin); local($end);
  204.     if (@_[0] =~ /-/) {
  205.     ($begin,$end) = split(/-/,@_[0]);
  206.     } else {    
  207.     $end = @_[0];
  208.     }
  209.     $end;
  210. }
  211.  
  212. # insert msgid/articles keyed by article num
  213. sub readmsgids_artkey {        # usage readmsgids input-file assoc-array
  214.     local($in) = "";
  215.     local(*infile) = @_[0];
  216.     local(*msgarray1) = @_[1];
  217.     local($art);
  218.  
  219.     while( ($in = <infile> ) !~ /^\./ ) { # end of transmission
  220.     ($art,$msgid,$rest) = split(/ /,$in);
  221.     if (!($art % 50)) { print stderr $art, ".."; }
  222. #        print "Article ",$art," Msg-ID: ", $msgid;
  223.     $msgarray1{$art} = $msgid;
  224.     }
  225. }
  226.  
  227. # insert msgid/articles keyed by msgid
  228. sub readmsgids_msgkey {        # usage readmsgids input-file assoc-array
  229.     local($in) = "";
  230.     local(*infile) = @_[0];
  231.     local(*msgarray1) = @_[1];
  232.     local($art);
  233.  
  234.     while( ($in = <infile> ) !~ /^\./ ) { # end of transmission
  235.     ($art,$msgid,$rest) = split(/ /,$in);
  236.     if (!($art % 50)) { print stderr $art, ".."; }
  237. #        print "Article ",$art," Msg-ID: ", $msgid;
  238.     $msgarray1{$msgid} = $art;
  239.     }
  240. }
  241.  
  242. sub writerange {        # usage writerange write-separator low high
  243.     local($write_sep) = @_[0];
  244.     local($low) = @_[1];
  245.     local($high) = @_[2];
  246.  
  247.     if ($write_sep) {
  248.     print ",";
  249.     }
  250.     if ($low == $high) {
  251.     print $low;
  252.     } else {
  253.     print $low, "-", $high;
  254.     }
  255. }
  256.  
  257. # Update the cache keyed on message id
  258. # usage update_cache cache-name low-art high-art nntp-connection
  259. sub update_cache_msgkey {
  260.     local(*msgarray) = @_[0];
  261.     local($low) = @_[1];
  262.     local($high) = @_[2];
  263.     local(*nntp) = @_[3];
  264.  
  265.     if (defined($msgarray{"high"}) && ($msgarray{"high"} < $high)) {
  266.     #update cache
  267.     print nntp "xhdr Message-Id ",$msgarray{"high"},"-",$high, "\n";
  268.     $junk = <nntp>;        # skip english response
  269.     &readmsgids_msgkey(nntp,msgarray);
  270.     } elsif (! defined($msgarray{"high"})) {
  271.     #create cache
  272.     print nntp "xhdr Message-Id ",$low,"-",$high, "\n";
  273.     $junk = <nntp>;        # skip english response
  274.     &readmsgids_msgkey(nntp,msgarray);
  275.     }
  276.     $msgarray{"low"} = $low;
  277.     $msgarray{"high"} = $high;
  278. }
  279.  
  280. # Update the cache keyed on article number
  281. # usage update_cache cache-name low-art high-art nntp-connection
  282. sub update_cache_artkey {
  283.  
  284.     local(*msgarray) = @_[0];
  285.     local($low) = @_[1];
  286.     local($high) = @_[2];
  287.     local(*nntp) = @_[3];
  288.  
  289.     if (defined($msgarray{"high"}) && ($msgarray{"high"} < $high)) {
  290.     #update cache
  291.     print nntp "xhdr Message-Id ",$msgarray{"high"},"-",$high, "\n";
  292.     $junk = <nntp>;        # skip english response
  293.     &readmsgids_artkey(nntp,msgarray);
  294.     } elsif (! defined($msgarray{"high"})) {
  295.     #create cache
  296.     print nntp "xhdr Message-Id ",$low,"-",$high, "\n";
  297.     $junk = <nntp>;        # skip english response
  298.     &readmsgids_artkey(nntp,msgarray);
  299.     }
  300.     $msgarray{"low"} = $low;
  301.     $msgarray{"high"} = $high;
  302. }
  303.  
  304. sub mkdbname_msgkey {        #usage mkdbname server group-name
  305.     $libdir . "/bymsg/" . @_[0] . "/" . @_[1];
  306. }
  307. sub mkdbname_artkey {        #usage mkdbname server group-name
  308.     $libdir . "/byart/" . @_[0] . "/" . @_[1];
  309. }
  310.  
  311. $LOCK_EX = 2;
  312. $LOCK_UN = 8;
  313. sub acquire_lock {        #usage filename
  314.     open(LOCKFILE,">" . @_[0] . "lock");
  315.     flock(LOCKFILE,$LOCK_EX);
  316.     $lockarray{@_[0]} = LOCKFILE;
  317.     @_[0];
  318. }
  319.  
  320. sub remove_lock {        #usage lockhandle
  321.     local($handle) = $lockarray{@_[0]};
  322.     flock($handle,$LOCK_UN);
  323.     close($handle);
  324. }
  325.  
  326. --
  327. Case Larsen
  328. clarsen@lbl.gov           uunet!ucbvax!lbl-csam!clarsen
  329. Voice: (415) 486-5601     Fax: 486-5548
  330. Lawrence Berkeley Laboratory,
  331. One Cyclotron Road -- MS 50F, Berkeley CA 94720
  332. --
  333. Case Larsen
  334. clarsen@lbl.gov           uunet!ucbvax!lbl-csam!clarsen
  335. Voice: (415) 486-5601     Fax: 486-5548
  336. Lawrence Berkeley Laboratory,
  337. One Cyclotron Road -- MS 50F, Berkeley CA 94720
  338.