############################################################################
#
#   Copyright 1999-2000 Phone.com, Inc.  All rights reserved.
#
#   Subject to the terms and conditions of the SDK License Agreement, 
#   Phone.com, Inc. hereby grants you the right to use the UP.SDK 
#   software and its related documentation.
#
#   The Phone.com name and logo and the family of terms carrying the "UP."
#   prefix are trademarks of Phone.com, Inc. All other brands and product 
#   names may be trademarks of the respective companies with which they 
#   are associated.
#
############################################################################

######################################################################
#
# HTTPClient
#
# Provides functions to invoke HTTP client operations like GET and POST to a URL
#
#
# PUBLIC FUNCTIONS:
# HTTPConnect - Connects to the URL with ths specified method and args
# HTTPDisconnect -  Disconnects from the URL connected earlier with HTTPConnect
# HTTPConnectAndBuffer - Connects to a URL and copies the output to a buffer
# HTTPConnectAndMatch - Connects to a URL and returns the first match of the 
#                       specified reg expression
#
# PUBLIC VARIABLES:
# $AppUtils::maxRedirects	- Maximum number of HTTP redirects to follow
# 
######################################################################

use Socket;

package AppUtils;

######################################################################
# Configuration
######################################################################
# Debugging support can be turned on by defining the file handle
#
# Example:
#
#		open (LOG, ">>/tmp/myapp.log");
#		$AppUtils::LOG = \*LOG;
#
$LOG = "";

######################################################################
# Constants
######################################################################
#
# Maximum number of redirects
#
$maxRedirects = 5;


######################################################################
# Subroutines
######################################################################
######################################################################
#
# METHOD:
# HTTPConnect
#
# INDEX: (lists the categories this function is indexed under in the docs)
# URLs:connecting to;POST method (HTTP);GET method (HTTP);
# 
# DESCRIPTION:
# HTTPConnect() connects a specified URL to a socket. It reads the HTTP status
# line but leaves the rest of the output.HTTPConnect() will handle up to five 
# redirects. If it doesn't load the specified URL after the fifth redirect, it
# fails, returning 0. You can optionally specify the request method (that is,
# GET or POST). If the method is POST, the last parameter is the content to 
# send to the server. If you do not specify a method, GET is assumed.
#
# ARGUMENTS:
# $fh		A file(socket) handle to create
# $url		The URL to use in the form http://[host[:port]]/[path]
# $method	The request method (optional)
# $postArgs	Args for the POST method (optional)
#
# RETURNS:
# 0			Failure
# 1			Success
#
# EXAMPLES:
# &HTTPConnect(\*HTTP_SOCKET,"http://www.netscape.com");
# &HTTPConnect(\*HTTP_SOCKET,"http://www.netscape.com","POST",$args);
#
######################################################################
sub HTTPConnect
{
    my($fh, $url, $method, $postArgs, $httpStatusRef) = @_;
    my($service, $host, $page, $port);
	my($newURL,$httpStatus);
	my($redirects) = 0;
    my($result) = 0;

    # default $method to GET
    $method = "GET" unless $method;

    ($service, $host, $page, $port) = &URLParse($url);

    if ($service ne "http") {
		printf($LOG "Error: not an http service [%s]\n", $protocol)
			if ($LOG ne "");
		return 0;
    }

	while ($redirects < $maxRedirects) {

		print $LOG "Connecting to [$host$page]..." if ($LOG ne "");

		if ($port) {
			$result = &URLConnect($fh, $port, $host);
		}
		else {
			$result = &URLConnect($fh, $service, $host);
		}

		if ($result) {

			print $LOG "connected\n" if ($LOG ne "");

			# Send the request
			&HTTPSendRequest($fh, $page, $method, $postArgs);

			# Get the status line
			$httpStatus = <$fh>;

			print $LOG "$httpStatus" if ($LOG ne "");

			$redirects++;
			if ($redirects < $maxRedirects) {
				last;
			}

			if (($httpStatus =~ m/HTTP\/1\.0\s+302/) ||
				($httpStatus =~ m/HTTP\/1\.0\s+301/)) {

				# We get here if this page has been moved.
				# We look for the new address and try to load it
				while (<$fh>) {
					($newURL) = /[Ll]ocation:\s*([^\r\n]+)/;
					last if $newURL;
				}

				# Disconnect from the old URL
				&HTTPDisconnect($fh);

				print $LOG "Redirecting [$host$page] to\n" if ($LOG ne "");

				# Connect to the new one
				($service, $host, $page) = &URLParse($newURL);

				print $LOG " [$host$page]\n" if ($LOG ne "");

				$redirects++;
			} else {
				# Success
				last;
			}
		} else {
			print($LOG "failed\n") if ($LOG ne "");

			# Failure
			last;
		}
	}

	if (ref($httpStatusRef)) {
		$$httpStatusRef = $httpStatus;
	}
    $result;
}

