#!/usr/bin/perl -w
#
# This is the main script of the NRH-up2date project, licensed under the GPL
# Version 1.3
#
# 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.
#
# 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.

use strict;
use Frontier::RPC2;
use Digest::MD5;
use BerkeleyDB;

my $methods = {
	'registration.welcome_message'		=> \&welcome_message,
	'registration.privacy_statement'	=> \&privacy_statement,
	'registration.reserve_user'			=> \&reserve_user,
	'registration.new_user'				=> \&new_user,
	'registration.new_system'			=> \&new_system,
	'registration.upgrade_version'		=> \&upgrade_version,
	'registration.register_product'		=> \&register_product,
	'registration.add_hw_profile'		=> \&add_hw_profile,
	'registration.add_packages'			=> \&add_packages,
	'registration.update_packages'		=> \&update_packages,
	'registration.delete_packages'		=> \&delete_packages,
	'registration.update_transactions'	=> \&update_transactions,
	'up2date.login'						=> \&up2date_login,
	'up2date.listChannels'				=> \&up2date_listChannels,
	'up2date.solveDependencies'			=> \&up2date_solveDependencies,
	'servers.list'						=> \&servers_list,
	'errata.getPackageErratum'			=> \&errata_getPackageErratum,
	'errata.GetByPackage'				=> \&errata_GetByPackage};

my $config_path = '/etc/nrh-up2date/';
my $store_path = '/var/spool/nrh-up2date/';

# Get our CGI request information.
my $method = $ENV{'REQUEST_METHOD'};
my $type = $ENV{'CONTENT_TYPE'};
my $length = $ENV{'CONTENT_LENGTH'};

# Perform some sanity checks.
http_error(405, "Make sure you set useNoSSLForPackages=yes and noSSLServerURL=http://<servername>/XMLRPC, not http://<servername>/cgi-bin/XMLRPC, this is the common mistake that triggers such situation !") unless $method eq "POST";
http_error(400, "Bad Request") unless $type eq "text/xml";
http_error(411, "Length Required") unless $length > 0;

# Fetch our body.
my $body;
my $count = read STDIN, $body, $length;
http_error(400, "Bad Request") unless $count == $length; 

# Serve our request.
my $coder = Frontier::RPC2->new;
send_xml($coder->serve($body,$methods));

# Send an HTTP error and exit.
sub http_error {
	my ($code, $message) = @_;
	print <<"EOD";
Status: $code $message
Content-type: text/html

<title>$code $message</title>
<h1>$code $message</h1>
<p>Unexpected error processing XML-RPC request.</p>
EOD
	exit 0;
}

# Send an XML document (but don't exit).
sub send_xml {
	my ($xml_string) = @_;
	my $length = length($xml_string);
	print <<"EOD";
Status: 200 OK
Content-type: text/xml
Content-length: $length

EOD
	# We want precise control over whitespace here.
	print $xml_string;
}

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

sub welcome_message {
	return 'Welcome to NRH-up2date registration system';
}

sub privacy_statement {
	return 'Privacy statement';
}

# returns 0 if the user does not exist, 1 if does and password matches.
# returns error is user exists and password not matches
sub reserve_user {
	my ($username, $password) = @_;
	my ($anon_passwd);

	if (open(ANON_PASS,$config_path.'anon_passwd')) {
		$anon_passwd = <ANON_PASS>;
		chomp($anon_passwd);
	}

	if ($anon_passwd ne '') {
		if (($username ne 'anonymous') || ($password ne $anon_passwd)) {
			die ("Anonymous access restricted.\nTrapped");
		}
	}

	return 0;
}

sub new_user {
	return 0;
}

