#!/usr/bin/perl -w
#################################################################
#### NOTE: THIS COPY HAS HAD LIBRARIES AUTOMATICALLY INLINED ####
#################################################################
$version = "941227.5";

## 2do
## make -v work cleanly with TTY output
## add a retry option for failed name lookups.
##

## Where latest version should be.
$WEB_normal  = 'http://www.wg.omron.co.jp/~jfriedl/perl/httpget';
$WEB_inlined = 'http://www.wg.omron.co.jp/~jfriedl/perl/inlined/httpget';

##
## httpget
##
## Jeffrey Friedl (jfriedl@omron.co.jp), July 1994.
## Copyright 19.... ah hell, just take it.
## Should work with either perl4 or perl5
##
## "941227.5";
##   Added follow stuff (with -nofollow, etc.)
##   Added -updateme. Cool!
##   Some general tidying up.
##
## "941107.4";
##   Allowed for ^M ending a header line... PCs give those kind of headers.
##
## "940820.3";
##   First sorta'clean net release.
##
##
## BLURB:
## Given an HTTP URL on the command line, httpget fetches the named object
## (HTML text, images, audio, whatever the object happens to be). Will
## automatically work with a proxy if the environment is so defined.
## Works with perl4 or perl5.
##
##>
##
## Fetch http URLs given on the command line and spit to
## STDOUT.  Thrown together for your edification (whatever
## that is).
##
## If the first argument is "-post" and a URL looks like
## reply to a form (i.e. has a '?' in it), the request is
## POSTed instead of GETed
##
## The header is normally stripped, but can be kept with the
## -nostrip (or -ns) option. The -verbose (or -v) option
## will print the header to stderr.
##
## Normally, "this document has moved" replies are followed. 
## This can be suppressed with -nofollow or -nf. Since you
## probably want to know about when something has moved, a
## message is printed when a pointer is followed.  This can
## be suppressed with -quiet (or -q).
##
## The response status will be printed to stderr if anything
## other than "OK" (or "Found" if following moved
## documents).  This can be suppressed with -q or -quiet.
##
## If the 'http_proxy' environmental variable is set,
## httpget will use it (unless the '-noproxy' flag is
## given). 'no_proxy' is also supported.
##
## The special and rather cool flag "-updateme" will see if
## httpget has been updated since you got your version, and
## prepare a local version of the new version for you to
## use. Keep updated! (although you can always ask to be put
## on the ping list to be notified when there's a new
## version -- see the auther's perl web page).
##
##<
##

&package__home_ari7_jfriedl_public_html_perl_network_pl_init; ## automatic inline of "network.pl"
&package__home_ari7_jfriedl_public_html_perl_Www_pl_init; ## automatic inline of "Www.pl"
$inlined=1;           ## this might be changed by a the inline thing.

$WEB = $inlined ? $WEB_inlined : $WEB_normal;

$strip = 1;           ## default is to strip
$verbose = 0;         ## verbose normally off
$quiet = 0;           ## also normally off.
$showinfo = 0;        ## if true, show running info about bytes read.
$follow = 1;          ## normally, we follow "Found (302)" links
$defaultdelta2print = 2048;
$doing_update = 0;    ## see &updateme;

while (@ARGV && $ARGV[0] =~ m/^-/) {
    $arg = shift(@ARGV);

    $follow=0,	 			next if $arg =~ m/^-no?f(ollow)?$/;
    $post = 1,				next if $arg =~ m/^-p(ost)?$/i;
    $showinfo = 1,			next if $arg =~ m/^-i(nfo)?$/;
    $strip = 0,				next if $arg =~ m/^-(ns|nostrip)$/;
    ($quiet=0, $verbose=$showinfo=1),   next if $arg =~ m/^-v(erbose)?$/;
    ($verbose=0, $quiet=1), 		next if $arg =~ m/^-q(uiet)?$/;
    delete $ENV{'http_proxy'},		next if $arg =~ m/^-no?p(roxy)?$/;
    &showhelp,               	     exit(0) if $arg =~ m/^-h(elp)?$/;
    &updateme				     if $arg eq '-updateme';

    warn qq/$0: unknown option "$arg"\n/;
    &showhelp;
    exit(1);
}