######################################################################
#
# METHOD:
# HTTPDisconnect
#
# INDEX: (lists the categories this function is indexed under in the docs)
# URLs:disconnecting from
# 
# DESCRIPTION:
# Disconnects the current URL from the specified socket.
#
# ARGUMENTS:
# $fh		A file(socket) handle to disconnect
#
######################################################################
sub HTTPDisconnect
{
	my($fh) = @_;
    close($fh);
}

######################################################################
#
# METHOD:
# HTTPConnectAndBuffer
#
# INDEX: (lists the categories this function is indexed under in the docs)
# URLs:connecting to;POST method (HTTP);GET method (HTTP);
# 
# DESCRIPTION:
# Retrieves the content of a URL and stores it to a specified buffer. 
# HTTPConnectAndBuffer() will handle up to five redirects. If it doesn't load 
# the specified URL after the fifth redirect, it fails, returning 0. 
# HTTPConnectAndBuffer() treats the specified buffer as a scalar array. It 
# stores each line of the retrieved content to a separate array member. 
# You can optionally specify the method of the request (GET or POST). If the method
# is POST, the last parameter is the content to send to the server.
# If you do not specify a method, GET is assumed.
#
# ARGUMENTS:
# $url		The URL to use, in the form http://[host[:port]]/[path].
# $pageRef	Reference to an array to store the response (with headers).
# $pageRef	The request method (optional).
# $postArgs	Arguments for the POST method.
#
# RETURNS:
# 0			Failure
# 1			Success
#
# EXAMPLES:
# &HTTPConnectAndBuffer("http://www.netscape.com", \@data);
# &HTTPConnectAndBuffer("http://www.netscape.com", \@data, "POST", $args);
#
######################################################################
sub HTTPConnectAndBuffer
{
	my($url, $pageData, $method, $postArgs) = @_;
	my($result);
	my($httpStatus);

	$result = &HTTPConnect(\*HTTP_SOCK, $url, $method, $postArgs,\$httpStatus);

	if ($result) {
		# Buffer the data
		@$pageData = <HTTP_SOCK>;
		unshift (@$pageData, $httpStatus);
		&HTTPDisconnect(HTTP_SOCK);
	}

	$result;
}

######################################################################
#
# METHOD:
# HTTPConnectAndMatch
#
# INDEX: (lists the categories this function is indexed under in the docs)
# URLs:connecting to;POST method (HTTP);GET method (HTTP);matching regular 
# expressions in URLs
# 
# DESCRIPTION:
# Connects an HTTP URL, reads in the page and returns the
# first match of the specified regular expression.
# Takes a URL and a regular expression.
# You can optionally specify the request method (GET or POST). If the method
# is POST, the last parameter is the content to send to the server.
# If you do not specify a method, GET is assumed.
# The regular expression should contain at least one parenthesized
# expression. Do not include the / delimiters in the regular expression.
#
# ARGUMENTS:
# $url		The URL to use, in the form http://[host[:port]]/[path]
# $regExp	The regular expression (without the / delimiters) to match against.
# $method	The request method.
# $postArgs	Arguments for the POST method.
#
# RETURNS:
# An array that contains the matching values.
# The array will be undefined if there is an error or no match.
#
# EXAMPLES:
# To return the value associated with the ACTION
# keyword, we could pass in the following expression:
#			.*ACTION=\"(.*)\".*
#
######################################################################
sub HTTPConnectAndMatch
{
    my($url, $re, $method, $postArgs) = @_;
    my(@result);
	my($status);

	$status = &HTTPConnect(\*HTTP_SOCK, $url, $method, $postArgs);

	if ($status) {
		# Try to match the given regular expression
		while (<HTTP_SOCK>) {
			if (m/$re/) {
				@result = /$re/;
				last;
			}
		}
		&HTTPDisconnect(HTTP_SOCK);
	}

	@result;
}

