#! /usr/local/bin/perl -w
#   ATELstream client v0.11 March 24 2011
#          -- Added an "EOF" to "send()", to fix bug (tcp does not receive end of stream notices). 
#          -- Added process forking for redistribution to daughters, to speed up redistribution
#   ATELstream client v0.1  Beta Test Period.  March 21 2011. 
#
########################################################################
########################################################################
#  This is an example program to perform the two main client-initiated 
#  functions with ATelStream: (1) Submit an object for broadcast; (2) 
#  Request the full contents of the existing stream.  (3) Request a specific 
#  object from the streaam by its referent. 

use IO::Socket;
use Socket; 
use Digest::MD5 qw(md5_hex); 
use XML::Parser; 
use Time::HiRes qw(gettimeofday); 
use XML::Twig; 

# Flush after every write
$|=1; 


$ENDTCP = "\nEOF\n";  # needed to end every TCP send transmission. 

$user = 'test@test.com'; # subtitute test@test.com with an Approved ATEL credential email address
$pass = "test"; # substitute test password with an Approved ATel credential password 

$xmlfile = "test.xml"; 
$default_atel_server_port = 33331; # this is the port at which the ATelStream server is found. 
$default_atel_server_name = "astronomerstelegram.org";  # This is the ip where the ATelStream server is found. 

my $addr = inet_ntoa(inet_aton($default_atel_server_name)); 

$socket = new IO::Socket::INET (
				PeerAddr  => $addr,
				PeerPort  => $default_atel_server_port,
				Proto => 'tcp',
                               )                
or die "Couldn't connect to Server $addr\n";
$socket->autoflush(1); 

print "Connected to $addr\n"; 
$recv_data = my_recv($socket,1024); 
print "A: $recv_data\n"; 

####
#### First, the client must authenticate, to tell the server that it can be trusted
#### to submit an XML object. 
####

$socket->send("USER $user");  # $user is set the the contants.inc file
$recv_data = my_recv($socket,1024); 
print "B: $recv_data\n"; 

$socket->send("PASS $pass");  # $pass is set in the constants.inc file
$recv_data = my_recv($socket,1024); 
print "C: $recv_data\n"; 

#### Authentication complete. 

####
####
#### Send XML object.  The XML must be "well-formed" to be processed by ATELstream.  
#### XML objects which are not well-formed would corrupt the stream, and are therefore rejected by the main node,
#### with an error message. 
#### It is the author's (your) responsibility to *also* insure that the submitted XML object is "valid", 
#### that it conforms to an indicated DTD.  Failure to do so will render your object functionally useless. 
####
####


#### Here, we define an ASCII XML object, which is well-formed
####
my $xml_object = GetXMLObject($xmlfile); 
####
####

####
####  Here, we send the well-formed ASCII XML object to the server, and accept the server's response
####
$socket->send($xml_object . $ENDTCP); 
$recv_data = my_recv($socket,1024); 
print "D: $recv_data\n";          # if XML is invalid, returns an error and closes.  Else should receive a checksum. 
####
####



if ($recv_data =~ m/CHECKSUM\s+(\S+)/){
    $returned_checksum=$1; 
    my $forhash_obj = parse XML::Twig::Elt($xml_object); 
    $forhash_obj->set_pretty_print('none'); 
    my $checksum=MakeHash($forhash_obj); 
    if ($returned_checksum eq $checksum){
	print "(local): OK checksum: $checksum\n"; 
	my $send_data="OK"; 
	$socket->send($send_data); 
    } else {
	print "(local):  BAD checksum: $checksum\n"; 
	$socket->send("BAD"); 
    }
    $recv_data = my_recv($socket,1024); 
    print "E: $recv_data\n"; 
} else {
    print "E: $recv_data\n\n"; 
}
# Finally, close. 

close $socket; 

########################################################################
########################################################################
########################################################################
#############END OF INTERACTION WITH MAIN NODE #########################
########################################################################
########################################################################
########################################################################


sub GetXMLObject { 
    #### This subroutine returns an ascii XML object which is to be submitted to the server. 
    #### The version here first parses a file containing the XML object, to ensure that the XML
    #### object is "well-formed".  The Main-node will reject a submitted XML object if it is not "well-formed". 
    #### If the XML object is not well-formed, this script exits the program. 
    #### 

    ####  Clients may, of course, employ any other methods they like to obtain the XML object
    ####  they intend to submit to the main node. However, it is highly recommended that 
    ####  clients insure the XML object is "well-formed" prior to submitting to the main node. 
    ####  Also, submitted XML objects must be *unique*.  The server will reject XML objects which 
    ####  have previously been submitted to the server for distribution.  An XML object is considered
    ####  unique by the server if its md5_hex hash is unlike any other previously submitted to the server. 
    ####  Thus, if clients are testing the server and distribution, you are advised to slightly change the content
    ####  of the XML object each time.  Below, for example, we splice in the time of day in seconds and microseconds, 
    ####  which insures that each object submitted will be unique.  
    
    my $xmlfile = $_[0]; 
    
    my $xml_parser = XML::Parser->new(ErrorContext => 2); 
    eval { $xml_parser->parsefile( $xmlfile ); };

# report any error that stopped parsing, or announce success
    if( $@ ) {
	$@ =~ s/at \/.*?$//s;               # remove module line number
	print STDERR "\nERROR in '$xmlfile':\n$@\n";
	exit(0); 
    } 
    
    local $/=undef; 
    open XML, $xmlfile or die "Failed to open $xmlfile"; 
    binmode XML; 
    my $xml_object = <XML>; 
    close(XML); 
    
    my ($seconds, $microseconds) = gettimeofday; 
    $xml_object =~ s/(Client)/$1 $seconds $microseconds  /; 
    $xml_object =~ s/(NGC0931)/$1 $seconds $microseconds  /; 
    
    return($xml_object); 
}

sub my_recv {
    my ($socket, $bytelimit) = @_; 
    my $line=''; 
    my $r_data=''; 


    while (length($r_data)<$bytelimit && defined ($line = <$socket>)){
	if ($line =~ /^EOF\s*$/g){
	    last; 
	}
	$r_data .= $line; 
    }
    return($r_data); 
}


sub MakeHash {
    my $obj = $_[0]; 
    $obj->set_pretty_print('none'); 
    my $printobj = $obj->sprint; 
    $printobj =~ s/\s+//g;  #remove all the spaces
    $printobj =~ s/\n//g;  #remove all the newlines
#    print STDERR $printobj; 
    my $hash = md5_hex($printobj); 
    return($hash); 
}
1; 
