#!/usr/bin/perl
#
# (C) Copyright 2003 SWsoft, Inc. All rights reserved.
# contact email: contact@plesk.com
#
# LICENSE :


%STD_LIBDIRS = ();
%PSA_LIBDIRS = ();

BEGIN {
	$psalib = $0;
	my $count  = $psalib =~ tr/\///;
	$count-- if $psalib  =~/^\.\// ;
	if( $count > 1 ) {
		$psalib =~ s/(\/[^\/]+?){2}$//;
	} elsif( $count == 1 ) {
		$psalib = '.';
	} else {
		$psalib = '..';
	}
	$psa_prefix .= $psalib;
	$psalib .= "/lib/perl5";

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

	if ($^O eq 'freebsd') {
		if ("$perl_ver" ne "5.8.6") {
			print "WARNING: YOU ARE USING PERL $perl_version VERSION, BUT BU ARE COMPILED WITH PERL $  AND WE NOT GUARANTEE THAT Backup Utils WILL BE WORK PROPERLY\n";
			print "YOU SHOULD INSTALL THE FOLLOWING MODULES FOR THE PERL $perl_version TO USER Backup Utils:\n";
			print "HTML-Parser, DBI, MIME-Base64, Digest-MD5, Digest-SHA1, XML-Parser, Text-Iconv, Compress-Zlib, DBD-mysql, XML-DOM, MIME-Lite\n\n";
		}
	}

	use Config;
	my $new_prefix = $psa_prefix;
	$new_prefix =~ s,([^/])$,\1/,;
	my $sys_prefix = (($^O eq 'freebsd') && ($] < 5.006)) ? "/usr/local" : $Config{'prefix'};
	my @lib_dir_list = ('INSTALLSITELIB', 'INSTALLSITEARCH', 'INSTALLARCHLIB', 'INSTALLPRIVLIB');

	foreach my $dir_name (@lib_dir_list) {
		$_ = $Config{lc($dir_name)};
		### define standard libdir
		$STD_LIBDIRS{$dir_name} = $_;
		### define psa libdir
		s,^$sys_prefix/?,$new_prefix,;
		$PSA_LIBDIRS{$dir_name} = $_;
	}
}

use lib $STD_LIBDIRS{'INSTALLSITELIB'};
use lib $STD_LIBDIRS{'INSTALLSITEARCH'};
use lib $STD_LIBDIRS{'INSTALLARCHLIB'};
use lib $STD_LIBDIRS{'INSTALLPRIVLIB'};

use lib $PSA_LIBDIRS{'INSTALLSITELIB'};
use lib $PSA_LIBDIRS{'INSTALLSITEARCH'};
use lib $PSA_LIBDIRS{'INSTALLARCHLIB'};
use lib $PSA_LIBDIRS{'INSTALLPRIVLIB'};

use lib ".";
use lib "$psalib";


use DBI;
use XML::XQL;
use XML::XQL::DOM;
use XML::XQL::Debug;
use MIME::Base64 qw(encode_base64 decode_base64);

use BU::PSA::Const;
use BU::Logger;
use BU::Params;
use BU::FileFunc;
use BU::PSA::Restore::Domain;

$flags{OVERWRITE} = 1;

umask(0022);

my $usage = "Usage: $0 [-h] -f <dump_file> [options]";

$Help = << "EOF";
$usage

Options:
   -h - This help.
   -f <dump_file> - File with dump.

   --creating-time - Prints dump creation time.
   --info          - Prints info about dumped domain (for domain dumps).
   --get-name      - Prints name of the domain in dump (for domain dumps)
   --description   - Prints dump description.
EOF
#Options:

use Getopt::Long;

Getopt::Long::Configure("no_ignore_case", "no_ignore_case_always");
my %lopts_all = (
'h'			=> \$opt_h,
'v'			=> \$opt_v,
'version'	=> \$opt_v,
'f=s'		=> \$opt_f,
'single-domain-mode' => \$single_domain_mode,
'domain-name=s' => \$single_mode_domain_name,
'creating-time' => \$opt_creating_time,
'info' => \$opt_info,
'get-name' => \$opt_get_name,
'description' => \$opt_description,
'check-dump' => \$opt_check_dump
);

