#!/usr/local/bin/perl -w
#
#   This is a script to publish a file on a remote web site via HTTP
#
# This script is a client part of a HTTP copy facility, with Update-w-Taker.pl
# CGI script being a server part.
# See http://zowie.metnet.navy.mil/~spawar/JMV-TNG/Publishing.html
# for more details. The client-server system this script is a part of
# is rather similar to FrontPage's server extensions.
# 
# Synopsis:
# 	uptow dest-directory local-filename 
# 
# This script will copy the file specified by the 'local-filename' to a
# remote site. It will be placed into a given 'dest-directory'
# on the remote site under the same (base) name. The remote site will
# typically prepend a pre-defined path to this 'dest-directory'
# (e.g., /usr/local/htdocs or /w/data) to confine file updates
# to that part of its filesystem.
# 
# Unlike DPSR/DCS, this script publishes synchronously, and always
# tells the result of the transfer.

# This script is a specialized version of w-shove. See the URL above for more
# details. Specifically, this script establishes a connection to a
# destination HTTP server specified in the $TAKER_URI (either directly or
# via a proxy) and submits a PUT request.
# For example, if uptow is called as
#   	uptow mysite/dev /tmp/data.txt 
# the script sends a request like the following:
# 
#	PUT http://hostname.org:80/cgi-bin/taker/mysite/dev/
#	Host: hostname.org:80
#	User-Agent: UPTOW/1.3
#	Authorization: Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==
#	Content-Type: text/plain; filename="data.txt"
#	Content-Length: size-of(/tmp/data.txt)
#	newline
#	contents of the file /tmp/data.txt as it is.
#
#	The server normally acknowledges creation/modification of the
# PUT resource by replying "201 Created".
#
# Note on the Content-type. Because of a bug with certain proxy servers
# (notably Raptor 5.0), the upload connection is not 8-bit clean. This script
# tries to check if the file being uploaded is ASCII or binary. If former
# is the case, no encoding is used, and the media type in the Content-Type:
# header is set to "text/plain". Otherwise, the file is trivially
# encoded (by representing each byte by two ASCII characters: hexadecimal
# representation). The Content-Type is set to application/x-octet-stream-b2a
# in this case. Although a Transfer-Encoding: is a far better place to
# specify the encoding, this doesn't work with the Apache server. See
# comments in Update-w-Taker.pl for more details.
# 
# See http://zowie.metnet.navy.mil/~spawar/JMV-TNG/Met-Cast-HTTP.html for
# much more detailed discussion of HTTP file/transport within Metcast
# and references to relevant parts of the HTTP standard.
# 
# $Id: uptow.pl,v 2.0 1999/11/02 20:58:49 oleg Exp oleg $

	# Configuration parameters
$PROXY_NAME ="";	# if empty, no proxy is used
$PROXY_PORT = 80;
$REMOTE_HOST = "localhost";
$AUTH_CREDENTIAL = "Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ=="; # if empty, it is not used
$REMOTE_PORT = 80;
$TAKER_URI = "/cgi-bin/admin/Update-w-Taker.pl";
$USER_AGENT = "UPTOW/1.3";
$CRLF="\r\n";
#$TAKER_URI="/cgi-bin/oleg/test-cgi-my";
use integer;
use Socket;

my $buffer; 		# i/o (socket) buffer...
my $transfer_chunk = 1024;

	# Main module
@ARGV == 2 or &help("Two arguments are expected");
my $dest_dir = $ARGV[0];
my $file_name = $ARGV[1];
$file_name =~ m!([^\\/]+)$! or die "Invalid filename $file_name";
my $base_name = $1;

	# Check the file to publish...
stat($file_name);
-r _ || die "The file to publish -- $file_name -- does not exist, or unreadable";
my $file_size = -s _;
open(FILE_CONTENT,$file_name) || die "Failed to open $file_name: $!";
binmode FILE_CONTENT;
my $encoding = $ENV{windir} || -B FILE_CONTENT; # On WinNT, -B is not implemented
$encoding && print STDERR "File $file_name appears to be binary and will be encoded\n";