######################################################################
#
# Method:
# URLParse
#
# DESCRIPTION:
# Parse a URL into its protocol, port, host and path.
#
# ARGUMENTS:
# $url		URL of the form [service]://[host[:port]][path]
#
# RETURNS:
# (service, host, path, port)
# service	The service protocol
# host		The host name
# path		The path
# port		The port (will be empty if no port number is given)
#
######################################################################
sub URLParse
{
    my($url) = @_;
    my($service, $host, $path);
	my($port);

    ($service, $host, $path) = $url =~ /(\w+):\/\/([^\/]+)(.*)$/;

	# Look for a port number in the service
	if ($host =~ m/:\d+$/) {
		($host, $port) = $host =~ /^([^:]+):(\d+)$/;
	}

    if ($path eq "") {
		$path = "/";
    }

    ($service, $host, $path, $port);
}

######################################################################
#
# Method:
# URLConnect
#
# INDEX: (lists the categories this function is indexed under in the docs)
# files:opening;files:locking;locking files
# 
# DESCRIPTION:
# Connect URL to socket.
#
# ARGUMENTS:
# $fh		The file descriptor to open
# $service	The service name or port number
# $hostname	The host name of the server
#
# RETURNS:
# 0			Failure
# 1			Success
#
######################################################################
sub URLConnect
{
    my($fh, $service, $serverName) = @_;
    my($AF_INET, $sockAddr, $SOCK_STREAM);
    my($name, $aliases, $protocol, $port, $len);
    my($serverAddr, $serverPackedAddr);
    my($result) = 1;

	if ($LOG ne "") {
		printf($LOG "Connecting to //%s:%s\n", $serverName, $service)
	}

    # It may be a port number and not a service name
    $port = $service;

	# Use port 80 for http
	$port = 80 if ($service eq 'http');

    # Get our protocol
    ($name, $aliases, $protocol) = getprotobyname('tcp');

    # Get the port number if it was not passed in
    ($name, $aliases, $port, $protocol) = getservbyname($service, 'tcp')
		unless $port =~ /^\d+$/;

    # Get the host info for the server
    ($name, $aliases, $type, $len, $serverAddr) = gethostbyname($serverName);

    # Some magic values that get packed into the addresses
	#
	# If we are using perl5, then use the constants defined
	# by the Socket package. Otherwise, use some hardcoded
	# number.
	if ($] =~ /5\./) {
		# Wrap these in an eval since perl 4 cannot handle the syntax
		eval('$AF_INET = Socket::AF_INET;');
		eval('$SOCK_STREAM = Socket::SOCK_STREAM;');
	}
	else {
		$AF_INET = 2;
		$SOCK_STREAM = 2;
	}
    $sockAddr = 'S n a4 x8';

    # Pack the server address
    $serverPackedAddr = pack($sockAddr, $AF_INET, $port, $serverAddr);

    # Now, create a socket
    $result = socket($fh,  $AF_INET, $SOCK_STREAM, $protocol);

    # connect to the server
    $result = connect($fh, $serverPackedAddr) unless !$result;
 
    # unbuffer the socket
    select((select($fh), $| = 1)[0]);

    # Return the result
    $result;
}

######################################################################
#
# Method:
# HTTPSendRequest
#
# INDEX: (lists the categories this function is indexed under in the docs)
# files:opening;files:locking;locking files
# 
# DESCRIPTION:
# Send an HTTP request to the given socket
#
# ARGUMENTS:
# $fh		A file(socket) handle to create
# $page		The page to download
# $method	The request method
# $postArgs	Args for the POST method (optional)
#
# RETURNS:
# 0			Failure
# 1			Success
#
######################################################################
sub HTTPSendRequest
{
    my($fh, $page, $method, $postArgs) = @_;

    # Send the request
    print $fh "$method $page HTTP/1.0\r\n";

    # Specify our browser
    print $fh "User-Agent: UP.Link/2.0 (based application)\n";
    print $fh "Accept: */*\n";

    if ($method eq "POST") {
		print $fh "Content-type: application/x-www-form-urlencoded\n";
		print $fh "Content-length: ", length($postArgs), "\n";
		print $fh "\r\n";
		print $fh "$postArgs";
    }

    # Terminate the request
    print $fh "\r\n\r\n";
}

1;
