#! /usr/bin/perl
#
# spider.pl   Set tabstops to 3.
#

$| = 1;
$DEBUG = 0;  			# 0=no debug, 1=display progress, 2=complete dump
$SPANHOSTS = "off";	# Check hyperlinks to other hosts?

if(scalar(@ARGV) < 2){
	print "Usage: $0 <fully-qualified-URL> <search-phrase>\n";
	exit 1;
}

# Initialize.
%URLqueue = ();
chop($client_host=`hostname`);
$been = 0;
$search_phrase = $ARGV[1];


# Load the queue with the first URL to hit.
$URLqueue{$ARGV[0]} = 0;
$thisURL = &find_new(%URLqueue);


# While there's a URL in our queue which we haven't looked at ...
while($thisURL ne ""){

	# Progress report.
	$count = 0;
	while(($key,$value) = each(%URLqueue)){
		$count ++;
	}
	print "-----------------------------------------\n" if($DEBUG>=1);
	printf("Been: %d  To Go: %d\n", $been, $count-$been) if($DEBUG>=1);
	print "Current URL: $thisURL\n" if($DEBUG>=1);
	&dump_stack() if($DEBUG>=2);


	# Split the protocol from the URL.
	($protocol, $rest) = $thisURL =~ m|^([^:/]*):(.*)$|;

	# If the protocol is http, fetch the page and process it.
	if($protocol eq "http"){

		# Split out the hostname, port and document.
		($server_host, $port, $document) = 
			$rest =~ m|^//([^:/]*):*([0-9]*)/*([^:]*)$|;

		# Get the page of text and remove CR/LF characters and HTML
		# comments from it.
		$page_text = &get_http($client_host, $server_host, $port, $document);
		$page_text =~ tr/\r\n//d;
		$page_text =~ s|<!--[^>]*-->||g;

		# Report if our search string is found here.
		if($page_text =~ m|$search_phrase|i){
			print "$thisURL\n"
		}	

		# Find anchors in the HTML and update our list of URLs..
		(@anchors) = $page_text =~ m|<A[^>]*HREF\s*=\s*"([^ ">]*)"|gi;
		foreach $anchor (@anchors){
			$newURL = &fqURL($thisURL, $anchor);
			if($URLqueue{$newURL} > 0){

				# Increment the count for URLs we've already checked out.
				$URLqueue{$newURL}++;

			}else{

				# Add a zero record for URLs we haven't encountered. 
				# Optionally, ignore URL's which point to other hosts.
				($new_host) = 
						$newURL =~ m|^[^:/]*:/*([^/:]*):*[0-9]*/*[^:]*$|;
				if($SPANHOSTS eq "on" || $new_host eq $server_host){
					$URLqueue{$newURL}=0;
				}
			}
		}
	}else{
		print "Protocol '$protocol' ignored.\n" if($DEBUG>=1);
	}

	# Record the fact that we've been here, and get a new URL to process.
	$URLqueue{$thisURL} ++;
	$been ++;
	$thisURL = &find_new(%URLqueue);

}
exit;


#--------------------------------------------------------------
# Build a fully specified URL.
#--------------------------------------------------------------
sub fqURL
{
	local($thisURL, $anchor) = @_;
	local($has_proto, $has_lead_slash, $currprot, $currhost, $newURL);

	# Strip anything following a number sign '#', because its
	# just a reference to a position within a page.
	$anchor =~ s|^.*#[^#]*$|$1|;

	# Examine anchor to see what parts of the URL are specified.
	$has_proto = 0;
	$has_lead_slash=0;
	$has_proto = 1 if($anchor =~ m|^[^/:]+:|);
	$has_lead_slash = 1 if ($anchor =~ m|^/|);

	if($has_proto == 1){

		# If protocol specified, assume anchor is fully qualified.
		$newURL = $anchor;

	}
	elsif($has_lead_slash == 1){

		# If document has a leading slash, it just needs protocol and host.
		($currprot, $currhost) = $thisURL =~ m|^([^:/]*):/+([^:/]*)|;
		$newURL = $currprot . "://" . $currhost . $anchor;

	}	
	else{

		# Anchor must be just relative pathname, so append it to current URL.
		($newURL) = $thisURL =~ m|^(.*)/[^/]*$|;
		$newURL .= "/" if (! ($newURL =~ m|/$|));
		$newURL .= $anchor;

	}
	if($DEBUG >=2){
		print "Link Found\n   In:$thisURL\n   Anchor:$anchor\n   Result: $newURL\n"
	}
	return $newURL;

}



