#!/usr/bin/perl

##Copyright (C) 2007 Fonality Inc. (fonality.com)
#
#This program is free software; you can redistribute it and/or
#modify it under the terms of the GNU General Public License
#as published by the Free Software Foundation; either version 2
#of the License, or (at your option) any later version.
#
#This program is distributed in the hope that it will be useful,
#but WITHOUT ANY WARRANTY; without even the implied warranty of
#MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#GNU General Public License for more details.
#


use strict;
use Crypt::CBC;
use LWP::UserAgent;
use LWP::Simple;
use HTTP::Request::Common;
use IPC::Open3 qw/open3/;
use MIME::Base64 qw/encode_base64/;
use DB_File;
use Digest::MD5 qw/md5_hex/;
use Getopt::Long qw/GetOptions/;
use File::Spec;

my $VERSION = 9; #Increment to force clients to attempt to update themselves.

my $INSTALL_PATH = "/var/adm/bin";
my $CACHE_DB = "$INSTALL_PATH/registry_cache.db";
INSTALL_CRON_JOB(); #If we aren't already in the cron, install ourselves.

# This file is design to be executed regularly by an external controller such as cron.
# It retrieves a list of commands to be executed from the specified URI and executes them, saving the output
# and returning it to the webserver as an encrypted string.
my $remote_host;
if (-e "/etc/asterisk/fonality/globals.conf")
{
	my $server_id = get_server_id();
	if ($server_id >= 100000)
	{
		$remote_host = "proregistry.trixbox.com";
	}
	else
	{
		$remote_host = "update.fonality.com";
	}
}
else
{
	$remote_host = "registry.trixbox.com";
}

my $server_uri = "http://$remote_host/server_monitor.cgi";
my $update_uri = "http://$remote_host/";
my $server_id = get_server_id();

warn "SENDING SERVER ID: '$server_id'\n";

###############################################################################
# Fetch commands to run.
my $ua = LWP::UserAgent->new;

my $resp = fetch_server_commands( $ua );

my $key = get_key();
chomp $key;

my $cipher = Crypt::CBC->new( -cipher => "Blowfish", -key => $key );
my @commands = split /\n/, $cipher->decrypt( $resp->content );


###############################################################################
# Check our version.
my $expected_version = shift @commands;
if( $expected_version > $VERSION ) 
{
	warn "Trying to update: $update_uri/recognition.pl\n";
	my $update_resp = $ua->get("$update_uri/recognition.pl");
	
	if( $update_resp->is_success )
	{
		open my $fh, "> $INSTALL_PATH/tmp_recognition.pl" or die $!;
		print $fh $update_resp->content;
		close $fh;
		rename "$INSTALL_PATH/tmp_recognition.pl", "$INSTALL_PATH/recognition.pl" or warn "ERROR couldn't replace old recognition with new one: $!\n";
	}
	else
	{
		warn "ERROr, couldn't fetch recognition.pl ", $update_resp->status_line;
	}
	
	$update_resp = $ua->get("$update_uri/registry.pl");

	if( $update_resp->is_success )
	{
		my ( $fname  ) = (File::Spec->splitpath($0))[-1];

		open my $fh, "> $INSTALL_PATH/tmp_$fname" or die "Failed to open $INSTALL_PATH/tmp_$fname: $!";
		print $fh $update_resp->content;
		close $fh;
		rename "$INSTALL_PATH/tmp_$fname", "$INSTALL_PATH/$fname";
		exec "perl", "$INSTALL_PATH/$fname";
		exit; #If the exec failed, cleanly die.
	}
	else
	{
		die "Error, version is out of date and I could not fetch an update.\n";
	}


}


###############################################################################
# Check if we've been assigned a new server-id (for CE servers only)
my $new_id = shift @commands;
if( length $new_id > 1 and $new_id ne $server_id )
{
	$server_id = $new_id;
	store_generated_id( $new_id );

	#SERVER_ID\nSERVER_KEY
	#The key is only there if our ID has changed..
	my $new_key = shift @commands;
	store_generated_key( $new_key );
	$cipher = Crypt::CBC->new( -cipher => "Blowfish", -key => $new_key );

	#Remove cache file, since we should think we're now running on a brand new server.
	unlink $CACHE_DB;
}

###############################################################################
# Execute commands.
my @command_outputs;
for( @commands ) 
{
	my $pid = open3 my $write_handle, my $read_handle, my $err_handle, $_;
	close $write_handle;

	chomp( my @output = <$read_handle> );
	chomp( my @errors = <$err_handle> );
	waitpid $pid, 0;
	my $child_return_value = $?;
	my $success = 1; #Default to succeeded.

	if( $output[0] =~ /open3:/ ) #This matches the exceptions thrown by open3. Example, open3: Failed to exec in child..
	{
		@errors = @output;
		@output = ();
		$success = 0;
	}

	print "Cmd: $_\n";
	print "Received ", scalar @output, " lines of output\n";
	print "\t-- '$output[0]'\n";
	print "Received ", scalar @errors, " lines of errors\n\n";


	push @command_outputs, {
		stdout => ( join "\n", @output ),
		stderr => ( join "\n", @errors ),
		return_value => $child_return_value,
		succeeded => $success,
		command => $_,
	};
}


