#!/usr/local/bin/perl ### Copyright (C) 1997 Scott Lawrence; all rights reserved ### Permission is hereby granted to use, copy, and distribute this code ### in any way provided that the above copyright is included in all copies. ### No warranty is of suitability for any purpose is provided by the author. ### ### [That having been said, if you find a problem in this package (or use ### it and don't find a problem) I would love to hear from you: ### ### ### Author: Scott Lawrence ### ### Tool to probe web servers. ### ### $Revision: 1.11 $ ### $Date: 1999/08/03 12:51:01 $ require 'getargs.pl'; use Socket; ( $VERSION = '$Revision: 1.11 $' ) =~ s/.*(\d+\.\d+).*/$1/; #') fix the perl indenting funnies caused by the above ## Constants $SOCKS_VERSION = 4; $SOCKS_CONNECT_CMD = 1; $SOCKS_OK = 90; ## Defaults $SocksPort = 1080; $HttpVersion = '1.1'; $ShowQuery = 0; $Method = 'OPTIONS'; $UserAgent = ''; $DefaultUserAgent = "wwwreq/$VERSION"; $HELP = < Used only with the 'TRACE' method, it limits the number of proxies which may forward the request. No limit is sent if this option is not specified. --useragent Specify a User Agent string to send (defaults to '$DefaultUserAgent') Specify a null string argument to disable sending a User Agent string. Not valid with 0.9. --socks [:] Specify the SOCKS (version 4) gateway and port number through which the request should be sent. The port defaults to 1080. --basic Specify credentials for HTTP Basic authentication scheme. The server to which the query is sent. This may include the port number as specified in a URL (port defaults to 80). Valid examples: www.agranat.com myserver.mydomain.com:8000 127.0.0.1:8001 The HTTP request method (defaults to '$Method'): OPTIONS Return a list of methods supported by the target. The target defaults to '*' for this method. (1.1 only) TRACE Return the request as received by the server. The target defaults to '*' for this method. (1.1 only) HEAD Return the HTTP headers for a request, but not the actual resource that would be sent for a GET. The target defaults to '/' for this method. (1.0 or 1.1 only) GET Return the requested target (a target must be specified). Note that for some targets this may return non-text data. The target defaults to '/' for this method. The URL requested from the server. For testing proxies, this may be a full URL so that you can see whether or not it is forwarded correctly. HELP ## Legal Values @Versions = ( '0.9', '1.0', '1.1' ); %SupportedMethods = ( '0.9', ['GET'] ,'1.0', ['GET', 'HEAD'], ,'1.1', ['GET', 'HEAD', 'OPTIONS', 'TRACE'], ); &getargs( '-', 'q|query', 0, 'ShowQuery' ,'-', 'n|noclose', 0, 'NoClose' ,'-', 'v|version', 1, 'HttpVersion' # must be one of @Versions ,'-', 'f|forwards', 1, 'MaxForwards' ,'-', 'u|useragent', 1, 'UserAgent' ,'-', 'g|socks', 1, 'SocksServer' ,'-', 'h|host', 1, 'Host' ,'-', 'b|basic', 2, 'BasicParams' ,'-', 'inm', 1, 'NoneMatch' ,'-', 'ims', 1, 'ModifiedSince' ,'-', 'r|range', 1, 'Range' # ,'-', 'd|digest', 2, 'DigestParams' ,'-', 'header', 1, 'Header' ,'-', 's|sendversion', 1, 'SendVersion' ,'-', 'from', 1, 'From' ,'m', 'server', 1, 'Server' ,'o', 'method', 1, 'Method' ,'o', 'target', 1, 'Target' ,'h', 'help', 0, 'HELP' ) || exit 1; die "Invalid HTTP Version '$HttpVersion';\n must be one of '" , join( "', '", @Versions ), "'\n" unless $SendVersion || grep( m/^\Q$HttpVersion\E$/, @Versions ); $SendVersion = $HttpVersion unless $SendVersion; die "Invalid hop count '$MaxForwards';\n must be numeric\n" if defined( $MaxForwards ) && $MaxForwards !~ m/^\d+/; $Method = uc($Method); die "Invalid Method '$Method' for HTTP Version $HttpVersion;" ,"\n must be one of '" , join( "', '", @{$SupportedMethods{ $HttpVersion }} ), "'\n" unless grep( m/^\Q$Method\E$/, @{$SupportedMethods{ $HttpVersion }} ); warn "The hop count is only meaningful with 'TRACE' or 'OPTIONS'; ignored\n" if defined( $MaxForwards ) && $Method ne 'TRACE' && $Method ne 'OPTIONS'; if ( $HttpVersion eq '0.9' ) { die "The user agent can not be specified for HTTP version 0.9\n" if $UserAgent ne ''; die "The 'noclose' option is not valid with HTTP/0.9\n" if $NoClose; } else { $UserAgent = $DefaultUserAgent unless $UserAgent; } #die "Can't use both --basic and --digest\n" # if @BasicParams && @DigestParams; if ( $Server =~ m/([^:]+):(\d+)/ ) { $Server = $1; $Port = $2; } else { $Port = 80; } if ( ! defined( $Target ) ) { $Target = '/' if ( $Method eq 'GET' ); $Target = '/' if ( $Method eq 'HEAD' ); $Target = '*' if ( $Method eq 'OPTIONS' ); $Target = '*' if ( $Method eq 'TRACE' ); } if ( ! $Host ) { if ( $Target =~ m|\w+://([^/]+)| ) { $Host = $1; } elsif ( $Port == 80 ) { $Host = $Server; } else { $Host = "$Server:$Port"; } } ### Construct query $CRLF = "\r\n"; $Query = "$Method $Target"; $Query .= " HTTP/$SendVersion" if $HttpVersion ne '0.9'; $Query .= $CRLF; $Query .= "Host: $Host" . $CRLF if $HttpVersion eq '1.1'; $Query .= "From: $From" . $CRLF if $From; if ( $NoClose ) { $Query .= 'Connection: Keep-Alive' . $CRLF if $HttpVersion eq '1.0'; } else { $Query .= 'Connection: close' . $CRLF if $HttpVersion eq '1.1'; } $Query .= "Max-Forwards: $MaxForwards" . $CRLF if $Method =~ m/^(TRACE|OPTIONS)$/ && defined($MaxForwards); $Query .= "User-Agent: $UserAgent" . $CRLF unless $UserAgent eq ''; $Query .= ( "Authorization: Basic " . &BasicCredentials( @BasicParams ) . $CRLF ) if ( @BasicParams ); if ( $Method =~ m/\A(GET|HEAD)\Z/ ) { $Query .= "If-Modified-Since: $ModifiedSince" . $CRLF if $ModifiedSince; $Query .= "If-None-Match: \"$NoneMatch\"" . $CRLF if $NoneMatch; $Query .= "Range: $Range" . $CRLF if $Range; } $Query .= $Header . $CRLF if ( $Header ); $Query .= $CRLF; ### Connect to server $proto = getprotobyname('tcp'); if ( defined( $SocksServer ) ) { ## SOCKS handshake if ( $SocksServer =~ m/([^:]+):(\d+)/ ) { $SocksServer = $1; $SocksPort = $2; } socket( HTTP, PF_INET, SOCK_STREAM, $proto ); $addr = sockaddr_in( $SocksPort, inet_aton( $SocksServer ) ); connect( HTTP, $addr ) || die "Connect to $SocksServer:$SocksPort failed: $!\n"; select(HTTP); $| = 1; select(STDOUT); $ip = inet_aton( $Server ); $SocksRequest = pack( 'C1 C1 n' ,$SOCKS_VERSION, $SOCKS_CONNECT_CMD, $Port ) . $ip; $UserName = "$ENV{'USER'}\000"; syswrite HTTP,$SocksRequest,length($SocksRequest); syswrite HTTP,$UserName,length($UserName); sysread HTTP, $SocksReply, 8; die "SOCKS failed\n" unless length( $SocksReply ) == 8; } else { socket( HTTP, PF_INET, SOCK_STREAM, $proto ); $addr = sockaddr_in( $Port, inet_aton( $Server ) ); connect( HTTP, $addr ) || die "Connect to $Server:$Port failed: $!\n"; } select(HTTP); $| = 1; select(STDOUT); if ( $ShowQuery ) { print "Sending:\n$Query"; print "Response:\n"; } print HTTP $Query; $| = 1; $ResponseRcvd = 0; while( ) { $ResponseRcvd = 1; print; } close HTTP; if ( ! $ResponseRcvd ) { print STDERR "[Server closed connection with no response]\n"; exit 1; } exit 0; sub DigestCredentials { } sub BasicCredentials { local( $user, $password ) = $_[0..1]; my $credential = join(':', @_ ); my $res = ""; while ($credential =~ /(.{1,45})/gs) { $res .= substr(pack('u', $1), 1); chop($res); } $res =~ tr|` -_|AA-Za-z0-9+/|; #` # fix padding at the end my $padding = (3 - length($credential) % 3) % 3; $res =~ s/.{$padding}$/'=' x $padding/e if $padding; $res; } __END__ ### Local Variables: *** ### mode: perl *** ### comment-start: "## " *** ### End: ***