#! /usr/local/bin/perl -w 
#  server3.pl -- Beta Test Version (March 2011). 
#
#
#
#
# On startup this server contacts astronomerstelegram.org and obtains a token. 
# 
# This server then waits until it gets a connection; 
# When it gets the connection, it listens for its token, which insures the connection is with an authorized server. 
# On receiving a token, it will perform one of two functions: 
#  (1) Update its token (only from astronomerstelegram.org); 
#  (2) Receive and re-distribute an ATel stream by: 
#          (a) Accepting an XML object <ATELobject>
#          (b) Strips the ATELsendto object,  removes its info, repackages the ATELobject and 
#              sends it to the daughters. 
#          (c) Alerts the ATel server it has accepted an object. 
#
#
#

use IO::Socket;
use Socket; 
use XML::Parser; 
use XML::Twig; 
use Sys::Hostname; 
use Digest::MD5 qw(md5_hex); 

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

my $my_listening_port=33330;  # this is the port your server will listen to for ATelstream.  You might need to change it. 
my $host = hostname(); 
my $my_host_addr = inet_ntoa(scalar gethostbyname ($host || '$localhost'));

my $BYTE_LIMIT=100000; 
my $small_byte = 1024; 
my $default_atel_server_port = 33331; # this is the port at which 
my $default_atel_server_name = "astronomerstelegram.org";
my $default_atel_addr = inet_ntoa(inet_aton($default_atel_server_name)); 

############ Now Listen ##########

$socket = OpenSocketToATelStream($my_host_addr, $my_listening_port); 

#
#
#

print "Peer address $default_atel_addr\n"; 


## First, check in the main node at astronomerstelegram.org

$out_socket = ConnectToMainNode(); 

# Tell ATelStream what port you're listening with. 
$out_socket->send("PORT $my_listening_port". $ENDTCP);  
$recv_data = my_recv($out_socket, $small_byte); 
print STDERR "A: $recv_data\n"; 

####
####
####  The token is a shared secret between you (the server) and the main node.  When your 
####  server is presented with the token, you are then assured that the communication which follows
####  originated from the main node.  During normal server operations, your server may be
####  contacted peer-to-peer, by another server in the network, in which case they will present you
####  with this token.  Also, from time to time, the main node will change your token, (by first presenting
####  your old token, and then presenting you with a new one.  Where this happens below, you (the server)
####  first insure that the update comes from the main node, so that your server isn't hijaked. 
####
####  It is perfectly acceptable for you to kill this server at any time. The main node will determine
####  that the server is diconnected, when a series of attempted token updates fails sequentially. 
####  Furthermore, you may restart the server at any time, and your connection should resume without a hitch.
####
####
####

my $token=''; 


if ($recv_data =~ m/TOKEN\s+(\S+)/g){
    $token = $1; 
    print STDERR "TOKEN $token received from main node $default_atel_addr:$default_atel_server_port.\n"; 
    $out_socket->send("ACK" . $ENDTCP);  # This acknowledges receipt of a newtoken. 
    close $out_socket; 
} else {
    print STDERR "(local) Failed to obtain initializing TOKEN from main node. Exiting."; 
    exit(0); 
}


