[catagits/Gitalist.git] / local-lib5 / bin / lwp-request

#!/usr/bin/perl -w

eval 'exec /usr/bin/perl -w -S $0 ${1+"$@"}'
    if 0; # not running under some shell

# Simple user agent using LWP library.

=head1 NAME

lwp-request, GET, POST, HEAD - Simple command line user agent

=head1 SYNOPSIS

B<lwp-request> [B<-afPuUsSedvhx>] [B<-m> I<method>] [B<-b> I<base URL>] [B<-t> I<timeout>]
            [B<-i> I<if-modified-since>] [B<-c> I<content-type>]
            [B<-C> I<credentials>] [B<-p> I<proxy-url>] [B<-o> I<format>] I<url>...

=head1 DESCRIPTION

This program can be used to send requests to WWW servers and your
local file system. The request content for POST and PUT
methods is read from stdin.  The content of the response is printed on
stdout.  Error messages are printed on stderr.  The program returns a
status value indicating the number of URLs that failed.

The options are:

=over 4

=item -m <method>

Set which method to use for the request.  If this option is not used,
then the method is derived from the name of the program.

=item -f

Force request through, even if the program believes that the method is
illegal.  The server might reject the request eventually.

=item -b <uri>

This URI will be used as the base URI for resolving all relative URIs
given as argument.

=item -t <timeout>

Set the timeout value for the requests.  The timeout is the amount of
time that the program will wait for a response from the remote server
before it fails.  The default unit for the timeout value is seconds.
You might append "m" or "h" to the timeout value to make it minutes or
hours, respectively.  The default timeout is '3m', i.e. 3 minutes.

=item -i <time>

Set the If-Modified-Since header in the request. If I<time> is the
name of a file, use the modification timestamp for this file. If
I<time> is not a file, it is parsed as a literal date. Take a look at
L<HTTP::Date> for recognized formats.

=item -c <content-type>

Set the Content-Type for the request.  This option is only allowed for
requests that take a content, i.e. POST and PUT.  You can
force methods to take content by using the C<-f> option together with
C<-c>.  The default Content-Type for POST is
C<application/x-www-form-urlencoded>.  The default Content-type for
the others is C<text/plain>.

=item -p <proxy-url>

Set the proxy to be used for the requests.  The program also loads
proxy settings from the environment.  You can disable this with the
C<-P> option.

=item -P

Don't load proxy settings from environment.

=item -H <header>

Send this HTTP header with each request. You can specify several, e.g.:

    lwp-request \
	-H 'Referer: http://other.url/' \
	-H 'Host: somehost' \
	http://this.url/

=item -C <username>:<password>

Provide credentials for documents that are protected by Basic
Authentication.  If the document is protected and you did not specify
the username and password with this option, then you will be prompted
to provide these values.

=back

The following options controls what is displayed by the program:

=over 4

=item -u

Print request method and absolute URL as requests are made.

=item -U

Print request headers in addition to request method and absolute URL.

=item -s

Print response status code.  This option is always on for HEAD requests.

=item -S

Print response status chain. This shows redirect and authorization
requests that are handled by the library.

=item -e

Print response headers.  This option is always on for HEAD requests.

=item -d

Do B<not> print the content of the response.

=item -o <format>

Process HTML content in various ways before printing it.  If the
content type of the response is not HTML, then this option has no
effect.  The legal format values are; I<text>, I<ps>, I<links>,
I<html> and I<dump>.

If you specify the I<text> format then the HTML will be formatted as
plain latin1 text.  If you specify the I<ps> format then it will be
formatted as Postscript.

The I<links> format will output all links found in the HTML document.
Relative links will be expanded to absolute ones.

The I<html> format will reformat the HTML code and the I<dump> format
will just dump the HTML syntax tree.

Note that the C<HTML-Tree> distribution needs to be installed for this
option to work.  In addition the C<HTML-Format> distribution needs to
be installed for I<-o text> or I<-o ps> to work.

=item -v

Print the version number of the program and quit.

=item -h

Print usage message and quit.

=item -a

Set text(ascii) mode for content input and output.  If this option is not
used, content input and output is done in binary mode.

=back

Because this program is implemented using the LWP library, it will
only support the protocols that LWP supports.

=head1 SEE ALSO

L<lwp-mirror>, L<LWP>

=head1 COPYRIGHT

Copyright 1995-1999 Gisle Aas.

This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 AUTHOR

