#! /usr/bin/perl
#**********************************************************************
#* (C) Copyright IBM Corporation 1997, 2011.  All rights reserved.    *
#*                                                                    *
#* Name: rxd                                                          *
#>                                                                    *
#* Function: This program executes commands issued from a remote      *
#*  client.  The basic function is to open a socket and listen for    *
#*  any of the following commands:                                    *
#*                                                                    *
#<    CHDIR() changes the current directory to the directory in which *
#*     this program was started.                                      *
#*                                                                    *
#*    CHDIR(Directory) changes the current directory to the new       *
#*     directory.                                                     *
#*                                                                    *
#*    CMD(Command) executes Command under a new invocation of the     *
#*     shell or command interpreter and does not wait for completion. *
#*                                                                    *
#*    CMDF(Filespec Command) executes Command under a new invocation  *
#*     of the shell or command interpreter and writes the output to   *
#*     a file.                                                        *
#*                                                                    *
#*    COPY(SourceFile TargetFile) copies the source file on the       *
#*     remote system to the target file on the remote system.         *
#*                                                                    *
#*    DEL(Filespec) deletes the specified file(s).                    *
#*                                                                    *
#*    DIR() returns a list of files/directories in the current        *
#*     directory.                                                     *
#*                                                                    *
#*    DIR(Filespec) returns a list of files/directories matching the  *
#*     specified filespec.                                            *
#*                                                                    *
#*    ENV(Variable) returns the value of the requested environment    *
#*     variable.                                                      *
#*                                                                    *
#*    EXEC(Command) executes Command inline and returns the results.  *
#*                                                                    *
#*    FG(Command) executes Command inline in foreground and returns   *
#*     the command return code.                                       *
#*                                                                    *
#*    FGY(Command) executes Command inline in foreground with a 'y'   *
#*     piped to the command and returns the command return code.      *
#*                                                                    *
#*    GET(Filespec) copies the specified file in ASCII mode.          *
#*                                                                    *
#*    GETB(Filespec) copies the specified file in binary mode.        *
#*                                                                    *
#*    HALT() kill this daemon                                         *
#*                                                                    *
#*    HELP() returns the RXD help text.                               *
#*                                                                    *
#*    MSG(Text) displays the text on the remote system.               *
#*                                                                    *
#*    REN(Oldname Newname) renames the specified file.                *
#*                                                                    *
#*    PSWD(NewPassword) changes the command access password           *
#*                                                                    *
#*    PUT(Filespec) copies the specified file in ASCII mode.          *
#*                                                                    *
#*    PUTB(Filespec) copies the specified file in binary mode.        *
#*                                                                    *
#*    SKEW() returns the system time skew in seconds between the two  *
#*     systems.                                                       *
#*                                                                    *
#*    SYNC() synchronizes the system time on the remote system if     *
#*     it is Windows - date is NOT synchronized.                      *
#*                                                                    *
#*    SYS() returns the operating system descriptor.                  *
#*                                                                    *
#*    TIME() returns the system time in non-leap seconds since the    *
#*     begining of the epoch (00:00:00, January 1, 1970).             *
#*                                                                    *
#*  The use of parentheses in the command is optional.                *
#<                                                                    *
#* Usage: rxd [-d][-p Port][-s][-f] Password                          *
#*                                                                    *
#*  Use the rx remote client program to issue the command.            *
#*                                                                    *
#*  Password cannot contain embedded blanks.                          *
#*                                                                    *
#* Dependencies: UNIX, Windows                                        *
#*               Perl interpreter                                     *
#>                                                                    *
#* Written:  12/22/1997  CA Nichols                                   *
#**********************************************************************
use strict;
use warnings;
use threads;
use threads::shared;
use IO::Handle;
use IO::Socket::INET;
use File::Find;
use File::Path;
use Digest::SHA;

########################################################################
######## ARGUMENT CHECKING
#######################################################################
if ( $^O eq 'os390' )
{
	require 5.008;
	require Encode;
	import Encode qw( from_to );
	require Encode::EBCDIC;
}

my $debug = 0;
my $port  = 1600;


while ( defined($ARGV[0]) and substr( $ARGV[0],0,1 ) eq "-" ) {
	if ( $ARGV[0] eq "-d" ) { $debug = 1; shift; next; }
	if ( $ARGV[0] eq "-p" ) { $port = $ARGV[1]; shift; shift; next; }
	if ( $ARGV[0] eq "-h" ) { usage(); exit 1; }
	print "Warning: Invalid argument '".$ARGV[0]."' ignored.\n";
	shift;
}

