summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/bin/lwp-request.bat
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/bin/lwp-request.bat')
-rwxr-xr-xMaster/tlpkg/tlperl/bin/lwp-request.bat547
1 files changed, 0 insertions, 547 deletions
diff --git a/Master/tlpkg/tlperl/bin/lwp-request.bat b/Master/tlpkg/tlperl/bin/lwp-request.bat
deleted file mode 100755
index 0b447c29fd0..00000000000
--- a/Master/tlpkg/tlperl/bin/lwp-request.bat
+++ /dev/null
@@ -1,547 +0,0 @@
-@rem = '--*-Perl-*--
-@echo off
-if "%OS%" == "Windows_NT" goto WinNT
-perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
-goto endofperl
-:WinNT
-perl -x -S %0 %*
-if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
-if %errorlevel% == 9009 echo You do not have Perl in your PATH.
-if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
-goto endofperl
-@rem ';
-#!/usr/bin/perl -w
-#line 15
-
-# 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
-}
-
-__END__
-:endofperl