#!/usr/bin/perl -w
use strict;
use IO::Socket;

my %method = ( g => 'GET',
               h => 'HEAD',
               o => 'OPTIONS',
               t => 'TRACE' );

my $method = '';
while ( $method !~ /^[gtho]/i ) {
    print 'Request method (GET, TRACE, OPTIONS, or HEAD - HEAD is default)? ';
    $method = <STDIN>;
    $method = 'HEAD' if ! $method;
}

$method = $method{ lc substr $method, 0, 1 };

my $host = '';
while ( ! $host ) {
    print 'Enter host: ';
    chomp ( $host = <STDIN> );
}

my $port = 0;
while ( $port < 1 or $port > 65535 ) {
    print 'Port (80 is default)? ';
    chomp ( $port = <STDIN> );
    $port = 80 if ! $port;
}

my $path = '';
while ( ! $path ) {
    print  'Path (',  $method eq 'OPTIONS' ? '*' : '/index.html', ' is default)? ';
    chomp ( $path = <STDIN> );
    if ( ! $path ) {
        $path = ( $method eq 'OPTIONS' ) ? '*' : '/index.html';
    }
}

my $maxForwards = 0;
if ( $method eq 'TRACE' ) {
    while ( $maxForwards < 1 ) {
        print 'Max forwards? ';
        chomp ( $maxForwards = <STDIN> );
    }
}

print "Attempting to connect to $host:$port\n";
my $target = new IO::Socket::INET("$host:$port");

my $request = "$method $path HTTP/1.1\n" .
              "Host: $host\n";
$request .= "Max-Forwards: $maxForwards\n" if $method eq 'TRACE';
$request .= "\n";

print "\n$request";

# Send the headers to the host
print $target $request;

my $response;
{
    undef $/;
    # Here are the headers
    $response = <$target>;
}
print $response;