diff options
Diffstat (limited to 'Master/tlpkg/tlperl/bin/lwp-request')
-rwxr-xr-x | Master/tlpkg/tlperl/bin/lwp-request | 531 |
1 files changed, 0 insertions, 531 deletions
diff --git a/Master/tlpkg/tlperl/bin/lwp-request b/Master/tlpkg/tlperl/bin/lwp-request deleted file mode 100755 index ee9dbf88ea7..00000000000 --- a/Master/tlpkg/tlperl/bin/lwp-request +++ /dev/null @@ -1,531 +0,0 @@ -#!/usr/bin/perl -w - -# 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 -} |