--- /dev/null
+#!/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 -x
+
+Extra debugging output.
+
+=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.810";
+
+
+require LWP;
+require LWP::Debug;
+
+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 "Enter username for $realm at $netloc: ";
+ my $user = <STDIN>;
+ chomp($user);
+ return (undef, undef) unless length $user;
+ print "Password: ";
+ system("stty -echo");
+ my $password = <STDIN>;
+ system("stty echo");
+ print "\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
+ #
+ 'x', # extra debugging info
+ '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;
+
+LWP::Debug::level('+') if $options{'x'};
+
+# 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 "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->url($url);
+ $response = $ua->request($request);
+
+ if ($options{'u'} || $options{'U'}) {
+ my $url = $response->request->url->as_string;
+ print "$method $url\n";
+ print $response->request->headers_as_string, "\n" if $options{'U'};
+ }
+
+ if ($options{'S'}) {
+ printResponseChain($response);
+ }
+ 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 printResponseChain
+{
+ my($response) = @_;
+ return unless defined $response;
+ printResponseChain($response->previous);
+ my $method = $response->request->method;
+ my $url = $response->request->url->as_string;
+ my $code = $response->code;
+ print "$method $url --> ", $response->status_line, "\n";
+}
+
+
+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
+
+ -x Extra debugging output
+EOT
+}
projects / dh-make-perl / blobdiff