#/usr/local/bin/perl # gopherclone - clone gophers # usage: # gopherclone [www style gopher reference] # gopherclone gopher://gopher.msen.com:70/cicnet # original NNTP client suggested by eci386!clewis # socket code mailed to me by cmf@obie.cis.pitt.edu (Carl M. Fongheiser) # adaptation for gopher by emv@msen.com (Edward Vielmetti) # modification to indexer by alberti@boombox.micro.umn.edu (Bob Alberti) # Configuration information -- change to reflect your site. $_ = $ARGV[0] ? $ARGV[0] : 'gopher://gopher.micro.umn.edu:70/'; #If an argument exists, use it, otherwise use default ($service, $host, $port, $path) = (/^(gopher:\/\/)([^:]+):(\d+)(.*)/); #If debug = 0, gopherclone runs silent. =1 is a verbose run. Commented #debug lines are annoyingly thorough $DEBUG = 1; #set this to 0 for silent operation if ($host && $port && $path) { $DEBUG && print "host=$host; port=$port; path=$path\n"; # Here's how to make your own socket.ph # cp /usr/include/sys/socket.h socket.h require 'socket.ph'; # h2ph socket chop($hostname = `hostname`); # get host name in variable ($N) = &tcpconnect($host, $hostname);# open connection if ($path eq "/") { $path = ""; } &gopherlevel($host, $hostname, $path, N); # clone the gopher close(N); # close the connection. NOTHING TO IT! } else { print "Command format:\n\n"; print " gopherclone service://host.name:port/path/\n\n"; print "If a directory in the path includes multiple words separated by spaces,\n"; print "(i.e. /path name/), surround the parameter string with single quotes:\n\n"; print " goppherclone 'service://host.name:port/path name/'\n\n"; } sub gopherlevel { # Build a level of gopher directory before recursion local($host, $hostname, $path, $N) = @_; $DEBUG && print "sending path=$path\n"; send(N,"$path\r\n",0); $DEBUG && print STDERR "$path\r\n"; local($dirnum, $docnum, $i, @doc, @dir); #avoid scoping errors @doc = 0; #call me a fuddy-duddy but I like to Know @dir = 0; while() { #While receiving data chop;chop; # trim data next if /^[\. ]*$/; # quit if a period s/^(.)// && ( $type = $1); # otherwise Type is first character @G= split(/\t/); # and split other fields on tabs #$DEBUG && print "Type=$type\n"; #$DEBUG && print "Name=$G[0]\n"; #$DEBUG && print "Path=$G[1]\n"; #$DEBUG && print "Host=$G[2]\n"; #$DEBUG && print "Port=$G[3]\n"; next if (($host ne $G[2]) || ($G[3] ne $port)); # if a link, skip if ($type == 1) { # Add directories to the list of directories $dirnum += 1; $dir[$dirnum] = $G[1]; # to be built after all information received $DEBUG && print "$dirnum: $dir[$dirnum]\n"; } if ($type == 0) { # Add documents to the list of items $docnum += 1; #$DEBUG && print "document\n"; $doc[$docnum] = $G[1]; # to be fetched after all information received # $DEBUG && print "$docnum: $doc[$docnum]\n"; } } close(N); #$DEBUG && print "\n"; for ($i = 1; $i <= $docnum; $i++) { #Documents first, they're easy @path = split('/',$doc[$i]); #split along slashes $filename = $path[$#path]; #take last item as filename $filename = $filename ? $filename : "/"; open(FILE, ">$filename") || die "Couldn't open new file $filename: $!\n"; ($N) = &tcpconnect($host, $hostname); if ($N) { # If connection good send(N,"$doc[$i]\r\n", 0) || die "Send $d to $host barfed with: $!\n"; $DEBUG && print "Receiving $filename\n"; while () { #$DEBUG && print $_; next if /^[\.]*$/; #loop til lone period print FILE $_; # Put the text in the file } close(FILE); } else { die "Couldn't open tcp connection $N: $!\n"; } close(N); } for ($i = 1; $i <= $dirnum; $i++) { # Make directories @path = split('/',$dir[$i]); # split off leading entries in path; $dirname = $path[$#path]; # take last item as name $DEBUG && print "dirname: $dirname\n"; $_ = $dirname; #Bah, this is ungraceful, but if (/^\S/) { #sometimes $dirname is blank. mkdir ($dirname, 0xfff) || die print "Mkdir $dirname: $!\n"; } else { next; } chdir ($dirname) || die print "Chdir $dirname: $!\n"; ($N) = &tcpconnect($host, $hostname); if ($N) { &gopherlevel($host, $hostname, $dir[$i], N); sleep(2); #arbitrary sleeps give sockets time to close chdir("..") || die print "chdir up: $!\n"; } else { die "Couldn't open tcp connection $N: $!\n"; } close(N); } } sub tcpconnect { #Get TCP info in place local($host, $hostname) = @_; $sockaddr = 'S n a4 x8'; #$DEBUG && print "host: $host, me: $hostname\n"; ($name,$aliases,$proto) = getprotobyname('tcp'); ($name,$aliases,$port) = getservbyname($port, 'tcp') unless $port =~ /^\d+$/; ($name,$aliases,$type,$len,$thisaddr) = gethostbyname($hostname); ($name,$aliases,$type,$len,$thataddr) = gethostbyname($host); $this = pack($sockaddr, &AF_INET, 0, $thisaddr); $that = pack($sockaddr, &AF_INET, $port, $thataddr); sleep(2); socket(N, &PF_INET, &SOCK_STREAM, $proto) || die "socket: $!"; bind(N, $this) || die "bind: $!"; connect(N, $that) || die "connect: $!"; return(N); }