|
0
|
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 }
|