Gisle Aas <gisle@aas.no>

=cut

$progname = $0;
$progname =~ s,.*[\\/],,;  # use basename only
$progname =~ s/\.\w*$//;   # strip extension, if any

$VERSION = "5.834";


require LWP;

use URI;
use URI::Heuristic qw(uf_uri);

use HTTP::Status qw(status_message);
use HTTP::Date qw(time2str str2time);


# This table lists the methods that are allowed.  It should really be
# a superset for all methods supported for every scheme that may be
# supported by the library.  Currently it might be a bit too HTTP
# specific.  You might use the -f option to force a method through.
#
# "" = No content in request, "C" = Needs content in request
#
%allowed_methods = (
    GET        => "",
    HEAD       => "",
    POST       => "C",
    PUT        => "C",
    DELETE     => "",
    TRACE      => "",
    OPTIONS    => "",
);


# We make our own specialization of LWP::UserAgent that asks for
# user/password if document is protected.
{
    package RequestAgent;
    @ISA = qw(LWP::UserAgent);

    sub new
    { 
	my $self = LWP::UserAgent::new(@_);
	$self->agent("lwp-request/$main::VERSION ");
	$self;
    }

    sub get_basic_credentials
    {
	my($self, $realm, $uri) = @_;
	if ($main::options{'C'}) {
	    return split(':', $main::options{'C'}, 2);
	}
	elsif (-t) {
	    my $netloc = $uri->host_port;
	    print STDERR "Enter username for $realm at $netloc: ";
	    my $user = <STDIN>;
	    chomp($user);
	    return (undef, undef) unless length $user;
	    print STDERR "Password: ";
	    system("stty -echo");
	    my $password = <STDIN>;
	    system("stty echo");
	    print STDERR "\n";  # because we disabled echo
	    chomp($password);
	    return ($user, $password);
	}
	else {
	    return (undef, undef)
	}
    }
}

$method = uc(lc($progname) eq "lwp-request" ? "GET" : $progname);

# Parse command line
use Getopt::Long;

my @getopt_args = (
    'a', # content i/o in text(ascii) mode
    'm=s', # set method
    'f', # make request even if method is not in %allowed_methods
    'b=s', # base url
    't=s', # timeout
    'i=s', # if-modified-since
    'c=s', # content type for POST
    'C=s', # credentials for basic authorization
    'H=s@', # extra headers, form "Header: value string"
    #
    'u', # display method, URL and headers of request
    'U', # display request headers also
    's', # display status code
    'S', # display whole chain of status codes
    'e', # display response headers (default for HEAD)
    'd', # don't display content
    #
    'h', # print usage
    'v', # print version
    #
    'p=s', # proxy URL
    'P', # don't load proxy setting from environment
    #
    'o=s', # output format
);

Getopt::Long::config("noignorecase", "bundling");
unless (GetOptions(\%options, @getopt_args)) {
    usage();
}
if ($options{'v'}) {
    require LWP;
    my $DISTNAME = 'libwww-perl-' . LWP::Version();
    die <<"EOT";
This is lwp-request version $VERSION ($DISTNAME)

Copyright 1995-1999, Gisle Aas.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
EOT
}

usage() if $options{'h'} || !@ARGV;

# Create the user agent object
$ua = RequestAgent->new;

# Load proxy settings from *_proxy environment variables.
$ua->env_proxy unless $options{'P'};

$method = uc($options{'m'}) if defined $options{'m'};

if ($options{'f'}) {
    if ($options{'c'}) {
        $allowed_methods{$method} = "C";  # force content
    }
    else {
        $allowed_methods{$method} = "";
    }
}
elsif (!defined $allowed_methods{$method}) {
    die "$progname: $method is not an allowed method\n";
}

if ($method eq "HEAD") {
    $options{'s'} = 1;
    $options{'e'} = 1 unless $options{'d'};
    $options{'d'} = 1;
}

if (defined $options{'t'}) {
    $options{'t'} =~ /^(\d+)([smh])?/;
    die "$progname: Illegal timeout value!\n" unless defined $1;
    $timeout = $1;
    if (defined $2) {
        $timeout *= 60   if $2 eq "m";
        $timeout *= 3600 if $2 eq "h";
    }
    $ua->timeout($timeout);
}

if (defined $options{'i'}) {
    if (-e $options{'i'}) {
        $time = (stat _)[9];
    }
    else {
        $time = str2time($options{'i'});
        die "$progname: Illegal time syntax for -i option\n"
            unless defined $time;
    }
    $options{'i'} = time2str($time);
}

