#!/usr/local/bin/perl
############################################################
#                       HTTP_LIB.PL
#
# This script was written by Gunther Birznieks.
# Date Created: 5-15-96
#
#   You may copy this under the terms of the GNU General Public
#   License or the Artistic License which is distributed with
#   copies of Perl v5.x for UNIX.
#
# Purpose: Provides a set of library routines to connect as
# a browser to another HTTP site and then return the results to
# the caller.
#
# Main Procedures:
#  HTTPGet - Gets a URL using the GET Method
#  HTTPPost - Gets a URL using the POST Method
#
# Set the $http_os variable equal to NT if you are on Windows NT perl
# Set it to UNIX for normal UNIX operations.
#
# If you do not have a version of PERL with the Socket.pm, you
# can manually define $AF_INET and $SOCK_STREAM to 2 and 1 respectively.
# On some systems, SOCK_STREAM may be 2.
#
############################################################

# Use the Sockets library for TCP/IP Communications
use Socket;
$http_os = "UNIX";

############################################################
#
# subroutine: HTTPGet
#   Usage:
#     $buf = &HTTPGet("/index.html", "www.eff.org", 80,
#	"var1=value1&var2=value2&etc=etc);
#
#   Parameters:
#     $url = URL To Connect To Relative to the host
#     $hostname = HostName of WebSite to Connect To
#     $port = port to connect to (normally 80)
#     $in = Form Values To Mimic sending to the site
#
#   Output:
#     HTML Code Output from the Web Server.
#
############################################################

sub HTTPGet {
    local($url, $hostname, $port, $in) = @_;
    local($form_vars, $x, $socket);
    local ($buf);
    $socket = &OpenSocket($hostname, $port);


    $form_vars = &FormatFormVars($in);
# we need to add the ? to the front of the passed
# form variables
    $url .= "?" . $form_vars;

# The following sends the information to the HTTP Server.
    print  $socket <<__END_OF_SOCKET__;
GET $url HTTP/1.0
Accept: text/html
Accept: text/plain
User-Agent: Mozilla/1.0


__END_OF_SOCKET__
   
# RetrieveHTTP retrieves the HTML code
    $buf = &RetrieveHTTP($socket);
    $buf;

} #end of HTTPGet

############################################################
#
# subroutine: HTTPPost
#   Usage:
#     $buf = &HTTPPost("/index.html", "www.eff.org", 80,
#	"var1=value1&var2=value2&etc=etc);
#
#   Parameters:
#     $url = URL To Connect To Relative to the host
#     $hostname = HostName of WebSite to Connect To
#     $port = port to connect to (normally 80)
#     $in = Form Values To Mimic sending to the site
#
#   Output:
#     HTML Code Output from the Web Server.
#
############################################################

sub HTTPPost {
    local($url, $hostname, $port, $in) = @_;
    local($form_vars, $x, $socket);
    local ($buf, $form_var_length);
    $socket = &OpenSocket($hostname, $port);
# The following sends the information to the HTTP Server.

    $form_vars = &FormatFormVars($in);

# We need the length of the form variables
# that are passed to the server to pass as
# content-length.
    $form_var_length = length($form_vars);
    print $socket <<__END_OF_SOCKET__;
POST $url HTTP/1.0
Accept: text/html
Accept: text/plain
User-Agent: Mozilla/1.0
Content-type: application/x-www-form-urlencoded
Content-length: $form_var_length

$form_vars
__END_OF_SOCKET__

    $buf = &RetrieveHTTP($socket);
    $buf;

} #end of HTTPPost

############################################################
#
# subroutine: FormatFormVars
#   Usage:
#     $formvars = &FormatFormVars($in);
#
#   Parameters:
#     $in = form variables to process
#
#   Output:
#     Processed form variables.  Illegal characters
#     are replaced with their %Hexcode equivalents.
#     Currently the routine only handles spaces but
#     could be expanded for more.
#
############################################################

sub FormatFormVars {
    local ($in) = @_; 

    $in =~ s/ /%20/g;

    $in;
} # FormatFormVars

############################################################
#
# subroutine: RetrieveHTTP
#   Usage:
#     $buf = &RetrieveHTTP($socket_handle);
#
#   Parameters:
#     $socket = Handle to the socket we are communicating
#               with
#
#   Output:
#     Buffer containing the output of the HTTP Server
#
############################################################

sub RetrieveHTTP {
    local ($socket) = @_;
    local ($buf,$x, $split_length);

    $buf = read_sock($socket, 6);
# if the buffer has a status code of 200 in it,
# then we know its safe to read in the rest of the document

    if ($buf =~ /200/) {
        while(<$socket>) {
            $buf .= $_;
        }
    }

# We strip off the HTTP header by looking for 
# two newlines or two newlines preceeded with
# carriage returns.  Different Web Servers use
# different delimiters sometimes.
#
    $x = index($buf, "\r\n\r\n");
    $split_length = 4;

    if ($x == -1) {
        $x = index($buf, "\n\n");
        $split_length = 2;
    }
#
# The following actually splits the header off
    if ($x > -1) {
        $buf = substr($buf,$x + $split_length);
    }

    close $socket;

$buf;
} # End of RetrieveHTTP