my $password = $ARGV[0] || "hot34tot";
##########################################################################
######## Thread-safe printing functions
#######################################################################
$|++;

my $semSTDOUT :shared;
sub tprint{
	lock $semSTDOUT;
	my $msg = shift;
	my $tid = shift || threads->tid();
	if($tid ne ""){$tid = "($tid)"};
	print "RXD+ $tid > $msg \n";
}
sub debug{
	if($debug){
		lock $semSTDOUT;
		my $msg = shift;
		my $tid = shift || threads->tid();
		if($tid == 0){ $tid = "MAIN";}
		if($tid ne ""){$tid = "($tid) "};

		print "DEBUG -- " . $tid . $msg . "\n";;
	}
}

sub usage
{
	print "Usage: rxd [-d][-p Port] Password\n";
}

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


##########################################################################
######## SEND\RECEIVE parsing functions
#######################################################################
sub receiveCommand{
	my $client = shift;
	debug("Waiting for command input");
	
	my $command = "";
	my $args = "";
	my $buffer = '';
	my $i = 0;
	while( my $num = sysread($client, $buffer, 100000, length($buffer)))  { #attempt to receive 100000 bytes at a time
		$i++;
		my $len = length($buffer);
		debug($num . " bytes received, bringing the total to " . $len);

		$command = flagUnwrap("RX", $buffer);
		if( $command ne ""){
			last;
		}
		if($i > 999999999){ #infinite loop stopper
			debug("Terminating infinite loop, closing connection to $client"); # just in case, but sysread would probably block anyways
			last;
		}
	}
	if(length($buffer) < 300){
		debug("Raw text received = $buffer");
	}else{
		debug("Received " . length($buffer) . " bytes from RX");
	}
	return ($command);
	
}


sub sendResponse{
	my $msg = shift;
	my $rc = shift;
	my $client = shift;
	$msg = flagWrap("RESPONSE", $msg); 
	my $rcMSG = flagWrap("RETURN CODE", $rc);
	
	my $response = flagWrap("RXD", $msg . $rcMSG);
	my $len = length($response);
	if($len < 200){
		debug("Command complete, sending response '$response'");
	}else{
		debug("Command complete, sending $len bytes in response.");
	}
	tprint("Command completed with a return code of $rc", threads->tid());
	syswrite($client, $response, length($response)) or debug(">>ERROR<< Couldnt write to client");
	debug("sent");
}
##########################################################################




##########################################################################
######## Worker Thread subroutine
#######################################################################
sub processRequest {
	my $client;
	my $tid = threads->tid;
	my $fno = shift;

	# need to add a while loop to retry
	while (1) {
		last if (open $client, "+<&", $fno);
		sleep (1);
	}

	$client->autoflush(1);
	debug("Connected to client machine");
	my $response = "";
	my $returnCode = "";

	my $fullCMD = receiveCommand($client);
	my $pswd = flagUnwrap("PASSWORD", $fullCMD);
	my $command = uc(flagUnwrap("COMMAND", $fullCMD)); #Command ie EXEC
	my $args = flagUnwrap("ARGUMENTS", $fullCMD); #arguments for command
	tprint("$command $args");
	my $additionalData = flagUnwrap("ADDITIONAL DATA", $fullCMD); #like a file
	my $shaValue = flagUnwrap("SHA VALUE", $fullCMD);
	my $readMoreSize = flagUnwrap("READ SIZE", $fullCMD); #indicating a long file
	if($pswd eq $password){
		#debug($readMoreSize);
		if($readMoreSize ne ""){ #RX is going to try to send more stuff!
			debug("Now waiting for the client to send $readMoreSize more bytes");
			my $i = 0;
			while(length($additionalData) < int($readMoreSize) and $i < 9999999){
				$i++;
				my $num = sysread($client, $additionalData, $readMoreSize, length($additionalData));
				my $len = length($additionalData);
				if(defined($num)){
						debug($num . " bytes received, bringing the total to " . $len);
				}
			}
		}
		
		my $len = length($additionalData);
		if($len > 0){
			if($len < 200 and $additionalData !~ /\n/ms){
				tprint("Additional data received: $additionalData");
			}else{
				tprint("Received $len bytes of additional data");
			}
		}
		($response, $returnCode) = executeCommand($command, $args, $additionalData, $client, $shaValue);
	}else{
		$response = "Incorrect password specified";
		$returnCode = 1;
	}
	 
	#since execprint needs to be able to send while simultaneously executing the command
	#cannot store output in a string to send at once
	if ($command ne 'EXECPRINT' and $command ne 'GET' and $command ne 'GETB') {
		sendResponse($response, $returnCode, $client);
	}


	sleep 10;
	debug("Closing connection");
	shutdown($client, 2);
	close $client;
	
	# need to have thread return fd
	return ($fno);
}