$content = undef;
if ($allowed_methods{$method} eq "C") {
    # This request needs some content
    unless (defined $options{'c'}) {
        # set default content type
        $options{'c'} = ($method eq "POST") ?
              "application/x-www-form-urlencoded"
            : "text/plain";
    }
    else {
        die "$progname: Illegal Content-type format\n"
            unless $options{'c'} =~ m,^[\w\-]+/[\w\-.+]+(?:\s*;.*)?$,
    }
    print STDERR "Please enter content ($options{'c'}) to be ${method}ed:\n"
        if -t;
    binmode STDIN unless -t or $options{'a'};
    $content = join("", <STDIN>);
}
else {
    die "$progname: Can't set Content-type for $method requests\n"
        if defined $options{'c'};
}

# Set up a request.  We will use the same request object for all URLs.
$request = HTTP::Request->new($method);
$request->header('If-Modified-Since', $options{'i'}) if defined $options{'i'};
for my $user_header (@{ $options{'H'} || [] }) {
    my ($header_name, $header_value) = split /:\s*/, $user_header, 2;
    $request->header($header_name, $header_value);
    $ua->agent($header_value) if lc($header_name) eq "user-agent"; # Ugh!
}
#$request->header('Accept', '*/*');
if ($options{'c'}) { # will always be set for request that wants content
    $request->header('Content-Type', $options{'c'});
    $request->header('Content-Length', length $content);  # Not really needed
    $request->content($content);
}

$errors = 0;

# Ok, now we perform the requests, one URL at a time
while ($url = shift) {
    # Create the URL object, but protect us against bad URLs
    eval {
	if ($url =~ /^\w+:/ || $options{'b'}) {  # is there any scheme specification
	    $url = URI->new($url, $options{'b'});
	    $url = $url->abs($options{'b'}) if $options{'b'};
	}
	else {
	    $url = uf_uri($url);
        }
    };
    if ($@) {
	$@ =~ s/ at .* line \d+.*//;
	print STDERR $@;
	$errors++;
	next;
    }

    $ua->proxy($url->scheme, $options{'p'}) if $options{'p'};

    # Send the request and get a response back from the server
    $request->uri($url);
    $response = $ua->request($request);

    if ($options{'u'} || $options{'U'}) {
        my $url = $response->request->uri->as_string;
        print "$method $url\n";
        print $response->request->headers_as_string, "\n" if $options{'U'};
    }

    if ($options{'S'}) {
        for my $r ($response->redirects, $response) {
            my $method = $r->request->method;
            my $url = $r->request->uri->as_string;
            print "$method $url --> ", $r->status_line, "\n";
        }
    }
    elsif ($options{'s'}) {
        print $response->status_line, "\n";
    }

    if ($options{'e'}) {
        # Display headers
        print $response->headers_as_string;
        print "\n";  # separate headers and content
    }

    unless ($options{'d'}) {
	if ($options{'o'} &&
	    $response->content_type eq 'text/html') {
	    eval {
		require HTML::Parse;
	    };
	    if ($@) {
		if ($@ =~ m,^Can't locate HTML/Parse.pm in \@INC,) {
		    die "The HTML-Tree distribution need to be installed for the -o option to be used.\n";
		}
		else {
		    die $@;
		}
	    }
	    my $html = HTML::Parse::parse_html($response->content);
	    {
		$options{'o'} eq 'ps' && do {
		    require HTML::FormatPS;
		    my $f = HTML::FormatPS->new;
		    print $f->format($html);
		    last;
		};
		$options{'o'} eq 'text' && do {
		    require HTML::FormatText;
		    my $f = HTML::FormatText->new;
		    print $f->format($html);
		    last;
		};
		$options{'o'} eq 'html' && do {
		    print $html->as_HTML;
		    last;
		};
		$options{'o'} eq 'links' && do {
		    my $base = $response->base;
		    $base = $options{'b'} if $options{'b'};
		    for ( @{ $html->extract_links } ) {
			my($link, $elem) = @$_;
			my $tag = uc $elem->tag;
			$link = URI->new($link)->abs($base)->as_string;
			print "$tag\t$link\n";
		    }
		    last;
		};
		$options{'o'} eq 'dump' && do {
		    $html->dump;
		    last;
		};
		# It is bad to not notice this before now :-(
		die "Illegal -o option value ($options{'o'})\n";
	    }
	}
	else {
	    binmode STDOUT unless $options{'a'};
	    print $response->content;
	}
    }

    $errors++ unless $response->is_success;
}