############################################################
#
# subroutine: OpenSocket
#   Usage:
#     $socket_handle = &OpenSocket($host, $port);
#
#   Parameters:
#     $host = host name to connect to
#     $port = port to connect to
#
#   Output:
#     Handle to socket that was opened
#
############################################################

sub OpenSocket {
    local($hostname, $port) = @_;

    local($ipaddress, $fullipaddress, $packconnectip);
    local($packthishostip);
    local($AF_INET, $SOCK_STREAM, $SOCK_ADDR);
    local($PROTOCOL, $HTTP_PORT); 

# The following variables are set using values defined in
# The sockets.pm library.  If your version of perl (v4) does
# not have the sockets library, you can substitute some 
# default values such as 2 for AF_INIT, and 1 for SOCK_STREAM.
# if 1 does not work for SOCK_STREAM, try using 2.
#
# AF_INET defines the internet class of addressing
#
# SOCK_STREAM is a variable telling the program to use
# a socket connection.  This varies from using SOCK_DGRAM
# which would send UDP datagrams using a connectionless paradigm
# instead.
# 
# PROTOCOL is TCPIP (6).
#
# PORT Should generally be 80 for HTTP Access, some sites use
# alternative ports such as 8080.
#
# SOCK_ADDR is the packeted format of the full socket address
# including the AF_INIT value, HTTP_PORT, and IP ADDRESS in that order
#

    $AF_INET = AF_INET;
    $SOCK_STREAM = SOCK_STREAM;

    $SOCK_ADDR = "S n a4 x8";

# The following routines get the protocol information
#

    $PROTOCOL = (getprotobyname('tcp'))[2];

    $HTTP_PORT = $port;
    $HTTP_PORT = 80 unless ($HTTP_PORT =~ /^\d+$/);
    $PROTOCOL = 6 unless ($PROTOCOL =~ /^\d+$/);

# Ip address is the Address of the host that we need to connect
# to
    $ipaddress = (gethostbyname($hostname))[4];

    $fullipaddress = join (".", unpack("C4", $ipaddress));

    $packconnectip = pack($SOCK_ADDR, $AF_INET, 
		   $HTTP_PORT, $ipaddress);
    $packthishostip = pack($SOCK_ADDR, 
			 $AF_INET, 0, "\0\0\0\0");

# First we allocate the socket
    socket (S, $AF_INET, $SOCK_STREAM, $PROTOCOL) || 
	&web_error( "Can't make socket:$!\n");

# Then we bind the socket to the local host
    bind (S,$packthishostip) || 
	&web_error( "Can't bind:$!\n");
# Then we connect the socket to the remote host
    connect(S, $packconnectip) || 
	&web_error( "Can't connect socket:$!\n");

# The following selects the socket handle and turns off
# output buffering
#
    select(S);
    $| = 1;
    select (STDOUT);

S;
} # End of OpenSocket

############################################################
#
# subroutine: read_sock
#   Usage:
#     &read_socket(SOCKET_HANDLE, $timeout);
#
#   Parameters:
#     SOCKET_HANDLE = Handle to an allocated Socket
#     $timeout = amount of time read_sock is allowed to
#                wait for input before timing out
#                (measured in seconds)
#
#   Output:
#     Buffer containing what was read from the socket
# 
############################################################

sub read_sock {
    local($handle, $endtime) = @_;
    local($localbuf,$buf);
    local($rin,$rout,$nfound);

# Set endtime to be time + endtime.
    $endtime += time;

# Clear buffer
    $buf = "";

# Clear $rin (Read Input variable)
    $rin = '';
# Set $rin to be a vector of the socket file handle
    vec($rin, fileno($handle), 1) = 1;

# nfound is 0 since we have not read anything yet
    $nfound = 0;

# Loop until we time out or something was read 
read_socket: 
while (($endtime > time) && ($nfound <= 0)) {
# Read 1024 bytes at a time
    $length = 1024;
# Preallocate buffer
    $localbuf = " " x 1025;
	# NT does not support select for polling to see if 
	# There are characters to be received.  This is important
	# Because we dont want to block if there is nothing
	# being received.
    $nfound = 1;
    if ($http_os ne "NT") {
# The following polls to see if there is anything in the input
# buffer to read.  If there is, we will later call the sysread routine
	$nfound = select($rout=$rin, undef, undef,.2);
	    }
}
	
# If we found something in the read socket, we should
# get it using sysread.
    if ($nfound > 0) {
	$length = sysread($handle, $localbuf, 1024);
	if ($length > 0) {
	    $buf .= $localbuf;
	    }
    }

# Return the contents of the buffer
$buf;
}

############################################################
#
# subroutine: web_error
#   Usage:
#     &web_error("File xxx could not be opened");
#
#   Parameters:
#     $error = Description of Web Error
#
#   Output:
#     None
# 
############################################################

sub web_error
{
local ($error) = @_;
$error = "Error Occured: $error";
print "$error<p>\n";

# Die exits the program prematurely and prints an error to
# stderr

die $error;

} # end of web_error

1;