sub executeCommand{
	my $rxdCMD = uc(shift);
	my $rxdArgs = shift;
	my $rxdData = shift;
	my $client = shift;
	my $shaValue = shift || "";
	my $resp = "";
	my $rc = 0;

	if($rxdCMD ne ""){
		debug("Processing command '$rxdCMD'");
		if ( $rxdCMD eq 'CMD' && $rxdArgs ne '' )    # CMD(Command)
		{
			if ( $^O eq "MSWin32" ) {
				system "start /b cmd.exe /c $rxdArgs";
				$rc = int($?>>8);
			}
			else {
				$rxdArgs =~ s/ \*/ \\\*/g;
				system "$rxdArgs &";
				$rc = int($?>>8);
			}

		}
		elsif ( $rxdCMD eq 'CMDF' && $rxdArgs ne '' )    # CMD(Command)
		{
			my ( $file, $argf ) = split ' ', $rxdArgs, 2;
			if ( $^O eq "MSWin32" ) {
				system "start /b cmd.exe /c $argf 2>>&1 > $file";
				$rc = int($?>>8);
			}
			else {
				$rxdArgs =~ s/ \*/ \\\*/g;
				system "$argf 2>&1 > $file &";
				$rc = int($?>>8);
			}
		
		}
		elsif ( $rxdCMD eq 'COPY' && $rxdArgs ne '' )   # COPY(Source Target)
		{
			if ( $^O eq "MSWin32" ) {
				system "copy /y $rxdArgs";
				$rc = int($?>>8);
			}
			else {
				system "cp $rxdArgs";
				$rc = int($?>>8);
			}
		}

		elsif ( $rxdCMD eq 'DEL' && $rxdArgs ne '' )    # DEL(Filespec)
		{
			if ( $^O eq "MSWin32" ) {
				$rxdArgs =~ s/\\/\\\\/g;
			}
			my $err = 0;
			$err = unlink glob( $rxdArgs );
			if ( $err) { $resp = "File removed successfully"; }
			else{$resp = "File could not be removed";}
		}

		elsif($rxdCMD eq 'DIR'){
			my $cmd = '';
			if ( $^O eq "MSWin32" ) {
				$cmd = "dir /b /o-d $rxdArgs";
			}
			else {
				$cmd = "ls -t $rxdArgs";
			}
			debug("Executing `$cmd`");
			$resp = `$cmd 2>&1`;
			$rc = int($?>>8);
		}
					   
		elsif($rxdCMD eq 'ENV' && $rxdArgs ne ''){
			$resp = $ENV{$rxdArgs};
			$rc = int($?>>8);
		}
		elsif ( $rxdCMD eq 'EXEC' && $rxdArgs ne '' )   # EXEC(Command)
		{
			my $error = 0;
			if ( $^O eq "MSWin32" ) {
				$resp = `$rxdArgs 2>>&1`;
			}else {
				$rxdArgs =~ s/ \*/ \\\*/g;
				$resp = `$rxdArgs 2>&1`;
			}
			$rc = int($?>>8);
		}
		elsif ( $rxdCMD eq 'FG' && $rxdArgs ne '' )   # EXEC(Command)
		{
			if ( $^O eq "MSWin32" ) {
				system($rxdArgs);
			}
			else {
				$rxdArgs =~ s/ \*/ \\\*/g;
				system($rxdArgs);
			}
			$rc = int($?>>8);
		}
		else{
			$resp = "Unrecognized command. Pleas refer to the documentation for a list of possible commands.";
			$rc = 1;
		}


	}else{
		$rc = 1;
		$resp = "Command was not passed successfully.";
	}
        
	if($resp eq ''){
		if($rc){
			$resp = "Command was not completed successfully.";
		}else{
			$resp = "Command was completed successfully.";
		}
	}
	debug("Command execution completed!");
	return ($resp, $rc);
}

sub calculateSHA{
	my $file = shift;
	my $val = 0;
	open(my $fh, $file) or return "";
	eval{
		my $sha1 = Digest::SHA->new(256);
		$sha1->addfile($fh);
		$val = $sha1->hexdigest;
	};
	if($@){
		debug("An error occurred calculating the SHA-Value. Cannot verify integrity of file\n$@");
	}
	close($fh);
	return $val;
}