if (@ARGV == 0) {
   warn "$0: nothing to do. Use -help for info.\n";
   exit(0);
}
&do(@ARGV);
exit(0);

###########################################################################
###########################################################################

sub showhelp
{
    print STDERR <<INLINE_LITERAL_TEXT;
usage: $0 [options] URL [URL ...]
Requests and prints the named http URL(s). The "http://" may be omitted.

Options are from among:
 -v, -verbose    print to STDERR the HTTP header and running "bytes read" info
 -ns, -nostrip   the HTTP header, normally striped from the output, is kept
 -nf, -nofollow  don't follow "this document has moved" replies.
 -q, -quiet      the warning printed upon non-"OK" response is suppressed
 -i, -info       prints running "bytes read" info to STDERR
 -h, -help       prints this message
 -np, -noproxy   uses no proxy, even if http_proxy defined

 -updateme       Pull the latest version of http from
   $WEB
and report if it's newer than your current version.
INLINE_LITERAL_TEXT
}

##
## Pull the latest version of this program to a local file.
## Clip the first couple lines from this executing file so that we
## preserve the local invocation style.
##
sub updateme
{
    $doing_update = 1;
    $showinfo = 1 unless $quiet;

    ##
    ## Open a temp file to hold the new version,
    ## redirecting STDOUT to it.
    ##
    open(STDOUT, '>'.($tempFile="/tmp/newHTTP"))     ||
    open(STDOUT, '>'.($tempFile="/usr/tmp/newHTTP")) ||
    open(STDOUT, '>'.($tempFile="/newHTTP"))         ||
    open(STDOUT, '>'.($tempFile="newHTTP"))          ||
	die "$0: can't open a temp file.\n";

    ##
    ## See if we can figure out how we were called.
    ## The seek will rewind not to the start of the data, but to the
    ## start of the whole program script.
    ## 
    ## Keep the first line if it begins with #!, and the next two if they
    ## look like the trick mentioned in the perl man page for getting
    ## around the lack of #!-support.
    ##
    if (seek(DATA, 0, 0)) { ## 
	$_ = <DATA>; if (m/^#!/) { print;
	    $_ = <DATA>; if (m/^\s*eval/) { print;
		$_ = <DATA>; if (m/^\s*if/) { print; }
	    }
	}
	print "\n#-\n";
    }

    ## Go get the latest one...
    print STDERR qq/Checking "$WEB"....\n/ unless $quiet;
    &do($WEB);
    close(STDOUT);
    $fetched_version = "<unknown>" unless defined $fetched_version;

    ##
    ## Try to update the mode of the temp file with the mode of this file.
    ## Don't worry if it fails.
    ##
    chmod($mode, $tempFile) if $mode = (stat($0))[2];

    $as_well = '';
    if ($fetched_version eq $version) {
	print STDERR "You already have the most-recent version ($version).\n",
		     qq/FWIW, fetched one left in "$tempFile".\n/;
    } elsif ($fetched_version <= $version) {
	print STDERR
	    "Mmm, your current version seems newer (?!):\n",
	    qq/  your version: "$version"\n/,
	    qq/  new version:  "$fetched_version"\n/,
	    qq/FWIW, fetched one left in "$tempFile".\n/;
    } else {
	print STDERR
	    "Inded, your current version was old:\n",
	    qq/  your version: "$version"\n/,
	    qq/  new version:  "$fetched_version"\n/,
	    qq/The file "$tempFile" is ready to replace the old one.\n/;
	print STDERR qq/Just do:\n  % mv $tempFile $0\n/ if -f $0;
	$as_well = ' as well';
    }
    print STDERR "Note that the libraries it uses may (or may not) need updating$as_well.\n"
	unless $inlined;
    exit(0);
}