exit $errors;


sub usage
{
    die <<"EOT";
Usage: $progname [-options] <url>...
    -m <method>   use method for the request (default is '$method')
    -f            make request even if $progname believes method is illegal
    -b <base>     Use the specified URL as base
    -t <timeout>  Set timeout value
    -i <time>     Set the If-Modified-Since header on the request
    -c <conttype> use this content-type for POST, PUT, CHECKIN
    -a            Use text mode for content I/O
    -p <proxyurl> use this as a proxy
    -P            don't load proxy settings from environment
    -H <header>   send this HTTP header (you can specify several)
    -C <username>:<password>
                  provide credentials for basic authentication

    -u            Display method and URL before any response
    -U            Display request headers (implies -u)
    -s            Display response status code
    -S            Display response status chain
    -e            Display response headers
    -d            Do not display content
    -o <format>   Process HTML content in various ways

    -v            Show program version
    -h            Print this message
EOT
}
Commit	Line	Data
3fea05b9	1	#!/usr/bin/perl -w
	2
	3	eval 'exec /usr/bin/perl -w -S $0 ${1+"$@"}'
	4	if 0; # not running under some shell
	5
	6	# Simple user agent using LWP library.
	7
	8	=head1 NAME
	9
	10	lwp-request, GET, POST, HEAD - Simple command line user agent
	11
	12	=head1 SYNOPSIS
	13
	14	B<lwp-request> [B<-afPuUsSedvhx>] [B<-m> I<method>] [B<-b> I<base URL>] [B<-t> I<timeout>]
	15	[B<-i> I<if-modified-since>] [B<-c> I<content-type>]
	16	[B<-C> I<credentials>] [B<-p> I<proxy-url>] [B<-o> I<format>] I<url>...
	17
	18	=head1 DESCRIPTION
	19
	20	This program can be used to send requests to WWW servers and your
	21	local file system. The request content for POST and PUT
	22	methods is read from stdin. The content of the response is printed on
	23	stdout. Error messages are printed on stderr. The program returns a
	24	status value indicating the number of URLs that failed.
	25
	26	The options are:
	27
	28	=over 4
	29
	30	=item -m <method>
	31
	32	Set which method to use for the request. If this option is not used,
	33	then the method is derived from the name of the program.
	34
	35	=item -f
	36
	37	Force request through, even if the program believes that the method is
	38	illegal. The server might reject the request eventually.
	39
	40	=item -b <uri>
	41
	42	This URI will be used as the base URI for resolving all relative URIs
	43	given as argument.
	44
	45	=item -t <timeout>
	46
	47	Set the timeout value for the requests. The timeout is the amount of
	48	time that the program will wait for a response from the remote server
	49	before it fails. The default unit for the timeout value is seconds.
	50	You might append "m" or "h" to the timeout value to make it minutes or
	51	hours, respectively. The default timeout is '3m', i.e. 3 minutes.
	52
	53	=item -i <time>
	54
	55	Set the If-Modified-Since header in the request. If I<time> is the
	56	name of a file, use the modification timestamp for this file. If
	57	I<time> is not a file, it is parsed as a literal date. Take a look at
	58	L<HTTP::Date> for recognized formats.
	59
	60	=item -c <content-type>
	61
	62	Set the Content-Type for the request. This option is only allowed for
	63	requests that take a content, i.e. POST and PUT. You can
	64	force methods to take content by using the C<-f> option together with
