#!/usr/local/bin/perl

#########################################################
#                 A WWW header grabber.                 #
# Basically, given an http address it will get you      #
# the HTTP/1.0 response header to validate links or get #
# other header info without the body.                   #
#                                                       #
# Usage:  wwwhead http://site.name.edu/ [filename]      #
#                                                       #
# ex.  wwwhead http://www.engr.wisc.edu/~ballard/       #
# will get you the response headers my homepage and     #
# wwwhead http://www.engr.wisc.edu/~ballard/pics/me.gif #
# will get you a header for a .gif image.               #
#                                                       #
#########################################################
# Written by Jeff Ballard (ballard@cae.wisc.edu) 7/2/95 #
#              URL:  http://www.engr.wisc.edu/~ballard/ #
# Modified by David Efflandt (efflandt@xnet.com)        #
# 7/28/97      URL:  http://www.xnet.com/~efflandt/     #
#########################################################
#                                                       #
# Feel free to contact me with any questions/comments/  #
#  and such.                                            #
#                                                       #
#########################################################
# This program is freeware.  *NO* warranty is expressed,#
# implied, nor granted to you in any way.  Use of this  #
# program is at your own risk.  Your milage may vary.   #
# This progarm was packed by weight, not by volume.     #
# Some settling may have occurred during shipment.      #
#########################################################
# Much thanks to Brendan Kehoe <brendan@cygnus.com>     #
# URL: http://www.zen.org/~brendan/                     #
# for his help in getting rid of the constants          #
#########################################################

# Required for perl5.
use Socket;

# Given an http address, rip it into its coresponding parts.

($_, $savefilename) = @ARGV;

if (!$_) {
  print "Usage:  $0 http://www.any.site/location [outputfilename]\n";
  print "  Where [outputfilename] is the optional filename to create.\n";
  print "  (ommitting this means that it will mean that the data will be\n";
  die "  sent to STDOUT.  If this file exists, it will be overwritten)\n";
}

/http:\/\/([^\/]*)\/*([^ ]*)/;
$site = $1;
$file = "/".$2;

if (!$site) {
  die "$0:  Fatal Error.  You appear to have munged your URL address.\nIt must be in the form of http://www.any.site/location\n";
}

$_ = $site;
/^([^:]*):*([^ ]*)/;
$site = $1;
$port = $2;
$port = 80 unless $port;

$hostname = $site;

#print STDERR "[$site] [$port] [$file]\n";

# Open a socket and get the data
  ($sockaddr,$there,$response,$tries) = ("Snc4x8");
  $there = pack($sockaddr,2,$port, &getaddress($hostname));
  ($a, $b, $c, $d) = unpack('C4', $hostaddr);

  $proto = (getprotobyname ('tcp'))[2];

  if (!socket(S,AF_INET,SOCK_STREAM,$proto)) { die "$0:  Fatal Error.  $!\n"; }
  if (!connect(S,$there)) { die "$0:  Fatal Error.  $!\n"; }
  select(S);$|=1;
  select(STDOUT);
  print S "HEAD $file HTTP/1.0\n";
  print S 'Host: ' . "$hostname\n\n";
  if ($savefilename) {
    open(OUT,">$savefilename") || die "$0: Cannot create $savefilename.\n";
  }
  while($line = <S>) {
    if ($savefilename) {
      print OUT $line;
    } else {
      print $line;
    }
  }
  close(S);
  if ($savefilename) {
    close(OUT);
  }


sub getaddress {
  local($host) = @_;
  local(@ary);
  @ary = gethostbyname($host);
  return(unpack("C4",$ary[4]));
}