#!/usr/public/bin/perl # $Id: get,v 0.15 1994/09/21 01:23:18 fielding Exp $ # ========================================================================== # Perform a WWW request on a (set of) absolute or relative URL(s). # The URL(s) may be on the command line or passed via a pipe. # The method used is equal to the uppercased name of this program, # so the intention is to name it "get" and create a symbolic links # called "HEAD" and "POST" which point to "get" (three programs for # the price of one). # # The program starts with the BASE URL equal to the current file directory. # To change it, enter a URL prefixed with "base=", e.g, # # Enter a URL (^D to exit): base=http://www.ics.uci.edu/ # # 13 Jun 1994 (RTF): Initial Version # 14 Jun 1994 (RTF): Changed env variable to LIBWWW_PERL # Fixed the method name to remove any path garbage # 06 Jul 1994 (RTF): Added extra fallback code from Martijn Koster # 20 Jul 1994 (RTF): The default From header is now set by www.pl # and &www'set_def_header() is called to set User-Agent # 07 Sep 1994 (RTF): Added code to show original headers if they were received; # Added tout to interactively change the timeout value; # Added ims to interactively give If-Modified-Since; # Added handling of POST content suggested by Mel Melchner. # 18 Sep 1994 (RTF): Added command-line options, debug and quiet modes. # # Created by Roy Fielding to test the libwww-perl system # ========================================================================== if ($libloc = $ENV{'LIBWWW_PERL'}) { unshift(@INC, $libloc); } require "getopts.pl"; require "www.pl"; require "wwwurl.pl"; require "wwwerror.pl"; $pname = $0; $method = $pname; # Method = program name $method =~ s#^.*/([^/]+)$#$1#; # lose the path $method =~ tr/a-z/A-Z/; # uppercase it $Version = "$method/0.5"; # Set up User-Agent: header &www'set_def_header('http', 'User-Agent', $Version); $pwd = ( $ENV{'PWD'} || $ENV{'cwd'} || '' ); $Base = "file://localhost$pwd/"; # Set up initial Base URL $Tout = 30; # Time-out in seconds $Ims = ''; # If-Modified-Since header $Contype = 'application/x-www-form-urlencoded'; # Content-type for POST $Debug = 0; # Ask before display? $Quiet = 0; # No headers if Quiet $Out = STDOUT; # ========================================================================== # ========================================================================== # Print the usage information if help requested (-h) or a bad option given. # sub usage { die <<"EndUsage"; usage: $pname [-heq] [-b BaseURL] [-t Timeout] [-i IMS_date] [-c ContentType] [URL ...] $Version -- A program for sending $method requests for World-Wide Web URLs Options: [DEFAULT] -h Help -- just display this message and quit. -e Display the request and response headers to STDERR. [STDOUT] -q Don't display the request and response headers. -d Don't display the content (useful for debugging servers). -b Start with the given Base URL. [$Base] -t Start with the given Timeout value (in seconds) [$Tout] -i Add the If-Modified-Since header (an HTTP date) to GET requests. -c Use the given MIME Content-type for POST, PUT, and CHECKIN requests. [$Contype] URL ... Perform the $method request on each URL listed. If no URLs are listed on the command-line, the program enters an interactive mode. The following commands are available interactively: base=BaseURL -- changes the current Base URL to that given. tout=NNNN -- sets the current Timeout value (in seconds). ims=IMS_date -- sets the If-Modified-Since header value. URL -- performs the request on the given URL. EndUsage } # ========================================================================== # Get the command-line options if (!(&Getopts('heqdb:i:t:c:')) || $opt_h) { &usage; } if ($opt_e) { $Out = STDERR; } if ($opt_q) { $Quiet = 1; } if ($opt_d) { $Debug = 1; } if ($opt_b) { $Base = $opt_b; } if ($opt_i) { $Ims = $opt_i; } if ($opt_c) { $Contype = $opt_c; } if ($opt_t) { $Tout = $opt_t if ($opt_t =~ /\d+/); } # ========================================================================== # Do the work if ($#ARGV >= 0) { # Quickie, one-line version $Interactive = 0; foreach $arg (@ARGV) { $url = &wwwurl'absolute($Base, $arg); &do_req($method, $url); } } else { # Interactive version $Interactive = 1; print "Enter a command or URL (^D to exit): "; while () { chop; if (/^base=(.*)$/) { $Base = $1; next; } if (/^tout=(\d+)$/) { $Tout = $1; next; } if (/^ims=(.*)$/) { $Ims = $1; next; } $url = &wwwurl'absolute($Base, $_); &do_req($method, $url); } continue { print "\n==========================================================\n"; print "Enter a URL (^D to exit): "; } print "\n"; } exit(0); #----------------------------------------------------------------- sub do_req { local($method, $url) = @_; local($hd, $response); local(%headers) = (); local($headers) = ''; local($content) = ''; if ($method eq 'GET') { if ($Ims) { $headers{'If-Modified-Since'} = $Ims; } } elsif (($method eq 'POST') || ($method eq 'PUT') || ($method eq 'CHECKIN')) { if ($Interactive) { print "Enter content-type [$Contype]: "; $_ = ; chop; if (/^\S/) { $Contype = $_; } print 'Enter content ("." to end): ', "\n"; } while () { last if (/^\.$/); chop; $content .= $_; } $headers{'Content-type'} = $Contype; $headers{'Content-length'} = length($content); } print($Out "$method $url HTTP/1.0\n") # Show user what it looks like unless $Quiet; # and then do the request $response = &www'request($method, $url, *headers, *content, $Tout); if (!$Quiet) { foreach $hd (keys(%headers)) # This is cheating, but it shows { # the default headers generated next if ($hd =~ m#^[a-z]#); # by the www.pl request library. print($Out "$hd: $headers{$hd}\n"); } print($Out "\n"); # And print out the result if ($headers) { print($Out $headers); } else { print($Out "HTTP/1.0 $response $wwwerror'RespMessage{$response}\n"); foreach $hd (keys(%headers)) { next if ($hd =~ m#^[A-Z]#); print($Out "$hd: $headers{$hd}\n"); } } print($Out "\n"); } if ($Debug) { if ($Interactive) { print 'Do you want the content displayed (y/n)? [n] '; $_ = ; chop; if (/^y/i) { print $content if defined($content); } } } else { print $content if defined($content); } } 1;