unless ( GetOptions (%lopts_all) ) {
	print_stderr ("$usage\n");
	exit 1;
}

if ($opt_v) {
	printPASTitle();
	exit 0;
}

# analize command line options
if($opt_h) {
	print_stderr("This util is not a command line utility for hands using.\n");
	print_stderr("This is a auxiliary utility for other utilities.\n");
	exit 1;
}

#if ($single_domain_mode && !$single_mode_domain_name) {
#	print_stderr ("In single domain mode domain name parameter --domain-name is required.\n");
#	exit 1;
#}

if ($opt_f eq '') {
	print_stdout("Key '-f' requires parameter\n");
#	print_stderr ("ERROR: the file with PSA dump was not specified.\n");
	print_stderr ("$usage\n");
	exit 1;
}

if ($opt_info && !$single_mode_domain_name) {
	if ( ! -f $opt_f ) {
		printf_stdout("-f option should be full path to dump file in other case --domain-name parameter is required.\n");
		die "\n";
	}
}

use BU::PSA::CommonFunc;
use BU::MIME::Mime;

checkInstalledPSAVersion;

$| = 1;

my $file_def = "psa.archive";
my ($proto, $metod, @metod_params) = getTarget($opt_f, $file_def);

unless ($metod) {
	print_stdout("ERROR: the specified transfer method is not supported or the file name is invalid: $opt_f\n");
	print_stderr ($Help);
	die "\n";
}

if($metod == $metod_const{STD}) {
	$arc = new BU::MIME::Mime({'file_descriptor' => \*stdin});

} elsif($metod == $metod_const{FILE}) {
	my ($file)= $metod_params[0];

#	print_log("Processing file with PSA dump: $file\n\n");
	
	$arc = new BU::MIME::Mime({'file_name' => $file});
} elsif($metod == $metod_const{TFTP}) {
	my ($host, $file)= @metod_params;

#	print_stdout ("Trying to get file $file from $host\n");

	my $tftp = Net::TFTP->new($host, BlockSize => 1024) || die "TFTP ERROR: %s.\n", $tftp->error."\n";
	$tftp->binary;
#	$tftp->debug() if ($debug > 0);
	$fh = $tftp->get($file) || die "TFTP ERROR: %s.\n", $tftp->error."\n";

	$arc = new BU::MIME::Mime({'file_descriptor' => $fh});

} else {
	printf_stdout("ERROR: the specified transfer method is not supported.\n");
	die "\n";
}

unless ($arc) {
	printf_stdout("ERROR: unable to create BU::MIME::Mime object: %s\n", $arc->getErrorMsg());
	die "\n";
}

if ($arc->error()) {
	printf_stdout($arc->getErrorMsg() . "\n");
	die "\n";
}

my $dumpPSAVer = $arc->getMimeHeaderField('Dumped-Psa-Version');
my $dumpPSAVerInt = ver2int($dumpPSAVer);

if ($dumpPSAVerInt <= 0) {
	printf_stdout("PSA version in MIME header is invalid.\n");
	die "\n";
}

if ($opt_creating_time) {
	my $ts = $arc->getMimeHeaderField('Creating-Timestamp');
	print "$ts\n";
	exit 0;
}

if ($opt_check_dump) {
	exit 0;
}

$arc->readPartHeader();
if ($arc->error()) {
	print_stderr($arc->getErrorMsg() . "\n");
	die "\n";
}

#print_stdout ("Reading and parsing the file containing the saved PSA configuration ...");

my $temp_file = tempFileName($const{PRODUCT_NAME} . '.xml');

unless (open fd, ">$temp_file") {
	print_stderr("\nERROR: unable to create temporary file '$temp_file': $!\n");
	die "\n";
}
$arc->readPartContent(\*fd);
unless (close fd) {
	print_stderr("\nAn error occured during temporary file writing '$temp_file': $!\n");
	die "\n";
}