while (1) {
    print STDERR "Listening...."; 
    my $r_data=''; 
    $client_socket = "";
    $client_socket = $socket->accept();
    
    $peer_address = $client_socket->peerhost();
    $peer_port = $client_socket->peerport();
    
    print STDERR "\n Connection from ( $peer_address , $peer_port ). ";
    
    $client_socket->send("HELO. Submit TOKEN Please." . $ENDTCP); 

    $r_data = my_recv($client_socket,$small_byte);  # first receipt should be the token
	
    my $subtoken=''; 
    if ($r_data =~ m/TOKEN\s+(\S+)/g){
	$subtoken = $1; 
    }
    
    unless ($subtoken eq $token)  # Client must present the correct token, else, exit. 
    {
	print STDERR "\n Closing socket $peer_address:$peer_port as token presented \"$subtoken\" is not TOKEN $token\n"; 
	close $client_socket;
	next;
    }
    
    $client_socket->send("TOKEN accepted. Continue.". $ENDTCP);  # Ack the token. 
    $r_data = my_recv($client_socket, $BYTE_LIMIT);  # After the token has been accepted, we can interact with remote client

    # There are only TWO functions of this server at this point. 
    #     (1) receive a new TOKEN from the main node. 
    #     (2) receive an XML object, and redistribute it. 
    
    if ($r_data =~ m/TOKEN\s+(\S+)/g && ($peer_address eq $default_atel_addr)) { 
	####
	####  Someone is attempting to update the token.  Make sure that "someone" is the
	####  main node, and not some other node attempting to hijak the server. 
	####
	$client_socket->send("ACK" . $ENDTCP);  # Ack the new token. End of interaction. 
	close $client_socket; 
	
	####  This is a new token sent from the ATel main node.  This token must be presented
	####  by any connecting client, to use server resources.  This helps avoid your server
	####  distributing non-authenticated content. 

	my $new_token=$1; 
	print STDERR "New token $new_token at " . localtime() . "\n"; 
	$token=$new_token;

	next; 
    } else { # 
	close $client_socket; 
		
        #### Users are required to permit redistribution of the object and acknowledgement to the main node
	#### Failure of the ATELsendto daughters to Ack receipt themselves
	#### is interpeted by the main node to mean this server is not performing its functions, and 
	#### the server may either be deprecated in the network, or removed entirely.  Also, failure of
	#### this server to acknowledge receipt means the main node will attempt to re-send this
	#### xmlobject to this server after a delay, to ensure its receipt.  
	
	####
	####  Prior to redistributing this object to the daughters of the top ATELsendto element, 
	####  this server confirms the hash in the ATELpublished element is the md5_hex hash of the
	####  distributed object, to insure data integrity.  Then, the server acknowledges receipt of
	####  the object to the main node, by passing back this hash to the main node, which will respond
	####  with a confirmation that the distributed object is authentic, and has not (for example) been
	####  subsituted by a server between the main node and this one. 
	####
	
	
	my $newxmlobject = $r_data; 
	my $xml_elt = parse XML::Twig::Elt($newxmlobject); 
	
	####
	#### Here, confirm the hash corresponds to the distributed XML object. 
	####

	my $fpelt = $xml_elt->first_child('ATELpublished'); 
	my $hash = $fpelt->first_child_text('hash'); 
	my $last_elt = $xml_elt->last_child; 
	my $object_hash = MakeHash($last_elt); 

	unless ($hash eq $object_hash){
	    print STDERR "Received Object (below) does not match the received hash.  Object may have been " . 
		"corrupted in transit.\nReceived Hash: $hash vs. hash of received object: $object_hash"; 
	    PrintObjectToScreen($xml_elt); 
	    next; 
	}
	
	####
	#### Next, acknowledge receipt of this object to the main node, which will respond with 
	#### confirmation that the received object is authentic, and has not (for example) been
	#### substituted by an intervening server between this one and the main node. 
	#####

	print STDERR "\nRECEIPTING: $hash $my_host_addr $my_listening_port $token\n"; 
	
	unless (AckReceipt($hash, $my_host_addr, $my_listening_port, $token)) { #Acknowledge receipt to the main node. 
	    ####  This server attempted to send a receipt to the main node, and it failed. 
	    ####  When that occurs, this server should not proceed to redistribute the XML object 
	    ####  the daughters of its ATELsendto object, because this server cannot confirm that the
	    ####  XML object of which it is in posession is a valid one -- that it has not been hijacked
	    ####  by another server performing a "man in the middle" attack, for example. 

	    print STDERR "\nRECEIPTING failed. XML object cannot be confirmed as valid with main node\n"; 
	    next; 
	}

	####
	####   Send this newly received XMLobject to daughters of this server's ATELsendto object
	####  

	SendToDaughters ($xml_elt);   
	
	####
	#### At this point,  all community functions have been done and the server can output the 
	#### XML object for local use.  
	####
	####
	#### Here, users may perform whatever function they like on the received XML object.  
	#### For example, we kick the full received object to a subroutine to be printed to STDERR.
	####
	
	PrintObjectToScreen($xml_elt); 	    

    }
}


######################################################################################################