# return valid system id as a string
sub new_system {
	my ($input) = @_;
	my ($md5,$anon_passwd,$secret);
	my (%response_hash) = ();

	$anon_passwd = '';

	if (open(ANON_PASS,$config_path.'anon_passwd')) {
		$anon_passwd = <ANON_PASS>;
		chomp($anon_passwd);
	}

	if ($anon_passwd ne '') {
		if (($input->{'username'} ne 'anonymous') || ($input->{'password'} ne $anon_passwd)) {
			die ("Anonymous access restricted.\nTrapped");
		}
	}

	$response_hash{'type'} = $coder->string('NRH-auth1');
	$response_hash{'description'} = "Initial release parameters:\nOs: Red Hat Linux\nRelease: ".$input->{'os_release'}."\nCPU Arch: ".$input->{'architecture'};
	$response_hash{'system_id'} = 'ID-000000001';
	$response_hash{'operating_system'} = 'Red Hat Linux';
	$response_hash{'profile_name'} = $coder->string($input->{'profile_name'});
	$response_hash{'username'} = $coder->string($input->{'username'});
	$response_hash{'os_release'} = $coder->string($input->{'os_release'});
	$response_hash{'architecture'} = $coder->string($input->{'architecture'});

	$secret = '';

	if (open(FILE, $config_path.'secret')) {
		$secret = <FILE>;
		chomp($secret);
		close FILE;
	}

	$md5 = Digest::MD5->new;
	$md5->add($input->{'profile_name'}, $input->{'username'}, $input->{'os_release'}, $input->{'architecture'}, 'ID-000000001','NRH-auth1',$secret);
	
	$response_hash{'checksum'} = $md5->hexdigest;

	my (@fields) = ('system_id','os_release','operating_system','architecture','username','type');

	$response_hash{'fields'} = \@fields;

	my $systemid = $coder->encode_response(\%response_hash);
	$systemid =~ s/<methodResponse>\n//;
	$systemid =~ s/<\/methodResponse>\n//;

	return $systemid;
}

# return valid system id as a string
sub upgrade_version {
	my ($systemid,$new_os_release) = @_;
	my ($params,$md5,$secret);

	$systemid =~ s/<params>\n/<methodCall>\n<methodName>stub.proc<\/methodName>\n<params>\n/;
	$systemid =~ s/<\/params>\n/<\/params>\n<\/methodCall>\n/;
	$params = $coder->decode($systemid)->{'value'};

	$secret = '';

	if (open(FILE, $config_path.'secret')) {
		$secret = <FILE>;
		chomp($secret);
		close FILE;
	}

	$md5 = Digest::MD5->new;
	$md5->add(%$params->[0]->{'profile_name'}, %$params->[0]->{'username'}, %$params->[0]->{'os_release'}, %$params->[0]->{'architecture'}, %$params->[0]->{'system_id'}, %$params->[0]->{'type'}, $secret);
	if ((%$params->[0]->{'checksum'} ne $md5->hexdigest) && (-f $config_path.'security')) {
		die ("Invalid system id detected - checksum doesn't match.\nTrapped ");
	}

	%$params->[0]->{'os_release'} = $coder->string($new_os_release);

	$secret = '';

	if (open(FILE, $config_path.'secret')) {
		$secret = <FILE>;
		chomp($secret);
		close FILE;
	}

	$md5 = Digest::MD5->new;
	$md5->add(%$params->[0]->{'profile_name'}, %$params->[0]->{'username'}, %$params->[0]->{'os_release'}, %$params->[0]->{'os_release'}, %$params->[0]->{'system_id'}, %$params->[0]->{'type'}, $secret);

	%$params->[0]->{'checksum'} = $md5->hexdigest;

	my (@fields) = ('system_id','os_release','operating_system','architecture','username','type');

	%$params->[0]->{'fields'} = \@fields;

	$systemid = $coder->encode_response(%$params->[0]);
	$systemid =~ s/<methodResponse>\n//;
	$systemid =~ s/<\/methodResponse>\n//;

	return $systemid;
}

sub register_product {
	return 0;
}

sub add_hw_profile {
	return 0;
}

sub add_packages {
	return 0;
}

sub update_packages {
	return 0;
}

sub delete_packages {
	return 0;
}

