home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / perl / scripts-osu / refetch.shar < prev    next >
Encoding:
Internet Message Format  |  1990-02-28  |  7.7 KB
  1. Path: tut.cis.ohio-state.edu!snorkelwacker!usc!elroy.jpl.nasa.gov!jato!lwall
  2. From: lwall@jato.Jpl.Nasa.Gov (Larry Wall)
  3. Newsgroups: news.admin,comp.lang.perl,alt.sources
  4. Subject: Re: Question on non-dbm history files
  5. Message-ID: <2943@jato.Jpl.Nasa.Gov>
  6. Date: 28 Feb 90 19:18:36 GMT
  7. References: <253@uucs1.UUCP> <1990Feb28.172640.25896@utzoo.uucp> <EMV.90Feb28134417@duby.math.lsa.umich.edu>
  8. Reply-To: lwall@jato.Jpl.Nasa.Gov (Larry Wall)
  9. Followup-To: comp.lang.perl
  10. Organization: Jet Propulsion Laboratory, Pasadena, CA
  11. Lines: 281
  12. Xref: tut.cis.ohio-state.edu news.admin:8075 comp.lang.perl:480 alt.sources:1494
  13.  
  14. In article <EMV.90Feb28134417@duby.math.lsa.umich.edu> emv@math.lsa.umich.edu (Edward Vielmetti) writes:
  15. :    The one other purpose that dbm (and the assorted substitutes for it)
  16. :    is intended to fulfill is random article lookup by message-ID.  Most of
  17. :    the news readers will try to do this in some circumstances, but the
  18. :    circumstances in question are usually use of some obscure command that
  19. :    nobody ever invokes in practice.
  20. : 
  21. : Here's an extremely rough cut at "article", a program to fetch
  22. : usenet articles by Message-ID over NNTP, intended to be somewhat
  23. : less obscure than most news readers. Invoke it like so:
  24. :     article "<253@uucs1.UUCP>"
  25. : once you've configured it appropriately.
  26. : 
  27. : I would like to teach it to cope with history file formats & be
  28. : generally more nice, but for me it works just dandy for now.
  29.  
  30. Here's a vaguely related script that does dbm history file lookups and nntp
  31. to refetch articles from an nntp server that were dropped in the bitbucket
  32. for some reason (usually by running out of disk space, or some such). 
  33. It should probably extract the default list of newsgroups from the sys file,
  34. but I was lazy.
  35.  
  36. Larry Wall
  37. lwall@jpl-devvax.jpl.nasa.gov
  38.  
  39. #!/bin/sh
  40. : make a subdirectory, cd to it, and run this through sh.
  41. echo 'If this kit is complete, "End of kit" will echo at the end'
  42. echo Extracting refetch
  43. sed >refetch <<'!STUFFY!FUNK!' -e 's/X//'
  44. X#!/usr/bin/perl
  45. X
  46. X$restart = shift(@ARGV);
  47. X
  48. X$server = 'jato';
  49. X$newsgroups =
  50. X'ca.*,comp.*,gnu.*,jpl.*,la.*,misc.*,nasa.*,news.*,rec.*,sci.*,soc.*,talk.*';
  51. X
  52. Xprint "Server? [$server] ";
  53. Xchop($ans = <STDIN>);
  54. X$server = $ans if $ans;
  55. X
  56. X$pat = 'S n C4 x8';
  57. X
  58. X$af_unix = 1;
  59. X$af_inet = 2;
  60. X
  61. X$stream = 1;
  62. X$datagram = 2;
  63. X
  64. X($name,$aliases,$proto) = getprotobyname('tcp');
  65. X$tcp = $proto;
  66. X
  67. X($name,$aliase,$port,$proto) = getservbyname('nntp','tcp');
  68. X$nntp = $port;
  69. X
  70. Xif ($server =~ /^\d+\./) {
  71. X    @bytes = split(/\./,$server);
  72. X}
  73. Xelse {
  74. X    ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($server);
  75. X    die "Can't lookup $server\n" unless $name;
  76. X    @bytes = unpack("C4",$addrs[0]);
  77. X}
  78. X
  79. X$this = pack($pat,$af_inet,1492,      0,0,0,0);
  80. X$that = pack($pat,$af_inet,$nntp,@bytes);
  81. X
  82. Xsocket(NNTP,$af_inet,$stream,$tcp) || die "socket: $!\n";
  83. Xbind(NNTP,$this) || die "bind: $!\n";
  84. Xconnect(NNTP,$that) || die "connect: $!\n";
  85. X
  86. Xselect(NNTP); $| = 1; select(STDOUT); $| = 1;
  87. X
  88. Xprint "\nConnected to NNTP server at $server (",join('.',@bytes),").\n\n";
  89. X
  90. Xif (!$restart) {
  91. X    print "Newsgroups? [$newsgroups] ";
  92. X    chop($ans = <STDIN>);
  93. X    $newsgroups = $ans if $ans;
  94. X
  95. X    $oneday = 60 * 60 * 24;
  96. X    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
  97. X    localtime(time-$oneday);
  98. X    $yesterday = sprintf("%02d%02d%02d",$year,$mon+1,$mday);
  99. X
  100. X    while (length($date) != 6) {
  101. X    print "\nSince date? [$yesterday] ";
  102. X    chop($date = <STDIN>);
  103. X    if ($date < 0) {
  104. X        ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
  105. X           localtime(time - $oneday * $date);
  106. X        $date = sprintf("%02d%02d%02d",$year,$mon+1,$mday);
  107. X    }
  108. X    else {
  109. X        $date = $yesterday unless $date;
  110. X    }
  111. X    }
  112. X
  113. X    $now = sprintf("%02d%02d%02d",$hour,$min,$sec);
  114. X
  115. X    while (length($time) != 6) {
  116. X    print "\nSince time? [$now] ";
  117. X    chop($time = <STDIN>);
  118. X    $time = $now unless $time;
  119. X    }
  120. X}
  121. X
  122. Xfork && exit;
  123. X
  124. Xopen(STDOUT,">refetch.log");
  125. Xopen(STDERR,">&STDOUT");
  126. X
  127. Xselect(STDERR); $| = 1;
  128. Xselect(STDOUT); $| = 1;
  129. X
  130. Xgoto label if $restart;
  131. X
  132. Xdbmopen(dhist,"history",0666) || die "Can't open history dbm file: $!\n";
  133. X
  134. Xprint STDERR "Loading history...";
  135. Xopen(hist,'/usr/lib/news/history') || die "Can't open history file";
  136. X($st_dev,$st_ino,$st_mode,$st_nlink,$st_uid,$st_gid,$st_rdev,$st_size,
  137. X    $st_atime,$st_mtime,$st_ctime,$st_blksize,$st_blocks) = stat(hist);
  138. Xfor ($offset = $st_size - 100000; $offset > 0; $offset -= 100000) {
  139. X    if (seek(hist,$offset,0)) {
  140. X    $_ = <hist>;        # probably starts in middle of a line
  141. X    $_ = <hist>;
  142. X    m|    (\d+)/(\d+)/(\d+)| || next;
  143. X    last if $3 * 10000 + $1 * 100 + $2 < $date;
  144. X    }
  145. X    else {
  146. X    $offset = -1;
  147. X    }
  148. X}
  149. Xseek(hist,0,0) if $offset < 0;
  150. Xwhile (<hist>) {
  151. X    m|    (\d+)/(\d+)/(\d+)| || next;
  152. X    last if $3 * 10000 + $1 * 100 + $2 >= $date;
  153. X}
  154. X$pct = int(tell(hist) * 100 / $st_size);
  155. Xprint STDERR "starting at $pct%...";
  156. X$pos = tell(hist);
  157. Xwhile (<hist>) {
  158. X    /^(<[^>]*>)/ && ($history{$1} = $pos + 0);
  159. X    $pos = tell(hist);
  160. X}
  161. Xprint STDERR "done\n";
  162. X
  163. Xprint NNTP "newnews $newsgroups $date $time\n";
  164. X
  165. Xopen(TMP,">/tmp/refetch$$") || die "Can't open tmp file";
  166. X
  167. Xwhile (<NNTP>) {
  168. X    last if /^230/;
  169. X}
  170. X
  171. Xchdir "/usr/spool/news" || die "Can't cd to /usr/spool/news: $!\n";
  172. X
  173. Xwhile (<NNTP>) {
  174. X    chop;
  175. X    chop;
  176. X    $Messid = $_;
  177. X    y/A-Z/a-z/;
  178. X    last if $_ eq '.';
  179. X    if ($history{$Messid}) {
  180. X    $loc = $dhist{$_ . "\000"};
  181. X    $loc = $dhist{$Messid . "\000"} if $loc eq '';
  182. X    if ($loc eq '') {
  183. X        $loc = $history{$Messid};
  184. X        print STDERR "???d\t",$Messid,"\n";
  185. X    }
  186. X    else {
  187. X        ($loc) = unpack("l",$loc);
  188. X        if ($loc != $history{$Messid}) {
  189. X        print STDERR "???\t$loc != $history{$Messid}\n";
  190. X        $loc = $history{$Messid};
  191. X        }
  192. X    }
  193. X    seek(hist,$loc,0);
  194. X    $histline = <hist>;
  195. X    ($messid,$date,$artlist) = split(/\t/,$histline);
  196. X    if ($messid =~ /^</) {
  197. X        if ($messid ne $Messid) {
  198. X        delete $dhist{$_ . "\000"};
  199. X        print STDERR ">>>m$messid\t",$Messid,"\n";
  200. X        print TMP $Messid,"\n";
  201. X        next;
  202. X        }
  203. X        @artlist = split(' ',$artlist);
  204. X        $exists = 0;
  205. X        for (@artlist) {
  206. X        y|.|/|;
  207. X        if (-e $_) {
  208. X            if (-z _) {
  209. X            --$exists;
  210. X            unlink $_;
  211. X            print STDERR "\t\t$Messid $_ zero size\n";
  212. X            }
  213. X            else {
  214. X            print STDERR "\t\t$Messid $_ exists\n";
  215. X            ++$exists;
  216. X            last;
  217. X            }
  218. X        }
  219. X        else {
  220. X            print STDERR "\t\t$Messid $_ doesn't exist\n";
  221. X        }
  222. X        }
  223. X        if ($exists < 1) {
  224. X        delete $dhist{$_ . "\000"};
  225. X        if ($exists < 0) {
  226. X            print STDERR ">>>z\t",$Messid,"\n";
  227. X        }
  228. X        else {
  229. X            print STDERR ">>>e\t",$Messid,"\n";
  230. X        }
  231. X        print TMP $Messid,"\n";
  232. X        next;
  233. X        }
  234. X    }
  235. X    else {
  236. X        delete $dhist{$_ . "\000"};
  237. X        print STDERR ">>>s\t$Messid\t",$_,"\n";
  238. X        print TMP $Messid,"\n";
  239. X        next;
  240. X    }
  241. X    print STDERR "\t",$Messid,"\n";
  242. X    }
  243. X    else {
  244. X    delete $dhist{$_ . "\000"};
  245. X    print STDERR ">>>h\t",$Messid,"\n";
  246. X    print TMP $Messid,"\n";
  247. X    }
  248. X}
  249. Xclose TMP;
  250. Xdbmclose(dhist);
  251. X
  252. Xlabel:
  253. Xif ($restart) {
  254. X    open(TMP,"/tmp/refetch$restart") || die "Can't reopen /tmp/refetch$restart: $!";
  255. X}
  256. Xelse {
  257. X    open(TMP,"/tmp/refetch$$") || die "Can't reopen /tmp/refetch$$: $!";
  258. X}
  259. X
  260. Xwhile (<TMP>) {
  261. X    chop;
  262. X    $article = $_;
  263. X    print NNTP "article $_\n";
  264. X    ($_ = <NNTP>) =~ /^220/ || (warn("Not 220 on $article: $_"),next);
  265. X    open(RNEWS,"|/usr/local/bin/rnews");
  266. X    while (<NNTP>) {
  267. X    s/\r\n$/\n/;
  268. X    last if $_ eq ".\n";
  269. X    s/^\.\././;
  270. X    print RNEWS;
  271. X    }
  272. X    close RNEWS;
  273. X    if ($?) {
  274. X    printf STDERR "Exit %d sig %d from rnews on %s\n",
  275. X        $? >> 8; $? & 255, $article;
  276. X    }
  277. X    else {
  278. X    print STDERR "OK    $article\n";
  279. X    }
  280. X}
  281. X
  282. Xprint NNTP "quit\n";
  283. Xwhile (<NNTP>) {
  284. X    ;
  285. X}
  286. X
  287. X# unlink "/tmp/refetch$$";
  288. X
  289. Xprint STDERR "done\n";
  290. !STUFFY!FUNK!
  291. echo ""
  292. echo "End of kit"
  293. : I do not append .signature, but someone might mail this.
  294. exit
  295.  
  296.