###############################################################################
# Generate report structure.
my @xml_outputs;
tie my %cached_output, 'DB_File', $CACHE_DB or die $!;
for( @command_outputs )
{
#  my $stdout = encode_base64 join "\n", @{ $_->{stdout} };
#  my $stderr = encode_base64 join "\n", @{ $_->{stderr} };
#  my $command = encode_base64 $_->{command};
	for( values %$_ )
	{
		$_ = encode_base64( $_ ) ;
	}

	my $xml = 
		"<results>
			<command>$_->{command}</command>
			<stdout>$_->{stdout}</stdout>
			<stderr>$_->{stderr}</stderr>
			<return_value>$_->{return_value}</return_value>
			<succeeded>$_->{succeeded}</succeeded>
		</results>"
	;
	my $checksum = md5_hex( $xml );

	if( $cached_output{ $_->{command} } ne $checksum )
	{
		push @xml_outputs, { encrypted => $cipher->encrypt( $xml ), command => $_->{command}, xml => $xml };
	}
}


###############################################################################
# Upload report.
if( @xml_outputs )
{
	my $post = POST $server_uri, 
		Content_Type => 'form-data',
		Content => [
			m => 'receive_results',
			server_id => $server_id,
			map {; "command$_" => [ undef, "command$_", Content => $xml_outputs[$_]->{encrypted}  ] } #Note, the semicolon is in fact required.
				0 .. $#xml_outputs,
		]
	;

	#Actually send request.
	my $resp = $ua->request( $post );

	############################################################################
	# Successful upload, update our cachefile
	if( $resp->is_success )
	{
		for( @xml_outputs )
		{
			my $checksum = md5_hex( $_->{xml} );
			$cached_output{ $_->{command} } = $checksum;
		}
	}
}


################################################################################
# Begin subs.
################################################################################
sub fetch_server_commands
{
	my( $ua ) = @_;

	my $resp = $ua->get("$server_uri?m=fetch_commands&sid=$server_id");

	warn "$server_uri?m=fetch_commands&sid=$server_id\n";
	if( $resp->is_error )
	{
		die "The request to retrieve commands to execute has errored with the following status: ", $resp->code, " -- exiting.\n";
	}
	elsif( $resp->content =~ /ERROR:/ )
	{
		if( $resp->content =~ /invalid server id/ )
		{
			$server_id = server_generate_id();
			return fetch_server_commands( $ua );
		}
	}

	return $resp;
}


sub get_server_id
{
	my $id = get_globals_user_id();

	if( $id ) { return $id; }

	$id = get_generated_id();

	if( $id ) { return $id; }
	
	die "Error: Couldn't find or generate a server id\n";
}

sub get_globals_user_id
{
	open my $fh, "/etc/asterisk/fonality/globals.conf" or return;

	while( <$fh> )
	{
		if( /ACCOUNT=(\S+)/ )
		{
			return $1;
		}
	}
}

sub get_generated_id
{
	if( -e "/etc/trixbox/monitor_server_id" )
	{
		open my $fh, "/etc/trixbox/monitor_server_id" or die; #FIXME shouldn't die
		chomp( my $id = <$fh> );

		if( $id )
		{
			return $id;
		}
	}

	return server_generate_id();
}

sub server_generate_id
{
	my $key_id = get( "$server_uri?m=generate_id" );
warn "RETURN VALUE: '$key_id'\n";
	my( $id, $key ) = split /\n/, $key_id;

	store_generated_id( $id );
	store_generated_key( $key );

	return $id;
}

sub store_generated_id
{
	my( $id ) = @_;

warn "STORING ID -- $id\n";

	open my $fh, "> /etc/trixbox/monitor_server_id" or die "Error, couldn't open /etc/trixbox/monitor_server_id: $!\n";
	print $fh $id;
}

sub store_generated_key
{
	my( $key ) = @_;

	mkdir "/etc/trixbox";
warn "STORING KEY -- $key\n";
	
	open my $fh, "> /etc/trixbox/monitor_server_key" or die "Error, couldn't open /etc/trixbox/monitor_server_key: $!\n";
	print $fh $key;
}

sub get_key
{
	my $file;

	for( qw{ /etc/asterisk/key /etc/trixbox/monitor_server_key } )
	{
		if( -e $_ ) { $file = $_; last; }
	}

	open my $fh, "< $file" or die "Error couldn't open keyfile $file: $!\n";
	my $key = <$fh>;
	chomp $key;

	return $key;
}

sub INSTALL_CRON_JOB
{
	my $fn = "/tmp/newcron.$$";
	system "crontab -l > $fn";

	open my $fh, "< $fn" or die $!;
	while( <$fh> )
	{
		if( /registry.pl/ ) { unlink $fn; return; }
	}

	#We didn't exit early..
	close $fh;
	open $fh, ">> $fn" or die $!;
	my ($minute,$hour ) = (int(rand(60)), int(rand(24)));
	print $fh "$minute $hour * * * perl $INSTALL_PATH/registry.pl &> /dev/null \n";
	close $fh;

	system( "crontab $fn" );
}