Mercurial > hg > paul

comparison bin/GET @ 0:2aa53823fb21

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
new repo
author Henry S. Thompson <ht@inf.ed.ac.uk>
date Sat, 06 Jun 2026 10:19:04 +0100
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:2aa53823fb21
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.827";
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 "Enter username for $realm at $netloc: ";
238 my $user = <STDIN>;
239 chomp($user);
240 return (undef, undef) unless length $user;
241 print "Password: ";
242 system("stty -echo");
243 my $password = <STDIN>;
244 system("stty echo");
245 print "\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 "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{'S'}) {
421 for my $r ($response->redirects, $response) {
422 my $method = $r->request->method;
423 my $url = $r->request->uri->as_string;
424 print "$method $url";
425 if ($options{'e'}) {
426 print "\n";
427 }
428 else {
429 print " --> ", $r->status_line, "\n";
430 }
431 print $r->request->headers_as_string, "\n" if $options{'U'};
432 if ($options{'e'}) {
433 # Display headers
434 print " ===> ", $r->status_line, "\n";
435 print $r->headers_as_string;
436 print "\n"; # separate headers and content
437 }
438 }
439 }
440 else {
441 if ($options{'u'} || $options{'U'}) {
442 my $url = $response->request->uri->as_string;
443 print "$method $url\n";
444 print $response->request->headers_as_string, "\n" if $options{'U'};
445 }
446 if ($options{'s'}) {
447 print $response->status_line, "\n";
448 }
449 if ($options{'e'}) {
450 # Display headers
451 print $response->headers_as_string;
452 print "\n"; # separate headers and content
453 }
454 }
455
456 unless ($options{'d'}) {
457 if ($options{'o'} &&
458 $response->content_type eq 'text/html') {
459 eval {
460 require HTML::Parse;
461 };
462 if ($@) {
463 if ($@ =~ m,^Can't locate HTML/Parse.pm in \@INC,) {
464 die "The HTML-Tree distribution need to be installed for the -o option to be used.\n";
465 }
466 else {
467 die $@;
468 }
469 }
470 my $html = HTML::Parse::parse_html($response->content);
471 {
472 $options{'o'} eq 'ps' && do {
473 require HTML::FormatPS;
474 my $f = HTML::FormatPS->new;
475 print $f->format($html);
476 last;
477 };
478 $options{'o'} eq 'text' && do {
479 require HTML::FormatText;
480 my $f = HTML::FormatText->new;
481 print $f->format($html);
482 last;
483 };
484 $options{'o'} eq 'html' && do {
485 print $html->as_HTML;
486 last;
487 };
488 $options{'o'} eq 'links' && do {
489 my $base = $response->base;
490 $base = $options{'b'} if $options{'b'};
491 for ( @{ $html->extract_links } ) {
492 my($link, $elem) = @$_;
493 my $tag = uc $elem->tag;
494 $link = URI->new($link)->abs($base)->as_string;
495 print "$tag\t$link\n";
496 }
497 last;
498 };
499 $options{'o'} eq 'dump' && do {
500 $html->dump;
501 last;
502 };
503 # It is bad to not notice this before now :-(
504 die "Illegal -o option value ($options{'o'})\n";
505 }
506 }
507 else {
508 binmode STDOUT unless $options{'a'};
509 print $response->content;
510 }
511 }
512
513 $errors++ unless $response->is_success;
514 }
515
516 exit $errors;
517
518
519 sub usage
520 {
521 die <<"EOT";
522 Usage: $progname [-options] <url>...
523 -m <method> use method for the request (default is '$method')
524 -f make request even if $progname believes method is illegal
525 -b <base> Use the specified URL as base
526 -t <timeout> Set timeout value
527 -i <time> Set the If-Modified-Since header on the request
528 -c <conttype> use this content-type for POST, PUT, CHECKIN
529 -a Use text mode for content I/O
530 -p <proxyurl> use this as a proxy
531 -P don't load proxy settings from environment
532 -H <header> send this HTTP header (you can specify several)
533 -C <username>:<password>
534 provide credentials for basic authentication
535
536 -u Display method and URL before any response
537 -U Display request headers (implies -u)
538 -s Display response status code
539 -S Display response status chain
540 -e Display response headers
541 -d Do not display content
542 -o <format> Process HTML content in various ways
543
544 -v Show program version
545 -h Print this message
546 EOT
547 }