#---------------------------------------------------------------
# Do a linear search of the URL stack to find a URL with a data 
# value of 0 (i.e. one we haven't checked out yet).
#---------------------------------------------------------------
sub find_new
{
	local(%URLqueue) = @_;
	local($key, $value);

	while(($key, $value) = each(%URLqueue)){
		return $key if($value == 0);
	}
	return "";
}



#-------------------------------------------------------------------
# Debugging utility.
#-------------------------------------------------------------------
sub dump_stack
{
	local($key, $x);
	local($done, $togo) = ("", "");

	foreach $key (keys(%URLqueue)){
		if($URLqueue{$key} == 0){
			$togo .= "   " . $key . "\n";
		}else{
			$done .= "   " . $key . " (hitcount = " . $URLqueue{$key} . ")\n";
		}
	}

	print "Been There:\n" . $done;
	print "To Go:\n" . $togo;
	print "------- Hit Q to Quit, Enter to Continue -------\n";
	read(STDIN, $key, 1);
	exit(1) if($key eq 'Q' || $key eq 'q');
	
}



#-------------------------------------------------------------------------
# Get the page indicated by the $server_host and $document parameters.
#-------------------------------------------------------------------------
sub get_http
{
	local($client_host, $server_host, $port, $document) = @_;
	local($name,$aliases,$type,$len);
	local($this,$thisaddr,$that,$thataddr);
	local($client_host, $sockaddr, $a,$b,$c,$d);
	local($page, $header, $header_text, $content);


	# Some constants used to access the TCP network.
	$AF_INET=2;
	$SOCK_STREAM=1;

	# Use default http port if none specified.
	$port = 80 if($port == 0);

	# Get the protocol number for TCP.
	($name,$aliases,$proto)=getprotobyname("tcp");

	# Get the IP addresses for the two hosts.
	($name,$aliases,$type,$len,$thisaddr) = gethostbyname($client_host);
	($name,$aliases,$type,$len,$thataddr) = gethostbyname($server_host);


	# Check we could resolve the server host name.
	($a,$b,$c,$d) = unpack('C4', $thataddr);
	if($a eq "" && $b eq "" && $c eq  "" && $d eq ""){
		print "ERROR: Unknown host $server_host.\n";
		return "";
	}
	print "Server: $server_host ($a.$b.$c.$d)\n" if($DEBUG>=2);


	# Pack the AF_INET magic number, the port, and the (already packed) IP
	# addresses into the same format as the C structure would use. Note 
	# this is architecture dependent: this pack format works for 32 bit
	# architectures.
	$sockaddr="S n a4 x8";
	$this=pack($sockaddr, $AF_INET, 0, $thisaddr);
	$that=pack($sockaddr, $AF_INET, $port, $thataddr);


	# Create the socket and connect.
	if(socket(S, $AF_INET, $SOCK_STREAM, $proto) == false){
		print "ERROR: Cannot create socket.\n";
		return "";
	}
	print "Socket OK\n" if($DEBUG>=2);
	if(connect(S, $that) == false){
		print "ERROR: Cannot connect to server $server_host, port $port.\n";
		return "";
	}
	print "Connect OK\n" if($DEBUG>=2);
	

	# Turn buffering in the socket off, and send request to the server.
	select(S); $| = 1; select(STDOUT);
	print S "GET /$document HTTP/1.0\n\n";


	# Receive the response. Check to ensure the response is of MIME 
	# type text/html or text/plain.
	$page = "";
	$header = 1;
	$header_text = "";
	while(<S>){
		
		# Check if we've hit the end of the HTTP header (an empty line).
		# If we have, check for a content-type header line, and ensure
		# it is valid.
		if( m|^[\n\r]*$| ){
			$header = 0;
			($content) = $header_text =~ m|Content-type: (\S+)|i;
			if($content ne "text/html" && $content ne "text/plain"){
				print "Content type '$content' ignored.\n" if($DEBUG>=1);
				last;
			}
		}
		# Save to a header string if we're still working on the HTTP header.
		elsif($header == 1){
			$header_text .= "   " . $_;
		}
		# Otherwise, save to the html page string.
		else{
			$page .= $_;
		}


	}

	print "HTTP header: \n $header_text" if($DEBUG>=2);
	return $page;
}