sub up2date_login {
	my ($systemid,$list_date,@channels,@channel,@extra_channel) = @_;
	my ($params,$md5, $authtoken,$secret);
	my (%response_hash) = ();

	$systemid =~ s/<params>\n/<methodCall>\n<methodName>stub.proc<\/methodName>\n<params>\n/;
	$systemid =~ s/<\/params>\n/<\/params>\n<\/methodCall>\n/;
	$params = $coder->decode($systemid)->{'value'};

	$secret = '';

	if (open(FILE, $config_path.'secret')) {
		$secret = <FILE>;
		chomp($secret);
		close FILE;
	}

	$md5 = Digest::MD5->new;
	$md5->add(%$params->[0]->{'profile_name'}, %$params->[0]->{'username'}, %$params->[0]->{'os_release'}, %$params->[0]->{'architecture'}, %$params->[0]->{'system_id'}, %$params->[0]->{'type'},$secret);
	if (%$params->[0]->{'checksum'} eq $md5->hexdigest) {
		$md5->new;
		$md5->add(%$params->[0]->{'username'},$secret);
		$authtoken = $md5->b64digest;
	} elsif (-f $config_path.'security') {
		die ("Invalid system id detected - checksum doesn't match.\nTrapped ");
	} else {
		$authtoken = 'anonymous';
	}

	if (!(%$params->[0]->{'os_release'} =~ /^[\w\.]+$/)) {
		die ("Bad os_release parameter.\nTrapped ");
	}

	if (open(LASTDATE,'<'.$store_path.%$params->[0]->{'os_release'}.'/nrh-listdate')) {
		$list_date = <LASTDATE>;
		close LASTDATE;
	} else {
		die ("nrh-listdate not found. Please have the admin run nrh-repository-update for this channel.\nTrapped ");
	}

	$channel[0] = $coder->string('redhat-linux-i386-'.%$params->[0]->{'os_release'});
	$channel[1] = $coder->string($list_date);
	$channel[2] = $coder->string(0);
	$channel[3] = $coder->string(1);
	$channels[0] = \@channel;

	if (open(LASTDATE,'<'.$store_path.%$params->[0]->{'os_release'}.'-extra'.'/nrh-listdate')) {
		$list_date = <LASTDATE>;
		close LASTDATE;
		$extra_channel[0] = $coder->string('redhat-linux-i386-'.%$params->[0]->{'os_release'}.'-extra');
		$extra_channel[1] = $coder->string($list_date);
		$extra_channel[2] = $coder->string(0);
		$extra_channel[3] = $coder->string(1);
		$channels[1] = \@extra_channel;
	}

	$response_hash{'X-RHN-Auth-Server-Time'} = $coder->string('1');
	$response_hash{'X-RHN-Server-Id'} = $coder->int(1);
	$response_hash{'X-RHN-Auth'} = $coder->string($authtoken);
	$response_hash{'X-RHN-Auth-User-Id'} = $coder->string(%$params->[0]->{'username'});
	$response_hash{'X-RHN-Auth-Expire-Offset'} = $coder->string('3600.0');
	$response_hash{'X-RHN-Auth-Channels'} = \@channels;

	return \%response_hash;
}

sub up2date_listChannels {
	my (%response_hash,%response_hash2) = ();
	my ($systemid) = @_;
	my ($params);
	my (@channels);

	$systemid =~ s/<params>\n/<methodCall>\n<methodName>stub.proc<\/methodName>\n<params>\n/;
	$systemid =~ s/<\/params>\n/<\/params>\n<\/methodCall>\n/;
	$params = $coder->decode($systemid)->{'value'};

	$response_hash{'arch'} = 'i386';
	$response_hash{'parent_channel'} = '';
	$response_hash{'label'} = 'redhat-'.%$params->[0]->{'os_release'}.'-i386';
	$response_hash{'description'} = 'Red Hat Linux '.%$params->[0]->{'os_release'};
	$response_hash{'name'} = 'Red Hat Linux '.%$params->[0]->{'os_release'};

	$channels[0] = \%response_hash;

	if (-e $store_path.%$params->[0]->{'os_release'}.'-extra'..'/nrh-listdate') {
		$response_hash2{'arch'} = 'i386';
		$response_hash2{'parent_channel'} = '';
		$response_hash2{'label'} = 'redhat-'.%$params->[0]->{'os_release'}.'-i386-extra';
		$response_hash2{'description'} = 'Red Hat Linux '.%$params->[0]->{'os_release'}.' Additional Applications';
		$response_hash2{'name'} = 'Red Hat Linux '.%$params->[0]->{'os_release'}.' Additional Apps';
		$channels[1] = \%response_hash2;
	}
	
	return \@channels;
}