##
## Given a list of URLs, fetch'em.
##
sub do {
  local(@todo) = @_;
  URL_LOOP: while (@todo)
  {
      $URL = shift(@todo);
      %hold_circref = %circref; undef %circref;

      ##
      ## If this looks like a form, and we're told to post, set $text to the
      ## post message content. Otherwise, make sure it's undefined.
      ##
      $text = (defined $post && $URL =~ s/\?(.*)//) ? $1 : undef;

      ##
      ## Attempt to request the URL. If successful, we can read the
      ## response via IN.
      ##

      print STDERR "connecting...\r" if $showinfo;
      if ($error = &Www'get_http(*IN, $URL, $text))
      {
	  warn qq/$error in "$URL"\n/;
	  next URL_LOOP;
      }
      print STDERR "waiting for data....   \r" if $showinfo;

      ## we can now read the response (header, then body) via IN.
      binmode(IN); ## just in case.

      ##
      ## The first line of the response will be the status (OK, error, etc.)
      ##

      if (!defined($_ = <IN>)) {
	  warn qq/empty response for "$URL"\n/;
	  next URL_LOOP;
      }

      ## Check the status line. If it doesn't match and we don't know the
      ## format, we'll just let it pass and hope for the best.
      if (m%^HTTP\S+\s+(\d\d\d)\s*(.*)$%i)
      {
	  ($code, $prose) = ($1, $2);
	  if ($follow && $code == 302) { ## 302 is magic for "Found"
	      local($newURL, @header);
	      while (<IN>) {
		  push(@header, @_) unless $strip;
		  last if m/^\s*$/;
		  $newURL = $1, last if m/^Location:\s*(.*\S)/;
	      }
	      if (!defined $newURL) {
		  warn "$0: can't parse 'Found' header?!\n";
		  print @header, <IN> unless $strip;
		  next URL_LOOP;
	      }
	      if ($newURL !~ m/^http:/) {
		  print STDERR
		      "$0: URL has moved to an address I don't understand:\n",
		       "  old: $URL\n",
		       "  new: $newURL\n";
		  next URL_LOOP;
	      }
	      ## Remove :80 from hostname, if there. Looks ugly.
	      $newURL =~ s,^(http:/+[^/:]+):80/,$1/, unless $URL =~  m/:80/;

	      if (defined $hold_circref{$newURL}) {
		  print STDERR "$0: seems $URL caught in a circular ", 
			       "reference among:\n    ",
			       join("\n    ", sort keys %hold_circref), "\n";
		  next URL_LOOP;
	      }
	      unless ($quiet) {
		  $tmp = $newURL;
		  if ((chop($tmp) eq '/') && ($tmp eq $URL)) {
		      print STDERR
			  qq%Warning: a directory URL must end with "/",%,
			  "re-fetching\n    $URL\nwith proper address......\n";
		  } else {
		       print STDERR
			  "$0: URL has moved, fetching from new address.\n",
			  "  old: $URL\n",
			  "  new: $newURL\n";
		  }
	      }

	      %circref = %hold_circref;
	      $circref{$newURL} = $circref{$URL} = 1;
	      unshift(@todo, $newURL);
	      next URL_LOOP;

	  } elsif ($code != 200) { ## 200 is magic for "OK";
	      warn "$URL: ($code) $prose\n" if !$quiet && !$verbose;

	      ## there's lots that could be done here.
	      ## Here are some notable codes:
	      ##
	      ##  	OK 200
	      ##  	CREATED 201
	      ##  	Accepted 202
	      ##  	Partial Information 203
	      ##  	No Response 204
	      ##		Found 302 -- follow name at Location field.
	      ##  	Error 4xx, 5xx
	      ##  	Bad request 400
	      ##  	Unauthorized 401
	      ##  	PaymentRequired 402
	      ##  	Forbidden 403
	      ##  	Not found 404
	      ##  	Internal Error 500
	      ##  	Not implemented 501
	      ##  	Redirection 3xx
	      ##  	Moved 301
	      ##  	Found 302
	      ##  	Method 303
	      ##  	Not Modified 304
	  }
      }

      undef $length;
      ## starting with the current line, process the header
      while (defined $_)
      {
	  print unless $strip;
	  print STDERR if $verbose;
	  last if m/^
?$/; ## end of header
	  $length = $1 if /^Content-length:\s*(\d+)/i;
	  $_ = <IN>; ## get the next line to deal with
      }

      #######
      ## Now read and print the body.
      #######
      $lastcount = $bytes = 0;

      ## Figure out how often to print the "bytes read" message
      $delta2print = (defined $length) ? int($length/50) : $defaultdelta2print;

      print STDERR "read 0 bytes                   \r" if $showinfo;

      while (defined($_ = <IN>))
      {
	  ## shove it out.
	  print;

	  if ($doing_update && !defined $fetched_version) {
	     ## big kluge. Get the version number from what we're reading.
	     $fetched_version = $1 if m/version\s*=\s*"([^"]+)"/;
	  }

	  ## if we know the content-length, keep track of what we're reading.
	  $bytes += length;
	  last if eof || (defined $length && $bytes >= $length);

	  if ($showinfo && $bytes > $lastcount + $delta2print) {
	       $lastcount = $bytes;
	       if (defined $length) {
		  printf STDERR "read $bytes bytes (%.0f%%) \r",
		      $bytes * 100 / $length;
	       } else {
		  printf STDERR "read $bytes bytes \r";
	       }
	  }
      }
  } continue {   
      print STDERR "\r", ' ' x 40, "\r" if $showinfo;
      close(IN);
  }
}