sub getDirs{
	my $args = shift;
	
	my $dir1 = "";
	my $dir2 = "";

	$dir2 = $2 if ($args =~ /"(.+)"\s+"(.+)"/i);
	if($dir2 eq ""){
		$dir1 = $args;
		# $dir2 = $dir1;
	}else{
		$dir1 = $1 if ($args =~ /"(.+)"\s+"(.+)"/i);
	}
	
	debug("Source file is: " . $dir1); 
	debug("Destination file is: " . $dir2); 
	
	
	return ($dir1, $dir2);
}


sub flagWrap {
	my $flag = shift;
	my $string = shift;
	my $flagPattern = '***';
	return $flagPattern . $flag . " BEGIN" . $flagPattern . $string . $flagPattern . $flag . " END" . $flagPattern;
}

sub flagUnwrap{
	my $flag = shift;
	my $string = shift;
	my $flagPattern = '\*\*\*';
	my $regexH = $flagPattern . $flag . " BEGIN" . $flagPattern;
	my $regexT = $flagPattern . $flag . " END" . $flagPattern;
	if($string =~ /$regexH(.+)$regexT/ims){
		return $1;
	}else{
		return "";
	}
}


sub deltree{
	my $dir = shift;
	my $keep = shift;
	my $keepRoot = 0;
	debug("Removing directory '$dir'");
	if($keep eq "KEEP ROOT"){
		debug("Keeping the root directory");
		$keepRoot = 1;
	}

	unless(-d $dir){
		debug("Directory '$dir' does not exist to remove.");
		return 0;
	}

	my $command = '';
	if ( $^O eq "MSWin32" ) {
		if($dir !~ /^[A-Za-z]:(\\|\/).+/){# just checking for <drive><:><\ or />
			debug("Directory does not match standard windows folder format. Make sure the full path is specified.");
			return 0;
		}
		$command = "rmdir /s /q \"$dir\"";
		$command .= " && mkdir $dir" if($keepRoot);
	}
	else {
		if($dir !~ /^\//){# just checking it begins with a '/' to ensure it is the full path. 
			debug("Directory does not match standard windows folder format. Make sure the full path is specified.");
			return 0;
		}
		$command = "rm -rf \"$dir\"";
		$command .= "/*" if($keepRoot);
		$command =~ s/\/\//\//g; #replace double slashes with a single in case appending the "/*" created a double
	}
	debug("Executing command '$command'");
	system($command);
	my $rc = int($?>>8);
	debug("Command completed with return code '$rc', returning '" . !$rc . "'");
	return !$rc;
}
##########################################################################





#############################################################################
######## MAIN THREAD	
my $lsn = new IO::Socket::INET(
	Listen => SOMAXCONN,
	LocalPort => $port,
	ReuseAddr => 1,
	Blocking => 1,
	
	) or die "Failed to open listening port: $!\n";

print "RXD+ had been started on port $port\n";
debug("Password is '$password'");

#making the CWD the directory RXD is located in
use FindBin qw($Bin);
my $currentDir = $Bin;
if ($^O =~ /win/i) {
	$currentDir =~ tr/\//\\/;
} elsif (($^O !~ /win/i) && ($currentDir !~ /\//)) {
	$currentDir .= "/";
}

chdir($currentDir);

# create a cache hash
my %FDcache;

while(1) {
	my $client;
	my $fd;
		
	unless ($client = $lsn->accept) {
		tprint ("Could not connect to socket: " . $!);
		next;
	}
		
	# change filehandle to file descriptor
	$fd = fileno $client;
	unless(defined($fd)){close($client);next;}
	
	# add filehandle to cache hash
	# tprint("Caching file descriptor- $fd");
	$FDcache{$fd} = $client;
	
	#if(!defined($client)){tprint("Could not connect to client"); next;}
	debug("Creating a new thread");
	my $thd = threads->create('processRequest', $fd);
	unless(defined($thd)){close($client); next;}
	#$thd ->detach();
	debug("New thread created TID: " . $thd->tid());
	
	# wait to join and delete from hash
	foreach my $join (threads->list(threads::joinable)) {
		my $val = $join->join();
		# tprint("Deleting fd- $val");
		delete $FDcache{$val};
	}
	
}

sub shutdownRXD{
	tprint("Sutting down");
	exit 0; 
}
#############################################################################


END{
	print "The RXD server has been shutdown.";
}