#!/usr/bin/perl -w # Beginnings of a program to migrate news-servers. Currently, allows # you to scan a list of free news servers for a particular group (such # as, say, alt.sex.leek) # Waider June 2000 # URLs of interest # http://www.newzbot.com/sorted-longevity-table.html $| = 1; use LWP::UserAgent; use Net::NNTP; my @servers; my $verbose = 0; $froup = $ARGV[0] || die "Need a froup."; shift; my $ua = new LWP::UserAgent; $ua->agent( "GeekToy/0.1 " . $ua->agent ); $ua->env_proxy(); my $req = new HTTP::Request GET => "http://www.newzbot.com/sorted-longevity.txt"; my $res; my $content; if ( $#ARGV > -1 ) { open( LIST, $ARGV[0] ) || die $!; local $/ = undef; $content = ; close( LIST ); } else { print "Fetching list of servers.\n"; $res = $ua->request( $req ); # fetch! } if (( defined( $res ) && $res->is_success ) || defined( $content )) { # Format: # Server: etg.zp.ua (195.248.175.2) # NNTP Banner: 200 etg.zp.ua NNTPcache server V2.3.3 [see www.nntpcache.org] (c) 1996-1998 Julian Assange May 23 2000 ready (posting ok). # Speed: 2.02k/sec # Groups: 4588 # Posting: 340 Ok # First discovered: 2000-06-27 09:16:58 # Average article retention: 144 my $detail = ""; for $line ( split( "\n", $content || $res->content )) { next if $line =~ /^(#.*|\s*)$/; if ( $line =~ /^Server: (.*)$/ ) { if ( $detail ) { push @servers, $detail; } my ( undef, $h, $i ) = split( /\s+/, $line ); $i ||= $h; $i =~ s/[()]//g; $detail = "$h\0$i"; # host\0ip } if ( $line =~ /^Posting: (.*)$/) { if ( $1 =~ /^[45][0-9]{2}/i ) { $detail .= "\0No Posting"; } else { $detail .= "\0Posting"; } } if ( $line =~ /^Groups: (.*)$/) { $detail .= "\0$1"; } } } else { print "Failed to get page\n"; exit; } # dump the server list for my $details ( sort { ( undef, undef, $k1, undef ) = split( "\0", $a ); ( undef, undef, $k2, undef ) = split( "\0", $b ); $k2 <=> $k1 } @servers ) { my ( $host, $ip, $groups, $posting ) = split( "\0", $details ); $host ||= ""; $ip ||= $host; $posting ||= ""; $groups ||= 0; # print "$groups $host ($ip) $posting\n"; # Let's see if it's interesting $nntp = Net::NNTP->new( "$ip" ); if ( defined( $nntp )) { my @group = $nntp->group( "$froup" ); if ( @group ) { print "$host carries $froup, $group[0] article(s)\n"; } else { print "$host doesn't carry $froup.\n" if $verbose;; } $nntp->quit; } else { print "connection to $host failed: $!\n"; } }