From 4ef79011155d7c826f33f210196b587cc045c74f Mon Sep 17 00:00:00 2001
From: Michael Adam <obnox@samba.org>
Date: Wed, 16 Sep 2009 22:27:57 +0200
Subject: tests:webclient: extend webclient to support HTTP/0.9, 1.0 and 1.1
requests.
Enable spcifying HTTP protocol version on command line ( --http-version).
Enable specifying method (GET, CONNECT, ...) on the command line (--method).
Add POD documentation.
Use pod2usage() to print help message.
Michael
---
tests/scripts/webclient.pl | 107 ++++++++++++++++++++++++++++++++++++++++++---
1 file changed, 101 insertions(+), 6 deletions(-)
(limited to 'tests/scripts')
diff --git a/tests/scripts/webclient.pl b/tests/scripts/webclient.pl
index bdc8765..f76dbd9 100755
--- a/tests/scripts/webclient.pl
+++ b/tests/scripts/webclient.pl
@@ -21,19 +21,77 @@
use strict;
use IO::Socket;
+use Getopt::Long;
+use Pod::Usage;
my $EOL = "\015\012";
my $VERSION = "0.1";
my $NAME = "Tinyproxy-Web-Client";
my $user_agent = "$NAME/$VERSION";
+my $user_agent_header = "User-Agent: $user_agent$EOL";
+my $http_version = 1.0;
+my $method = "GET";
+my $help = 0;
+
+my $default_port = "80";
+my $port = $default_port;
+
+sub process_options() {
+ my $result = GetOptions("help|?" => \$help,
+ "http-version=s" => \$http_version,
+ "method=s" => \$method);
+ die "Error reading cmdline options! $!" unless $result;
+
+ pod2usage(1) if $help;
+
+ # some post-processing:
+}
+
+
+sub build_request($$$$$)
+{
+ my ( $host, $port, $version, $method, $document ) = @_;
+ my $request = "";
+
+ $method = uc($method);
+
+ if ($version eq '0.9') {
+ if ($method ne 'GET') {
+ die "invalid method '$method'";
+ }
+ $request = "$method $document$EOL"
+ . "$EOL";
+ } elsif ($version eq '1.0') {
+ if ($method ne 'GET') {
+ die "invalid method '$method'";
+ }
+ $request = "$method $document HTTP/$version$EOL"
+ . $user_agent_header
+ . "$EOL";
+ } elsif ($version eq '1.1') {
+ $request = "$method $document HTTP/$version$EOL"
+ . "Host: $host" . (($port and ($port ne $default_port))?":$port":"") . "$EOL"
+ . $user_agent_header
+ . "Connection: close$EOL"
+ . "$EOL";
+ } else {
+ die "invalid version '$version'";
+ }
+
+ return $request;
+}
+
+# main
+
+process_options();
unless (@ARGV > 1) {
- die "usage: $0 host[:port] document ...";
+ pod2usage(1);
}
-my $host = shift(@ARGV);
-my $port = "http(80)";
+my $hostarg = shift(@ARGV);
+my $host = $hostarg;
if ($host =~ /^([^:]+):(.*)/) {
$port = $2;
@@ -52,9 +110,7 @@ foreach my $document (@ARGV) {
$remote->autoflush(1);
- print $remote "GET $document HTTP/1.0" . $EOL .
- "User-Agent: $user_agent$EOL" .
- $EOL;
+ print $remote build_request($host, $port, $http_version, $method, $document);
while (<$remote>) {
print;
@@ -62,3 +118,42 @@ foreach my $document (@ARGV) {
close $remote;
}
+
+exit(0);
+
+__END__
+
+=head1 webclient.pl
+
+A simple WEB client written in perl.
+
+=head1 SYNOPSIS
+
+webclient.pl [options] host[:port] document [document ...]
+
+=head1 OPTIONS
+
+=over 8
+
+=item B<--help>
+
+Print a brief help message and exit.
+
+=item B<--http-version>
+
+Specify the HTTP protocol version to use (0.9, 1.0, 1.1). Default is 1.0.
+
+=item B<--method>
+
+Specify the HTTP request method ('GET', 'CONNECT', ...). Default is 'GET'.
+
+=back
+
+=head1 DESCRIPTION
+
+This is a basic web client. It permits to send http request messages to
+web servers or web proxy servers. The result is printed as is to standard output,
+including headers. This is meant as a tool for diagnosing and testing
+web servers and proxy servers.
+
+=cut
--
cgit v1.2.3