if ($arc->error()) {
	printf_stdout($arc->getErrorMsg() . "\n");
	die "\n";
}


my $dom = new XML::DOM::Parser;

my $doc = $dom->parsefile(XML::XQL::Debug::filename($temp_file));
unlink($temp_file);

# global variables - XML root node and database wrapper
$psaNode = $doc->getChildNodes()->item(0);

if ($opt_info) {

	# Get only domain node with given name
	# (dump may contains several domain nodes or may not contain 
	# node with this name)

	my ($domainNode) = $psaNode->xql('./sites/domain[@name="' . $single_mode_domain_name . '"]');

	unless ($domainNode) {

		# If domain node with appropriate name not found - dump
		# most probably is made for domain with different name.
		# So, get a first domain name from dump.

		($domainNode) = $psaNode->xql('./sites/domain');
	}

	my %dumpLimitsUsage = ( 
		'max_box'		=> 'mailboxes',
		'max_redir'		=> 'mailredirects',
		'max_mg'		=> 'mailgroups',
		'max_resp'		=> 'autoresponders',
		'max_wu'		=> 'webusers',
		'max_db'		=> 'databases',
		'max_webapps'	=> 'webapps',
		'max_maillists'	=> 'maillists',
		'max_subdomains'=> 'subdomains'
	);

	foreach my $limit (keys %dumpLimitsUsage) {
		my $value = getDumpLimitUsage($domainNode, $limit);
		print $dumpLimitsUsage{$limit} . ":$value\n";
	}

	my $ip_address_id = undef;

	if (my ($ip_address_id_node) = $domainNode->xql('./user[@type = "hosting"]/ip_address')) {
		$ip_address_id = $ip_address_id_node->getAttribute('id');
	} else {
		if (my ($ip_address_id_node) = $domainNode->xql('./dns/host[(@type = "A") $and$ (@name = "' . a2u(u2a($domainNode->getAttribute('displayName')) . '.') . '")]')) {
			$ip_address_id = $ip_address_id_node->getAttribute('ip_address_id');
		} elsif (my ($ip_address_id_node) = $domainNode->xql('./dns/host[(@type = "A") $and$ (@name = "' . $domainNode->getAttribute('name') . '.")]')) {
			$ip_address_id = $ip_address_id_node->getAttribute('ip_address_id');
		}
	}

	if (my ($ip_address_node) = $psaNode->xql('./server/ip_addresses_list/ip_address[@id = "' . $ip_address_id . '"]')) {
		print "ip:" . $ip_address_node->getAttribute('ip_address') . "\n";
		print "ip_type:" . $ip_address_node->getAttribute('type') . "\n";
	}

	# define number of site apps
	my $site_apps_num = 0;
	foreach my $i ($domainNode->xql('./user[@type="hosting"]/site_apps/site_app')) {
		$site_apps_num++;
	}
	foreach my $i ($domainNode->xql('./user[@type="hosting"]/subdomains/subdomain/site_apps/site_app')) {
		$site_apps_num++;
	}
	print "site_apps:$site_apps_num\n";
}

# Get dumped domain name
if ($opt_get_name) {
	if ( ! -f $opt_f ) {
		printf_stdout("-f option should be full path to dump file in other case --domain-name parameter is required.\n");
		die "\n";
	}

	my ($domainNode) = $psaNode->xql('./sites/domain');
	unless ($domainNode) {
		print_stdout("Unable to define domain node.\n");
		die "\n";
	}

	# and simply print it
	my $dumped_name = $domainNode->getAttribute('name');
	print $dumped_name . "\n";
}

if ($opt_description) {
	if (my ($node) = $psaNode->xql('./description')) {
		my $textNode = $node->getFirstChild();
		if ($textNode) {
			print u2a($textNode->toString()) . "\n";
		}
	}
}

exit 0;

