#!/usr/bin/perl

BEGIN {
	# define perl version
	$PERL_VER = sprintf("%vd", $^V);
	if ($PERL_VER eq '%vd') { ## perl doesn't support $^V
		$] =~ m/^([0-9]\.[0-9]{3})/;
		$PERL_VER = $1;	
	}
}

# get params from /etc/psa/psa.conf
my %psa_conf = ();
open (FD, '/etc/psa/psa.conf') || die "Unable to open psa configuration file :$!\n";
while (<FD>) {
	s/^\s*$//g;
	s/#.*$//g;
	next unless $_;
	m/^\s*([^\s]+)\s+([^\s]+)\s*$/;
	$psa_conf{$1} = $2;
}
close FD;

use lib "$psa_conf{'PRODUCT_ROOT_D'}/lib/perl5/$PERL_VER";
use lib "$psa_conf{'PRODUCT_ROOT_D'}/lib/perl5/site_perl/$PERL_VER";
use lib "$psa_conf{'PRODUCT_ROOT_D'}/lib/perl5/site_perl/$PERL_VER/mach";

use MIME::Base64;
use File::Basename;
use File::Find;
use File::Path;
use File::stat;

my $drweb_ini = $psa_conf{'DRWEB_ETC_D'} . "/drweb32.ini";
my $default_key = $psa_conf{'DRWEB_ROOT_D'} . "/drweb32.key";

sub install($);
sub find_previous($);
sub remove();
sub usage ()
{
	print " --install --key <key file> install new drweb key\n";
	print " --remove --key <key file> delete the drweb key\n";
	print " --activate --key <key file> activate the drweb key\n";
	exit(1);
}

# parse command line arguments
if (@ARGV[0] eq "--install" && @ARGV[1] eq "--key") {
	install(@ARGV[2]);
} elsif (@ARGV[0] eq "--activate" && @ARGV[1] eq "--key") {
	install(@ARGV[2]);
} elsif (@ARGV[0] eq "--remove" && @ARGV[1] eq "--key") {
	my $prev = find_previous(@ARGV[2]);
	if ($prev eq "") {
		remove();
	} else {
		install($prev);
	}
} else {
	usage();
}

sub get_param($$)
{
	my ($key_file, $param_name) = @_;
	my $pattern = "^$param_name=(['\"])([-A-Za-z0-9+\\/=]*)\\1\$";

	open(KEYIN, $key_file) or die("open($key_file) failed: $!\n");

	while (<KEYIN>) {
		if (/$pattern/) {
			close KEYIN;
			return $2;
		}
	}

	close KEYIN;
	return undef();
}

sub extract($);
sub install($)
{
	my ($key_file) = @_;

	my $key = get_param($key_file, 'key');

	if (!defined($key)) {
		die("no key found in $key_file\n");
	}
	extract($key);
}

sub locate_key();
sub remove()
{
	my $drwebkey = locate_key();
		if (!unlink($drwebkey)) {
			if (!($!{ENOENT})) {
				die ("remove($drwebkey) failed: $!\n");
			}
	}
}

sub backup($);
sub extract($)
{
	my ($string) = @_;
	my $drwebkey = locate_key();
	backup($drwebkey);

	my $tmpname = mk_temp($drwebkey);
	my $dir = dirname($tmpname);
	if (!-d $dir) {
		if (-e $dir) {
			die ("Key directory '$dir' already exists and is not a directory\n");
		}
		mkpath($dir);
	}
	open(TMPFD, ">$tmpname") or die ("Temporary file '$tmpname' open failed:$!\n");

	my $key_string = MIME::Base64::decode_base64($string);
	print TMPFD $key_string;
	close TMPFD;
	rename($tmpname, $drwebkey);
}

sub locate_key ()
{
	if (!open (ini, $drweb_ini)) {
		if ($!{ENOENT}) {
			print STDERR "Drweb configuration not found, use default $default_key\n";
			return $default_key;
		} else {
			die("open($drweb_ini) failed: $!\n");
		}
	}

	while(<ini>) {
		if (/^\s*Key\s*=\s*"(.*)"\s*$/i) {
			close ini;
			return $1;
		}
	}

	close ini;

	die("no Key parameter found in $drweb_ini\n");
}

sub backup($)
{
	my ($file) = @_;
	my $count = 0;

	while(1) {
		if (link($file, $file."~".$count."~")) {
			return;
		} else {
			if ($!{EEXIST}) {
				$count++;
			} elsif ($!{ENOENT}) {
				return;
			} else {
				printf ("%d\n",$!);
				warn ("Cannot backup $file : $!\n");
				return;
			}
		}
	}
}

sub randFileName($)
{
	my ($fname) = @_;

	my $random = int(rand() * 1000000000); 

	return $fname . '.' . $random;
}

sub mk_temp($)
{
	my ($fname) = @_;
	my $i = 10;

	my $tmp_fname = randFileName($fname);
	while (($i-- > 0) && (-f $tmp_fname)) {
		$tmp_fname = randFileName($fname);
	}

	return $tmp_fname;
}

sub find_previous($)
{
	my ($current_fname) = @_;

	local $key_name = get_param($current_fname, 'name');
	local $last_mtime = 0;
	local $last_name = '';
	sub wanted {
		if ($File::Find::name eq $current_fname) {
			return;
		}
		my $sb = stat($File::Find::name);
		my $name = get_param($File::Find::name, 'name');
		if ($key_name eq $name and $sb->mtime > $last_mtime)
		{
			$last_mtime = $sb->mtime;
			$last_name = $File::Find::name;
		}
	}
	find(\&wanted, dirname($current_fname));
	return $last_name;
}