A stand-alone HTTP-only LWP::Simple get()

Robert Munafo (munafo@gcctech.com)
Tue, 18 Jan 2000 23:24:00 -0500 

q%              (yes, this message is executable)

   I learned about LWP through the Operating System Sucks-Rules-O-Meter
(http://srom.zgp.org/) and decided I wanted to write some simple perl
scripts that fetch data from the Internet. I was soon surprised when I
found out how many files had to be installed to get such a little script
to work. Something as simple as:

  #!/usr/bin/perl
  use LWP::Simple;
  $_ = get("http://www.cnn.com/");
  s/<[^>]+>//g; s/^.*E-MAIL//s; s/FULL STORY.*$//s;
  s/\n[ \t\n\r]+/\n/g; print;

requires the entire LWP library, and 5 or 6 other libraries as well, to
run. I started installing the necessary libraries but about halfway
through the process I decided it was better to find out just what code
was actually used by the get() routine. I knew that a minimal HTTP GET
is very simple to implement, and indeed I discovered that only about 80
lines of code from LWP were being used, including the proxy and redirect
handling.

So, as a service (hopefully) to others writing really simple scripts
like this, I have created SimpleGet.pl, a stand-alone library that
implements an HTTP-only get() and getprint(). The example script above
works by replacing 'use LWP::Simple;' with 'require SimpleGet.pl;',
provided that you have put SimpleGet.pl in your @INC.

SimpleGet.pl is at http://www.mrob.com/SimpleGet.txt , and appended here
for those who are interested. Comments and suggestions are welcome.

  - Robert Munafo

%, "--------SimpleGet.pl follows--------", print <<'endquote';
#!/usr/bin/perl
#
# SimpleGet.pl  -- standalone replacement for LWP::Simple
#
# This is a fairly minimal implementation of the HTTP GET protocol in
# Perl. It only does the 'GET' method via http (not https), and handles
# proxies and redirects but nothing more complicated. It is designed to
# be a simple replacement for the LWP library for scripts that only
# use the get() and getprint() routines.
#
# It should be noted that web client Perl scripts fall into two general
# categories: Simple scripts that just get a page and grab one small
# bit of information from it, and complex tools like browsers, robots,
# site-shadowing utilities, custom search engines, etc. For the simple
# category, the LWP library and the other libraries it depends on
# (over 1.5 megabytes) is overkill.
#
# To use this code, put it in a file called "SimpleGet.pl" somewhere
# in your Perl @INC searchpath, such as /usr/lib/perl5/site_perl
# then add this line to your Perl script:
#
#   require "SimpleGet.pl";
#
# Each of the following is equivalent:
#
#   get "http://www.mrob.com"; print; $err = $http_get_result;
#   $_ = get("http://www.mrob.com"); print $_; $err = $http_get_result;
#   $err = getprint("http://www.mrob.com");
#
# get() reads the data via HTTP and returns it. getprint() sends the
# data to STDOUT with relatively low memory overhead (useful if the
# data is large)
#
# If you want to do anything more than loading simple pages and parsing
# their contents yourself, you should use LWP. LWP is a great set of
# libraries including such functions as MIME support, HTML parsing,
# handling of other transfer protocols like HTTPS and FTP, and much
# more. To learn more, see http://www.linpro.no/lwp/
#
# Existing web-client scripts that contain 'use LWP::Simple;' and only
# call the get() and/or getprint() functions can be converted to use
# SimpleGet by replacing the 'use LWP::Simple;' line with
# 'require "SimpleGet.pl";'
#
# Two extensions have been added to the functionality provided by the
# LWP get() and getprint() routines:
#   - Set the variable $http_no_cache to 1 to force proxies to reload,
#     or to 0 for a normal GET.
#   - The variable $http_get_result is set to the result code (e.g. 200
#     or 404). (It is also the return value of getprint())
#
# Copyright, Usage, Feedback, etc:
#
#   This library is free software; you can redistribute it and/or
#   modify it under the same terms as Perl itself.
#
# The minimal adaptation of LWP::Simple was created by Robert Munafo
# (www.mrob.com) from the LWP code. If you have problems, suggestions,
# or feedback regarding this file, please send them to "mrob at mrob
# dot com". Please don't bother Gisle Aas (the primary author of LWP)
# about it because it isn't his creation.
#
# 20000114 Initial version, derived from LWP::Simple, with minor
additions
#   to handle http_proxy
# 20000117 Add $http_get_result and get_to_stdout().
# 20000118 Add $http_no_cache. Rename get_to_stdout() to getprint,
#   because that's what it's called in LWP.

require 5.004;

sub _trivial_http_get
{
  my($host, $port, $path) = @_;
  my($AGENT, $VERSION, $p);
  #print "HOST=$host, PORT=$port, PATH=$path\n";

  $AGENT = "get-minimal";
  $VERSION = "20000113";

  $path =~ s/ /%20/g;

  require IO::Socket;
  local($^W) = 0;
  my $sock = IO::Socket::INET->new(PeerAddr => $host,
                                   PeerPort => $port,
                                   Proto   => 'tcp',
                                   Timeout  => 60) || return;
  $sock->autoflush;
  my $netloc = $host;
  $netloc .= ":$port" if $port != 80;
  my $request = "GET $path HTTP/1.0\015\012"
              . "Host: $netloc\015\012"
              . "User-Agent: $AGENT/$VERSION/u\015\012";
  $request .= "Pragma: no-cache\015\012" if ($http_no_cache);
  $request .= "\015\012";
  print $sock $request;

  my $buf = "";
  my $n;
  my $b1 = "";
  while ($n = sysread($sock, $buf, 8*1024, length($buf))) {
    if ($b1 eq "") { # first block?
      $b1 = $buf;         # Save this for errorcode parsing
      $buf =~ s/.+?\015?\012\015?\012//s;      # zap header
    }
    if ($http_stream_out) { print $buf; $buf = ""; }
  }
  return undef unless defined($n);

  $http_get_result = 200;
  if ($b1 =~ m,^HTTP/\d+\.\d+\s+(\d+)[^\012]*\012,) {
    $http_get_result = $1;
    # print "CODE=$http_get_result\n$b1\n";
    if ($http_get_result =~ /^30[1237]/ && $b1 =~
/\012Location:\s*(\S+)/) {
      # redirect
      my $url = $1;
      return undef if $http_loop_check{$url}++;
      return _get($url);
    }
    return undef unless $http_get_result =~ /^2/;
  }

  return $buf;
}

sub _get
{
  my $url = shift;
  my $proxy = "";
  grep {(lc($_) eq "http_proxy") && ($proxy = $ENV{$_})} keys %ENV;
  if (($proxy eq "") && $url =~ m,^http://([^/:]+)(?::(\d+))?(/\S*)?$,)
{
    my $host = $1;
    my $port = $2 || 80;
    my $path = $3;
    $path = "/" unless defined($path);
    return _trivial_http_get($host, $port, $path);
  } elsif ($proxy =~ m,^http://([^/:]+):(\d+)(/\S*)?$,) {
    my $host = $1;
    my $port = $2;
    my $path = $url;
    return _trivial_http_get($host, $port, $path);
  } else {
    return undef;
  }
}

sub get ($)
{
  $http_stream_out = 0;

  %http_loop_check = ();
  goto \&_get;
}

sub getprint ($)
{
  my $url = shift;

  $http_stream_out = 1;

  %http_loop_check = ();
  _get($url);

  return $http_get_result;
}

# end of SimpleGet.pl
endquote