65	C<-c>. The default Content-Type for POST is
66	C<application/x-www-form-urlencoded>. The default Content-type for
67	the others is C<text/plain>.
68
69	=item -p <proxy-url>
70
71	Set the proxy to be used for the requests. The program also loads
72	proxy settings from the environment. You can disable this with the
73	C<-P> option.
74
75	=item -P
76
77	Don't load proxy settings from environment.
78
79	=item -H <header>
80
81	Send this HTTP header with each request. You can specify several, e.g.:
82
83	lwp-request \
84	-H 'Referer: http://other.url/' \
85	-H 'Host: somehost' \
86	http://this.url/
87
88	=item -C <username>:<password>
89
90	Provide credentials for documents that are protected by Basic
91	Authentication. If the document is protected and you did not specify
92	the username and password with this option, then you will be prompted
93	to provide these values.
94
95	=back
96
97	The following options controls what is displayed by the program:
98
99	=over 4
100
101	=item -u
102
103	Print request method and absolute URL as requests are made.
104
105	=item -U
106
107	Print request headers in addition to request method and absolute URL.
108
109	=item -s
110
111	Print response status code. This option is always on for HEAD requests.
112
113	=item -S
114
115	Print response status chain. This shows redirect and authorization
116	requests that are handled by the library.
117
118	=item -e
119
120	Print response headers. This option is always on for HEAD requests.
121
122	=item -d
123
124	Do B<not> print the content of the response.
125
126	=item -o <format>
127
128	Process HTML content in various ways before printing it. If the
129	content type of the response is not HTML, then this option has no
130	effect. The legal format values are; I<text>, I<ps>, I<links>,
131	I<html> and I<dump>.
132
133	If you specify the I<text> format then the HTML will be formatted as
134	plain latin1 text. If you specify the I<ps> format then it will be
135	formatted as Postscript.
136
137	The I<links> format will output all links found in the HTML document.
138	Relative links will be expanded to absolute ones.
139
140	The I<html> format will reformat the HTML code and the I<dump> format
141	will just dump the HTML syntax tree.
142
143	Note that the C<HTML-Tree> distribution needs to be installed for this
144	option to work. In addition the C<HTML-Format> distribution needs to
145	be installed for I<-o text> or I<-o ps> to work.
146
147	=item -v
148
149	Print the version number of the program and quit.
150
151	=item -h
152
153	Print usage message and quit.
154
155	=item -a
156
157	Set text(ascii) mode for content input and output. If this option is not
158	used, content input and output is done in binary mode.
159
160	=back
161
162	Because this program is implemented using the LWP library, it will
163	only support the protocols that LWP supports.
164
165	=head1 SEE ALSO
166
167	L<lwp-mirror>, L<LWP>
168
169	=head1 COPYRIGHT
170
171	Copyright 1995-1999 Gisle Aas.
172
173	This library is free software; you can redistribute it and/or
174	modify it under the same terms as Perl itself.
175
176	=head1 AUTHOR
177
178	Gisle Aas <gisle@aas.no>
179
180	=cut
181
182	$progname = $0;
183	$progname =~ s,.*[\\/],,; # use basename only
184	$progname =~ s/\.\w*$//; # strip extension, if any
185
186	$VERSION = "5.834";
187
188
189	require LWP;
190
191	use URI;
192	use URI::Heuristic qw(uf_uri);
193
194	use HTTP::Status qw(status_message);
195	use HTTP::Date qw(time2str str2time);
196
197
198	# This table lists the methods that are allowed. It should really be
199	# a superset for all methods supported for every scheme that may be
200	# supported by the library. Currently it might be a bit too HTTP
201	# specific. You might use the -f option to force a method through.
202	#
203	# "" = No content in request, "C" = Needs content in request
204	#
205	%allowed_methods = (
206	GET => "",
207	HEAD => "",
208	POST => "C",
209	PUT => "C",
210	DELETE => "",
211	TRACE => "",
212	OPTIONS => "",
213	);
214
215
216	# We make our own specialization of LWP::UserAgent that asks for
217	# user/password if document is protected.
218	{
219	package RequestAgent;
220	@ISA = qw(LWP::UserAgent);
221
222	sub new
223	{
224	my $self = LWP::UserAgent::new(@_);
225	$self->agent("lwp-request/$main::VERSION ");
226	$self;
227	}
228
229	sub get_basic_credentials
230	{
231	my($self, $realm, $uri) = @_;
232	if ($main::options{'C'}) {
233	return split(':', $main::options{'C'}, 2);
234	}
235	elsif (-t) {
236	my $netloc = $uri->host_port;
237	print STDERR "Enter username for $realm at $netloc: ";
238	my $user = <STDIN>;
239	chomp($user);
240	return (undef, undef) unless length $user;
241	print STDERR "Password: ";
242	system("stty -echo");
243	my $password = <STDIN>;
244	system("stty echo");
245	print STDERR "\n"; # because we disabled echo
246	chomp($password);
247	return ($user, $password);
248	}
249	else {
250	return (undef, undef)
251	}
252	}
253	}
254
255	$method = uc(lc($progname) eq "lwp-request" ? "GET" : $progname);
256
257	# Parse command line
258	use Getopt::Long;
259
260	my @getopt_args = (
261	'a', # content i/o in text(ascii) mode
262	'm=s', # set method
263	'f', # make request even if method is not in %allowed_methods
264	'b=s', # base url
265	't=s', # timeout
266	'i=s', # if-modified-since
267	'c=s', # content type for POST
268	'C=s', # credentials for basic authorization
269	'H=s@', # extra headers, form "Header: value string"
270	#
271	'u', # display method, URL and headers of request
272	'U', # display request headers also
273	's', # display status code
274	'S', # display whole chain of status codes
275	'e', # display response headers (default for HEAD)
276	'd', # don't display content
277	#
278	'h', # print usage
279	'v', # print version
280	#
281	'p=s', # proxy URL
282	'P', # don't load proxy setting from environment
283	#
284	'o=s', # output format
285	);
286
287	Getopt::Long::config("noignorecase", "bundling");
288	unless (GetOptions(\%options, @getopt_args)) {
289	usage();
290	}
291	if ($options{'v'}) {
292	require LWP;
293	my $DISTNAME = 'libwww-perl-' . LWP::Version();
294	die <<"EOT";
295	This is lwp-request version $VERSION ($DISTNAME)
296
297	Copyright 1995-1999, Gisle Aas.
298
299	This program is free software; you can redistribute it and/or
300	modify it under the same terms as Perl itself.
301	EOT
302	}
303
304	usage() if $options{'h'} \|\| !@ARGV;
305
306	# Create the user agent object
307	$ua = RequestAgent->new;
308
309	# Load proxy settings from *_proxy environment variables.
310	$ua->env_proxy unless $options{'P'};
311
312	$method = uc($options{'m'}) if defined $options{'m'};
313
314	if ($options{'f'}) {
315	if ($options{'c'}) {
316	$allowed_methods{$method} = "C"; # force content
317	}
318	else {
319	$allowed_methods{$method} = "";
320	}
321	}
322	elsif (!defined $allowed_methods{$method}) {
323	die "$progname: $method is not an allowed method\n";
324	}
325
326	if ($method eq "HEAD") {
327	$options{'s'} = 1;
328	$options{'e'} = 1 unless $options{'d'};
329	$options{'d'} = 1;
330	}
331
332	if (defined $options{'t'}) {
333	$options{'t'} =~ /^(\d+)([smh])?/;
334	die "$progname: Illegal timeout value!\n" unless defined $1;
335	$timeout = $1;
336	if (defined $2) {
337	$timeout *= 60 if $2 eq "m";
338	$timeout *= 3600 if $2 eq "h";
339	}
340	$ua->timeout($timeout);
341	}
342
343	if (defined $options{'i'}) {
344	if (-e $options{'i'}) {
345	$time = (stat _)[9];
346	}
347	else {
348	$time = str2time($options{'i'});
349	die "$progname: Illegal time syntax for -i option\n"
350	unless defined $time;
351	}
352	$options{'i'} = time2str($time);
353	}
354
355	$content = undef;
356	if ($allowed_methods{$method} eq "C") {
357	# This request needs some content
358	unless (defined $options{'c'}) {
359	# set default content type
360	$options{'c'} = ($method eq "POST") ?
361	"application/x-www-form-urlencoded"
362	: "text/plain";
363	}
364	else {
365	die "$progname: Illegal Content-type format\n"
366	unless $options{'c'} =~ m,^[\w\-]+/[\w\-.+]+(?:\s;.)?$,
367	}
368	print STDERR "Please enter content ($options{'c'}) to be ${method}ed:\n"
369	if -t;
370	binmode STDIN unless -t or $options{'a'};
371	$content = join("", <STDIN>);
372	}
373	else {
374	die "$progname: Can't set Content-type for $method requests\n"
375	if defined $options{'c'};
376	}
377
378	# Set up a request. We will use the same request object for all URLs.
379	$request = HTTP::Request->new($method);
380	$request->header('If-Modified-Since', $options{'i'}) if defined $options{'i'};
381	for my $user_header (@{ $options{'H'} \|\| [] }) {
382	my ($header_name, $header_value) = split /:\s*/, $user_header, 2;
383	$request->header($header_name, $header_value);
384	$ua->agent($header_value) if lc($header_name) eq "user-agent"; # Ugh!
385	}
386	#$request->header('Accept', '/');
387	if ($options{'c'}) { # will always be set for request that wants content
388	$request->header('Content-Type', $options{'c'});
389	$request->header('Content-Length', length $content); # Not really needed
390	$request->content($content);
391	}
392
393	$errors = 0;
394
395	# Ok, now we perform the requests, one URL at a time
396	while ($url = shift) {
397	# Create the URL object, but protect us against bad URLs
398	eval {
399	if ($url =~ /^\w+:/ \|\| $options{'b'}) { # is there any scheme specification
400	$url = URI->new($url, $options{'b'});
401	$url = $url->abs($options{'b'}) if $options{'b'};
402	}
403	else {
404	$url = uf_uri($url);
405	}
406	};
407	if ($@) {
408	$@ =~ s/ at .* line \d+.*//;
409	print STDERR $@;
410	$errors++;
411	next;
412	}
413
414	$ua->proxy($url->scheme, $options{'p'}) if $options{'p'};
415
416	# Send the request and get a response back from the server
417	$request->uri($url);
418	$response = $ua->request($request);
419
420	if ($options{'u'} \|\| $options{'U'}) {
421	my $url = $response->request->uri->as_string;
422	print "$method $url\n";
423	print $response->request->headers_as_string, "\n" if $options{'U'};
424	}
425
426	if ($options{'S'}) {
427	for my $r ($response->redirects, $response) {
428	my $method = $r->request->method;
429	my $url = $r->request->uri->as_string;
430	print "$method $url --> ", $r->status_line, "\n";
431	}
432	}
433	elsif ($options{'s'}) {
434	print $response->status_line, "\n";
435	}
436
437	if ($options{'e'}) {
438	# Display headers
439	print $response->headers_as_string;
440	print "\n"; # separate headers and content
441	}
442
443	unless ($options{'d'}) {
444	if ($options{'o'} &&
445	$response->content_type eq 'text/html') {
446	eval {
447	require HTML::Parse;
448	};
449	if ($@) {
450	if ($@ =~ m,^Can't locate HTML/Parse.pm in \@INC,) {
451	die "The HTML-Tree distribution need to be installed for the -o option to be used.\n";
452	}
453	else {
454	die $@;
455	}
456	}
457	my $html = HTML::Parse::parse_html($response->content);
458	{
459	$options{'o'} eq 'ps' && do {
460	require HTML::FormatPS;
461	my $f = HTML::FormatPS->new;
462	print $f->format($html);
463	last;
464	};
465	$options{'o'} eq 'text' && do {
466	require HTML::FormatText;
467	my $f = HTML::FormatText->new;
468	print $f->format($html);
469	last;
470	};
471	$options{'o'} eq 'html' && do {
472	print $html->as_HTML;
473	last;
474	};
475	$options{'o'} eq 'links' && do {
476	my $base = $response->base;
477	$base = $options{'b'} if $options{'b'};
478	for ( @{ $html->extract_links } ) {
479	my($link, $elem) = @$_;
480	my $tag = uc $elem->tag;
481	$link = URI->new($link)->abs($base)->as_string;
482	print "$tag\t$link\n";
483	}
484	last;
485	};
486	$options{'o'} eq 'dump' && do {
487	$html->dump;
488	last;
489	};
490	# It is bad to not notice this before now :-(
491	die "Illegal -o option value ($options{'o'})\n";
492	}
493	}
494	else {
495	binmode STDOUT unless $options{'a'};
496	print $response->content;
497	}
498	}
499
500	$errors++ unless $response->is_success;
501	}
502
503	exit $errors;
504
505
506	sub usage
507	{
508	die <<"EOT";
509	Usage: $progname [-options] <url>...
510	-m <method> use method for the request (default is '$method')
511	-f make request even if $progname believes method is illegal
512	-b <base> Use the specified URL as base
513	-t <timeout> Set timeout value
514	-i <time> Set the If-Modified-Since header on the request
515	-c <conttype> use this content-type for POST, PUT, CHECKIN
516	-a Use text mode for content I/O
517	-p <proxyurl> use this as a proxy
518	-P don't load proxy settings from environment
519	-H <header> send this HTTP header (you can specify several)
520	-C <username>:<password>
521	provide credentials for basic authentication
522
523	-u Display method and URL before any response
524	-U Display request headers (implies -u)
525	-s Display response status code
526	-S Display response status chain
527	-e Display response headers
528	-d Do not display content
529	-o <format> Process HTML content in various ways
530
531	-v Show program version
532	-h Print this message
533	EOT
534	}