print STDERR "Sending $file_name of $file_size bytes...\n";
my $resource_to_put = "$TAKER_URI/$dest_dir/";
$resource_to_put =~ s![/\\]+!/!g; 	# replace double-slashes-backslashes
					# with a single slash

	# Establish the connection with a server
$|=1;		# Set autoflush on...
my $host_to_connect = $PROXY_NAME || $REMOTE_HOST;
my $iaddr_to_connect = inet_aton $host_to_connect;
$iaddr_to_connect || 
	die "Can't resolve the remote host or proxy name $host_to_connect: $!";
my $port_to_connect = $PROXY_NAME ? $PROXY_PORT : $REMOTE_PORT;
print STDERR "Connecting to $host_to_connect:$port_to_connect...\n";
socket(SOCK, PF_INET, SOCK_STREAM, getprotobyname('tcp')) || die "socket: $!";
connect(SOCK, sockaddr_in($port_to_connect, $iaddr_to_connect)) ||
	die "Failed to connect: $!";
binmode SOCK;
print STDERR "Connection established!\n";

	# Making the request (first in $buffer)
$buffer = "PUT " .
	( $PROXY_NAME ? "http://$REMOTE_HOST:$REMOTE_PORT" : "" ) .
	$resource_to_put . " HTTP/1.0" . $CRLF;
$buffer .= "Host: $REMOTE_HOST:$REMOTE_PORT" . $CRLF;
$buffer .= "User-Agent: $USER_AGENT" . $CRLF;
$AUTH_CREDENTIAL and $buffer .= "Authorization: $AUTH_CREDENTIAL" . $CRLF;
$buffer .= "Content-type: " . 
	( $encoding ? "application/x-octet-stream-b2a" : "text/plain" ) .
	'; filename="' . $base_name . '"' . $CRLF;
$buffer .= "Content-Length: " .
	( $encoding ? $file_size + $file_size : $file_size ) . $CRLF;
$buffer .= $CRLF;	# End-of-headers

syswrite SOCK,$buffer,length($buffer) || 
	die "Request sending error: $!";

my $to_read = $file_size; my $res;
if( $encoding )
{
  while ( $to_read > 0 &&
    	  ($res = read FILE_CONTENT,$buffer,
		($transfer_chunk < $to_read ? $transfer_chunk : $to_read))) {
	syswrite SOCK,unpack("H*",$buffer),$res+$res
		||  die "socket write error $!";
	$to_read -= $res;
      }
} else {
  while ( $to_read > 0 &&
    	  ($res = read FILE_CONTENT,$buffer,
		($transfer_chunk < $to_read ? $transfer_chunk : $to_read))) {
	syswrite SOCK,$buffer,$res
		||  die "socket write error $!";
	$to_read -= $res;
      }
}
$to_read == 0 || die "Failed to read the input file completely: $!";
close FILE_CONTENT;
print STDERR "Request sent\n";


# Read the status line -- the first line of the response...
sysread SOCK,$buffer,$transfer_chunk || die "Error reading the status line: $!";
$buffer =~ m!^HTTP/1.\d+\s+(\d+)\s+(.+)! 
	|| die "Invalid status line: $buffer";
my $response_code = $1;
print STDERR "Status: $response_code $2\n";

# Read the rest of the response and dump it...
print $';
while( ($res = sysread SOCK,$buffer,$transfer_chunk) > 0 )
{
  print $buffer
}
close SOCK;

if( $response_code == 304 )
{
  print STDERR "Not Modified\n";
  exit 1;
}

if( $response_code >= 300 )
{
  print STDERR "Error\n";
  exit 4;
}

print STDERR "Success\n";
exit 0;



# Print help as how to use the program. Print $1 as the title
sub help {
  $_ = shift;
  print STDERR "\n$_\n";

  open(THIS_SCRIPT,"$0") || 
  	die "Can't open this script to print out help, due to $!";
  while( <THIS_SCRIPT> ) {
    /^\#!/ && next;
    /^\#/ || last;
    print STDERR $'
  }
  close THIS_SCRIPT;
  exit 4
}