#! /usr/local/bin/perl --
#
#V  haul V2.2 18 Nov 1998 make // in URL optional
#   haul V2.1  9 Sep 1998 with -r
#   haul V2.0  2 Sep 1998 with Host: header
#   haul V1.9 10 Dec 1997 allow HTTP/1.1 or higher
#   haul V1.8 21 Nov 1997 -B for buffer size
#   haul V1.7 18 Nov 1997 -l is now optional
#   haul V1.6  7 Feb 1997 with -l to specify local interface (on two-homed machines)
#   haul V1.5 16 Oct 1996 with -o and -w
#   haul V1.4  1 Apr 1996 with -s
#   haul V1.3 28 Sep 1995 allowing proxy fetches
#   haul V1.2 17 Mar 1995 with -v
#   haul V1.1 13 Jan 1995 with -h and -b
#   haul V1.0 19 Dec 1994
#   Jim Richardson, University of Sydney
#   jimr@maths.usyd.edu.au or http://www.maths.usyd.edu.au:8000/jimr.html
#
#   Usage:
#
#	haul [ flags ] URL
#
#   where URL is an http URL (perhaps with the http: omitted), and
#   the optional flags are
#
#	-b		fetch body only, not head
#	-h		fetch head only, not body
#	-l addr		specify local address as name or IP number
#			(INADDR_ANY is default, supplied by Wire)
#	-o[file]	output body to file, default file part of URL
#	-w		overwrite file if it already exists
#	-v		verbose: show header even on error
#	-r		read all request lines from stdin
#	-i 'mod time'	fetch only if modified since mod time (where
#			mod time must be expressed in the server's terms)
#	-t tmosecs	timeout for net reads (default 30 seconds)
#	-B bufsiz	set buffer size fore Wire, in bytes
#	-s		show Wire statistics on STDERR

    use Wire;

    while( $ARGV[0] =~ m!^-([a-zA-Z])(.*)! )
    {
	$flag = $1; $val = $2;
	shift;

	if( $flag =~ m!^[bh]$! )
	{
	    die "Cannot specify both -b and -h\n"
		if $only && $flag ne $only;
	    die "Cannot specify both -o and -b\n"
		if $out && $flag eq 'b';
	    $only = $flag;
	}
	elsif( $flag eq 'o' )
	{
	    die "Cannot specify both -o and -h\n" if $only eq 'h';
	    $out = 1; $outfile = $val;
	}
	elsif( $flag eq 'w' )
	{
	    $overwrite = 1;
	}
	elsif( $flag eq 'l' )
	{
	    $lname = $val || shift;
	    if( $lname =~ m!^(\d+)\.(\d+)\.(\d+)\.(\d+)$! )
	    {
		$lad = pack( 'C4', $1, $2, $3, $4 );
	    }
	    else
	    {
		$lad = ( gethostbyname( $lname ) )[4]
		    or die "Cannot find -l name $lname in DNS\n";
	    }
	}
	elsif( $flag eq 'i' )
	{
	    $mod = $val || shift;
	    $ifmod = "If-Modified-Since: $mod\r\n";
	}
	elsif( $flag eq 's' )
	{
	    $show_stats = 1;
	}
	elsif( $flag eq 'r' )
	{
	    $req_stdin = 1;
	}
	elsif( $flag eq 't' )
	{
	    $timeout = $val || shift;
	}
	elsif( $flag eq 'v' )
	{
	    $verbose = 1;
	}
	elsif( $flag eq 'B' )
	{
	    $bufsiz = $val;
	}
	else
	{
	    die "Unexpected flag -$flag$val\n";
	}
    }

    #  Parse the URL (used to have (/.*) but that prevents proxy fetches)

    ( $host, $colonport, $port, $uri ) =
	$ARGV[0] =~ m!^(?:(?:http:)?//)?([^/:]+)(:(\d+))?(.*)!
	    or die "Bad URL $ARGV[0]\n";

    if( $out )
    {
	( $outfile ) = $uri =~ m!([^/]+)$! or die "Must specify -ofilename for $uri\n"
	    if ! length $outfile;
	die "Will not overwrite $outfile (use -w to override)\n"
	    if ! $overwrite && -e $outfile;
	open( OUT, '>' . $outfile ) or die "Could not write $outfile (\l$!)\n";
    }

    #  Open the connection and make the request

    $wire = Wire->open( HOST => $host, PORT => $port || 80, LOCALADDR => $lad,
	TIMEOUT => $timeout || 30, BUFSIZ => $bufsiz, CALLBACK => \&err );

    if( $req_stdin )
    {
	#  Read customized request header and data lines from stdin (e.g. POST)

	$wire->print( <STDIN> );
    }
    else
    {
	$wire->print( $only eq 'h' ? 'HEAD ' : 'GET ', $uri,
	    " HTTP/1.0\r\nHost: $host$colonport\r\n$ifmod\r\n" );
    }

    #  Obtain access to the wire's buffer

    $brf = $wire->bufref;

    #  Get and check the status line (without removing it from the buffer)

    1 while $wire->append and not ( $staline ) = $$brf =~ m!^([^\n]*)\n!;

    #  We insist on HTTP/1.0 or higher (limit length in case it isn't)

    if( $staline !~ m!^HTTP/[1-9]\d*\.\d+\s+200\s! )
    {
	die join( '', 'Bad status line ', substr( $staline, 0, 100 ), "\n" )
	    unless $verbose;
	undef $only;	# show the erring headers
    }

    if( $only || $out )
    {
	#  Read in and separate off the headers

	1 while
	    2 != ( ( $head, $$brf ) = split( m!\r?\n\r?\n!, $$brf, 2 ) )
	    and $wire->append;

	#  For -h just output the headers

	print( $head, "\n" ), exit if $only eq 'h';

	#  For -o display the header unless -b was specified

	print $head, "\n" if $out && $only ne 'b';
    }

    #  Now copy the rest (either the lot or just the body) to output

    open( STDOUT, '>&OUT' ) if $out;

    $wire->copy( STDOUT );

    print STDERR 'Wire statistics: ', join( ' ', $wire->stats ), "\n"
	if $show_stats;

    $wire->close;

##

sub err
{
    die "Network error: ", $_[0], "\n";
}

#!#