sub SendToDaughters { #strip Top ATELsendto and send reformatted xmlobject to ATELsendto daughters
    my $object = $_[0]; 
    my $root = $object->root; 
    my $top_atelsendto = $root->first_child('ATELsendto');  # This is the top ATELsendto
    my @ddaughters = $top_atelsendto->children( 'ATELsendto' ); 
    my @childpids =(); 
    foreach $ddaughter (@ddaughters) {
	my $pid=fork();   # fork the process
	if ($pid){
	    # parent
	    push(@childpids, $pid); 
	} elsif ($pid==0){
	    # child
	    # insert daughter ATELsendtoobject
	    my $new_xmlobj = $object; 
	    my $old_atelsendto_elt = $new_xmlobj->first_child( 'ATELsendto' ); 
	    $ddaughter->replace($old_atelsendto_elt); 
	    DistributeBySocket($new_xmlobj); 
	    exit(0);
	} else {
	    die "couldn't fork $!\n"; 
	}
    }

    foreach (@childpids){
	waitpid($_, 0); 
    }

    
}

sub DistributeBySocket {
    my $object = $_[0]; 
    my ($ip, $port, $token) = GrabATELsendInfo($object); 
    print STDERR "\nDistributing to $ip:$port with token $token\n"; 
    my $socket = OpenSocket($ip ,$port); 
    unless ($socket){
	print STDERR "Couldn't connect to Server $ip:$port. Distributing to next-generation daughters.\n";
	SendToDaughters($object); 
	return; 
    }
    
    my $recv_data= my_recv($socket, 1024); # initiating receive ("HELO" received).  
    $socket->send("TOKEN $token". $ENDTCP);  # submit token
    $recv_data = my_recv($socket, 1024); # obtain ACK for the token
    $socket->send($object->sprint . $ENDTCP); # $send the XML object
    close $socket;  # that's it; close up, you're done. 

}


sub GrabATELsendInfo { 
    my $object = $_[0];  #This object should be an XML:::Twig::Elt element
    my  $atelsendto = $object->first_child( 'ATELsendto' ); 
    my $ip = $atelsendto->{'att'}->{'ip'}; 
    my $port =  $atelsendto->{'att'}->{'port'}; 
    my $token = $atelsendto->{'att'}->{'token'}; 
    return ($ip, $port, $token); 
}

sub AckReceipt { 
    my ($hash, $ip, $port, $token) = @_; 
    
    my $out_socket = ConnectToMainNode(); 
    $out_socket->send("HASHACK $hash $ip $port $token" . $ENDTCP);  # This acknowledges receipt of a ATELobject
    my $recv_data = my_recv($out_socket, 1024); 
    print "\n$recv_data\n";     
    close $out_socket; 
    if ($recv_data =~ m/SUCCEDED/g){
	return(1); 
    }
    return(0); 

}


sub ConnectToMainNode { 

    my $lsocket = OpenSocket($default_atel_addr, $default_atel_server_port)
	or die "Couldn't connect to Server $default_atel_addr\n";
    
    print STDERR "Connected to $default_atel_addr\n"; 
    my $recv_data = my_recv($lsocket, $small_byte);  #receive the HELO
    print STDERR "A: $recv_data\n"; 
    return ($lsocket); 
}

sub OpenSocketToATelStream {

    my $lsocket; 
    my $trys=0; 
    do { 
	$lsocket = new IO::Socket::INET (
					 LocalHost => $my_host_addr, 
					 LocalPort => $my_listening_port,
					 Proto => 'tcp',
					 Listen => 5,
					 Reuse => 1
					 );
	
	unless ($lsocket){
	    print STDERR "Couldn't open socket at port $my_listening_port.."; 
	    $my_listening_port++;  # try another port
	    print STDERR "trying $my_listening_port..\n"; 
	    $trys++; 
	}
    } while (!$lsocket && $trys<10); 
    die "Failed to open listening socket" unless ($lsocket); 
    
    print STDERR "\nTCPServer Waiting for client to connect on port $my_listening_port\n";
    
    return ($lsocket); 
}

sub PrintObjectToScreen {
    my $obj = $_[0]; 
    $obj->set_pretty_print('indented'); 
    print STDERR "\n" . $obj->sprint . "\n"; 
}

sub OpenSocket {
    my ($addr, $port) = @_; 
    print STDERR "\nAttempting to open $addr $port\n"; 
    my $out_socket = new IO::Socket::INET (
					   PeerAddr  => $addr,
					   PeerPort  => $port, 
					   Timeout => "3", 
					   Proto => 'tcp',
					   )           
	or print STDERR "Failed to open socket $addr:$port\n"; 
    
    return($out_socket); 
}


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;