## start of inline of /home/ari7/jfriedl/public_html/perl/Www.pl
######################################################################

package main; sub package__home_ari7_jfriedl_public_html_perl_Www_pl_init {
##
## Jeffrey Friedl (jfriedl@omron.co.jp)
## Copyri.... ah hell, just take it.
##
package Www;
$version = "940820.2";
## version 940820.2 -- added proxy support

## BLURB:
##    A few routines for slinging HTTP. Requires my network library.
##    &get_http will, given a URL, return a filehandle from which the
##    URL's target stuff can be read. CERN proxies are supported.
##    &grok_url will split a URL into host, port, and path components.
##

##>
## Some HTTP routines
##
## $error = &get_http(*FD, $url);
##
##   Opens a connection to fetch the named HTTP URL (in which the leading
##   "http://" is optional). FD can then be used as if from an open.  Make
##   sure to close when you're done.
##
##   Normally returns 'undef'. Returns an error message on error.
##
## An example to print my home page:
##
##    $error = &get_http(*FD, "www.wg.omron.co.jp/cgi-bin/j-e/jfriedl.html");
##    die $error if defined $error;
##    print while <FD>;
##    close(FD);
##
##############################################################
##
## $error = &get_http(*FD, $url, $post);
##
##   Like above, but this sends a POST instead of a GET, and sends the
##   contents of $post.
##
################################################################
##
## This routine will use the CERN HTTPD proxy if the 'http_proxy'
## environmental variable is defined. The variable is queried at each call,
## so changes between calls are noticed.
##
## The proxy will not be used if
##	1) the requested URL is at the proxy itself
##      2) the requested URL is at a machine noted in 'no_proxy'.
##
## Note that unlinke 'http_proxy', the 'no_proxy' environmental variable is
## not reread each time.  The first time it's found to exist, its contents
## are parsed and saved.
##
## Also note that the host is compared to each machine in 'no_proxy' on a
## string-compare basis, and that two names for the same machine will not
## match. This is considered a feature. I think.
##<

$default_port = 80;  ## default port to use when not specified.

sub get_http ##public
{
    local(*FD, $url, $post) = @_;

    local($host, $port, $path) = &grok_url($url); ## parse URL
    return qq/get_http: can't grok "$url"/ unless defined $host;

    ## If there's a proxy and we're to proxy this request, do so.
    if (defined $ENV{'http_proxy'} && !&no_proxy($host, $port)) {
	($path = $url) =~ s,^((http:)/+)?,http://,; ## ensure "httpd//" there.
	($host, $port) = &grok_url($ENV{'http_proxy'});
    }

    ## set default path if needed
    $path = '/' if !defined($path) || $path eq '';
 
    ## make the connection to the host
    local($error) = &network'connect_to(*FD, $host, $port);
    return $error if $error;

    ## send the POST or GET request
    print FD (defined $post ? 'POST' : 'GET'), " $path HTTP/1.0\n";

    ## oh, let's sputter a few platitudes.....
    print FD "Accept: */*\n";

    ## If it's a post, send it.
    if (defined $post) {
	print FD "Content-type: application/x-www-form-urlencoded\n";
	print FD "Content-length: ", length $post, "\n\n";
	print FD $post, "\n";
    }
    print FD "\n";
    undef; ## indicates "no error"
}

##
## Given an HTTP URL, returns ($host, $port, $path)
##
sub grok_url ##public
{
    local($_) = @_;
    local($host, $port, $path);
    if (m%^((http:)?/+)?([^/:]+)(:(\d+))?(/.*)?$%) {
	($host, $port, $path) = ($3, defined $5 ? $5 : $default_port, $6);
    }
    ($host, $port, $path);
}

##
## &no_proxy($host, $port)
##
## Returns true if the specified host/port are identified in the
## no_proxy environmental variable, or identify the proxy server itself.
##
sub no_proxy
{
    local($host, $port) = @_;
    local($host) = join(';', $host, defined $port ? $port : $default_port);

    if (!defined %no_proxy && defined $ENV{'no_proxy'})
    {
	grep(
	    $no_proxy{join(':',(&grok_url($_))[0,1])} = 1,
	    split(/\s*,\s*/, $ENV{'no_proxy'})
	);
    }

    ## NO PROXY if the requested host/port is the proxy itself
    return 1 if $host eq join(':',(&grok_url($ENV{'http_proxy'}))[0,1]);

    ## NO PROXY if the requested host/port is in the array.
    return defined $no_proxy{$host};
}

## This here just to quiet -w warnings.
sub dummy {
  1 || $version || &dummy;
}

1;


} # end of inline of /home/ari7/jfriedl/public_html/perl/Www.pl