sub up2date_solveDependencies {
	my ($systemid,$deps) = @_;
	my ($params,$dep,$line,$channel_update_date,$provides_db_path);
	my (%response_hash) = ();

	$systemid =~ s/<params>\n/<methodCall>\n<methodName>stub.proc<\/methodName>\n<params>\n/;
	$systemid =~ s/<\/params>\n/<\/params>\n<\/methodCall>\n/;
	$params = $coder->decode($systemid)->{'value'};

	if (!(%$params->[0]->{'os_release'} =~ /^[\w\.]+$/)) {
		die ("Bad os_release parameter.\nTrapped ");
	}

	if (open(LASTDATE,'<'.$store_path.%$params->[0]->{'os_release'}.'/nrh-listdate')) {
		$channel_update_date = <LASTDATE>;
		close LASTDATE;
	} else {
		die ("nrh-listdate not found. Please have the admin run nrh-repository-update for this channel.\nTrapped ");
	}

	$provides_db_path = $store_path.%$params->[0]->{'os_release'}.'/provides-list.'.$channel_update_date.'.db';

	my $db = new BerkeleyDB::Btree
			-Filename => $provides_db_path,
			-Flags	=> DB_RDONLY,
			-Property  => DB_DUP
		or die "Cannot open $provides_db_path: $! $BerkeleyDB::Error\nTrapped " ;

	foreach $dep (@$deps) {
		my (@pkglist,$pkgcounter);
		$response_hash{$dep} = \@pkglist;

		$pkgcounter = 1;

		my ($k, $v) = ($dep, "") ;
		my $cursor = $db->db_cursor() ;

		if ($cursor->c_get($k, $v, DB_SET) == 0) {
			my (@providing_package);
			@providing_package = split(/\t/,$v);
			# Epoch may be missing, so ...
			if ($#providing_package == 2) {
				$providing_package[3]='';
			}
			$providing_package[0] = $coder->string($providing_package[0]);
			$providing_package[1] = $coder->string($providing_package[1]);
			$providing_package[2] = $coder->string($providing_package[2]);
			$providing_package[3] = $coder->string($providing_package[3]);
			$pkglist[0] = \@providing_package; 

			while ($cursor->c_get($k, $v, DB_NEXT_DUP) == 0) {
				my (@providing_package);
				@providing_package = split(/\t/,$v);
				$providing_package[0] = $coder->string($providing_package[0]);
				$providing_package[1] = $coder->string($providing_package[1]);
				$providing_package[2] = $coder->string($providing_package[2]);
				$providing_package[3] = $coder->string($providing_package[3]);
				$pkglist[$pkgcounter] = \@providing_package;
				$pkgcounter = $pkgcounter + 1;
			}

		}
	}

	undef $db;
	return \%response_hash;
}

# "servers.list" returns a list of servers available for the client to use
# Input : systemid
# Output : an array of hashes, a sample below  
#	{'server'=>'xmlrpc.rhn.redhat.com','description'=>'XML-RPC Server',
#	'handler'=>'/XMLRPC','location'=>'United States'}
# I return an empty array, since in this case the client will be given a joice
# between the current server he is using, and redhat's server (as in sample).

sub servers_list {
	my (@servers);

	return \@servers;
}

sub errata_getPackageErratum {
	my (@errata);

	return \@errata;
}

sub errata_GetByPackage {
	my (@errata);

	return \@errata;
}

sub update_transactions {
	return 0;
}
