#!@perl5@ -s

my $dbg = 0;			# set to 1 for lots of debugging info

my $default = "index.html";

require 5.001;
use FileHandle;
use Socket;

if ( @ARGV == 0 )
{
    die( "usage: <site-url> <url-prefix> <max-depth>\n" );
}

my @urls;
my %seen = 0;
explore_url( $ARGV[0], "", normalize_url( $ARGV[1] ), $ARGV[2], 0 );
my @urls = keys %seen;
print join( "\n", @urls ), "\n";

sub explore_url
{
    my( $url, $referring_url, $prefix_url, $max_depth, $depth, $type ) = @_;
    my( $service, $site, $port, $path );
    my( $doc );

if ( $dbg ) {  print STDERR "exploring [$url]...\n"; }

    if ( $depth > $max_depth + $type ) { return 0; }

    if ( $url =~ m|\s*mailto:|si || $url =~ m|\s*news:|si )
    {
	return 0;
    }

    $url = normalize_url( absolutize_url( $url, $referring_url ) );

if ( $dbg ) { print STDERR "normalized url [$url]\n"; }

if ( $dbg ) { print STDERR "checking prefix: url=[$url] prefix=[$prefix_url]...\n"; }
if ( $dbg ) {  print STDERR "checking prefix = " . substr( "\L$url", 0, length( $prefix_url ) ) . "\n"; }
    if ( substr( "\L$url", 0, length( $prefix_url ) ) ne "\L$prefix_url" )
    {
	return;
    }

    if ( defined( $seen{ "$url" } ) ) { return; }

    $doc = get_url( $url );
    $seen{ "$url" } = length( $doc );

if ( $dbg ) { print STDERR "checking document type...\n"; }

    if ( ! $doc =~ m|^\s*<HTML>|si ) { return 0; }

if ( $dbg ) { print STDERR "recursing into [$url]...\n"; }

    while ( $doc =~ s|<(A\s+HREF\s*=\s*")([^"]+)|\0$1$2|si )
    {
	explore_url( $2, $url, $prefix_url, $max_depth, $depth+1, 0 );
    }

    while ( $doc =~ s|<([^>]+SRC\s*=\s*")([^"]+)|\0$1$2|si )
    {
	explore_url( $2, $url, $prefix_url, $max_depth, $depth+1, 1 );
    }

    while ( $doc =~ s|<(BODY\s+BACKGROUND\s*=\s*")([^"]+)|\0$1$2|si )
    {
	explore_url( $2, $url, $prefix_url, $max_depth, $depth+1, 1 );
    }
}

######################################################################
# split url into ( "http", "www.foo.com", 80, "/bar/" )

sub parse_url
{
    my( $service, $site, $port, $path );
    my( $url ) = @_;

    $url =~ s|\n||gs;
    $url =~ s|#.*$||;
    ( $service, $site, $path ) = ($url =~ m|^([^:]+)://([^/]*)(/.*)$|);
    if ( "\L$service" ne "file" )
    {
	if ( $site =~ m|([^:]+):(.*)| )
	{
	    $site = $1;
	    $port = $2;
	}
	else
	{
	    $port = getservbyname( $service, "tcp" );
	}
    }
    return ( $service, $site, $port, $path );
}

sub absolutize_url
{
    my( $url, $referring_url ) = @_;
    my( $service, $site, $port, $path ) = parse_url( $referring_url );
    my( $rel_path );

    if ( $port ne "" ) { $port = ":$port"; }
    $rel_path = $path;
    $rel_path =~ s|/[^/]*$|/|;
    $url =~ s|^\s*/|$service://$site$port/|i ||
        $url =~ m|^\s*[a-zA-Z]+://|i ||
	( $referring_url ne "" &&
	    $url =~ s|^\s*|$service://$site$port$rel_path| );
    $url =~ s|[^/]+/\.\./||g;	# strip out "../"s

 # put index.html on the end of file URLS
    $url =~ s|\s*file://.*/$|$&$default|i;
    return $url;
}

sub normalize_url
{
    my( $url ) = @_;
    my( $service, $site, $port, $path ) = parse_url( $url );
    if ( $port ne "" ) { $port = ":$port"; }
    $url = "$service://$site$port$path";
    $url =~ s|\s*file:///|file://localhost/|i;
    return $url;
}

######################################################################
# I could've used someone elses wheel, but this is my wheel, it's a
# nice shiny wheel: it's simple, and it works

sub get_url
{
    my( $url ) = @_;
    my( $service, $site, $port, $path );
    my( $ipaddr, $addr, $proto );
    my( @DOC );

    ($service, $site, $port, $path) = parse_url( $url );

######################################################################
# file urls

    if ( $service eq "file" )
    {
	open( FILE, $path );
	@DOC = <FILE>;
	close( FILE );
	return join( '', @DOC );
    }

######################################################################
# http urls

    if ( $service ne "http" && $service ne "https" ) { return 0; }
    if ( $site eq "" ) { return 0; }
    if ( $site =~ m|([^:]+):(.*)| )
    {
	$site = $1;
	$port = $2;
    }
    else
    {
	$port = getservbyname( $service, "tcp" );
    }
    $ipaddr = inet_aton( $site );
    $addr = sockaddr_in( $port, $ipaddr );
    $proto = getprotobyname( "tcp" );

    socket( HTTP, PF_INET, SOCK_STREAM, $proto ) || return 0;
    HTTP->autoflush( 1 );
    connect( HTTP, $addr );
    print HTTP "GET $path\n";
    @DOC = <HTTP>;
    close( HTTP );
    return join('',@DOC);
}