## start of inline of /home/ari7/jfriedl/public_html/perl/network.pl
######################################################################

package main; sub package__home_ari7_jfriedl_public_html_perl_network_pl_init {
##
## Jeffrey Friedl (jfriedl@omron.co.jp)
## Copyri.... ah hell, just take it.
##
## July 1994
##
package network;
$version = "950311.5";

## version 950311.5 -- turned off warnings when requiring 'socket.ph';
## version 941028.4 -- some changes to quiet perl5 warnings.
## version 940826.3 -- added check for "socket.ph", and alternate use of
## socket STREAM value for SunOS5.x
##

## BLURB:
## A few simple and easy-to-use routines to make internet connections. 
## Similar to "chat2.pl" (but actually commented, and a bit more portable).
## Should work even on SunOS5.x.
##

##>
##
## connect_to() -- make an internet connection to a server.
##
## Two uses:
##	$error = &network'connect_to(*FILEHANDLE, $fromsockaddr, $tosockaddr)
##      $error = &network'connect_to(*FILEHANDLE, $hostname, $portnum)
##
## Makes the given connection and returns an error string, or undef if
## no error.
##
## In the first form, FROMSOCKADDR and TOSOCKADDR are of the form returned
## by SOCKET'GET_ADDR and SOCKET'MY_ADDR.
##
##<
sub connect_to
{
    local(*FD, $arg1, $arg2) = @_;
    local($from, $to)   = ($arg1, $arg2); ## for one interpretation.
    local($host, $port) = ($arg1, $arg2); ## for the other

    if (defined($to) && length($from)==16 && length($to)==16) {
	## ok just as is
    } elsif (defined($host)) {
	$to = &get_addr($host, $port);
	return qq/unknown address "$host"/ unless defined $to;
	$from = &my_addr;
    } else {
	return "unknown arguments to network'connect_to";
    }

    return "connect_to failed (socket: $!)"  unless &my_inet_socket(*FD);
    return "connect_to failed (bind: $!)"    unless bind(FD, $from);
    return "connect_to failed (connect: $!)" unless connect(FD, $to);
    local($old) = select(FD); $| = 1; select($old);
    undef;
}

##>
##
## listen_at() - used by a server to indicate that it will accept requests
##               at the port number given.
##
## Used as
##	$error = &network'listen_at(*LISTEN, $portnumber);
## (returns undef upon success)
##
## You can then do something like
##     $addr = accept(REMOTE, LISTEN);
##     print "contact from ", &network'addr_to_ascii($addr), ".\n";
##     while (<REMOTE>) {
##        .... process request....
##     }
##     close(REMOTE);
##
##<
sub listen_at
{
    local(*FD, $port) = @_;
    local($empty) = pack('S n a4 x8', 2 ,$port, "\0\0\0\0");
    return "listen_for failed (socket: $!)"  unless &my_inet_socket(*FD);
    return "listen_for failed (bind: $!)"    unless bind(FD, $empty);
    return "listen_for failed (listen: $!)"  unless listen(FD, 5);
    local($old) = select(FD); $| = 1; select($old);
    undef;
}

##>
##
## Given an internal packed internet address (as returned by &connect_to
## or &get_addr), return a printable ``1.2.3.4'' version.
##
##<
sub addr_to_ascii
{
    local($addr) = @_;
    return "bad arg" if length $addr != 16;
    return join('.', unpack("CCCC", (unpack('S n a4 x8', $addr))[2]));
}

##
## 
## Given a host and a port name, returns the packed socket addresss.
## Mostly for internal use.
##
##
sub get_addr
{
    local($host, $port) = @_;
    return $addr{$host,$port} if defined $addr{$host,$port};
    local($addr);

    if ($host =~ m/^\d+\.\d+\.\d+\.\d+$/)
    {
	$addr = pack("C4", split(/\./, $host));
    }
    elsif ($addr = (gethostbyname($host))[4], !defined $addr)
    {
        local(@lookup) = `nslookup $host 2>&1`;
	if (@lookup)
	{
	    local($lookup) = join('', @lookup[2 .. $#lookup]);
	    if ($lookup =~ m/^Address:\s*(\d+\.\d+\.\d+\.\d+)/) {
	        $addr = pack("C4", split(/\./, $1));
	    }
	}
	if (!defined $addr) {
	    ## warn "$host: SOL, dude\n";
	    return undef;
	}
    }
    $addr{$host,$port} = pack('S n a4 x8', 2 ,$port, $addr);
}

##
## my_addr()
## Returns the packed socket address of the local host (port 0)
## Mostly for internal use.
##
##
sub my_addr
{
    return $addr{'me'} if defined $addr{'me'};
    chop($_myhostname_ = `hostname`) if !defined $_myhostname_;
    $addr{'me'} = &get_addr($_myhostname_, 0);
}

##
## my_inet_socket(*FD);
##
## Local routine to do socket(PF_INET, SOCK_STREAM, AF_NS).
## Takes care of figuring out the proper values for the args. Hopefully.
##
## Returns the same value as 'socket'.
##
sub my_inet_socket
{
    local(*FD) = @_;
    local($socket);

    if (!defined $socket_values_queried)
    {
	## try to load some "socket.ph"
	if (!defined &main'_SYS_SOCKET_H_) {
	  eval 'package main;
	        local($^W) = 0;
                require("sys/socket.ph")||require("socket.ph");';
	}

	## we'll use "the regular defaults" if for PF_INET and AF_NS if unknown
	$PF_INET     = defined &main'PF_INET ? &main'PF_INET : 2;
	$AF_NS       = defined &main'AF_NS   ? &main'AF_NS   : 6;
	$SOCK_STREAM = &main'SOCK_STREAM if defined &main'SOCK_STREAM;

	$socket_values_queried = 1;
    }

    if (defined $SOCK_STREAM) {
	$socket = socket(FD, $PF_INET, $SOCK_STREAM, $AF_NS);
    } else {
	##
	## We'll try the "regular default" of 1. If that returns a
	## "not supported" error, we'll try 2, which SunOS5.x uses.
	##
	$socket = socket(FD, $PF_INET, 1, $AF_NS);
	if ($socket) {
	    $SOCK_STREAM = 1; ## got it.
	} elsif ($! =~ m/not supported/i) {
	    ## we'll just assume from now on that it's 2.
	    $socket = socket(FD, $PF_INET, $SOCK_STREAM = 2, $AF_NS);
	}
    }
    $socket;
}

## This here just to quiet -w warnings.
sub dummy {
  1 || $version || &dummy;
}

1;


} # end of inline of /home/ari7/jfriedl/public_html/perl/network.pl

__END__
