#!/usr/bin/perl -w
#
# This is a part of the NRH-up2date package, licensed under the GPL.
#
# 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;

my $method = $ENV{'REQUEST_METHOD'};
my $type = $ENV{'CONTENT_TYPE'};
my $length = $ENV{'CONTENT_LENGTH'};

# Fetch our body
my $body;
my $count = read STDIN, $body, $length;

# Serve our request
my $coder = Frontier::RPC2->new;
my $decode = $coder->decode($body);

my $method_name = $$decode{'method_name'};
my $version = $$decode{'value'};

# Because we want to control whether we send an XML formatted body
# (as opposed to binary), we cannot use $coder->server(a,b)
if ($method_name eq 'applet.poll_status') {
    poll_status(@$version);
} elsif ($method_name eq 'applet.poll_packages') {
    poll_packages(@$version);
} else {
    http_error(400, "Bad Method")
}

# 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;
}

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

sub send_xml {
    my ($xml_string, $bool_zlib) = @_;
    my $length = length($xml_string);
    print <<"EOD";
Status: 200 OK
Content-type: text/xml
Content-length: $length
EOD
    if ($bool_zlib) {
    print <<"EOD";
Content-Transfer-Encoding: binary
Content-Encoding: x-zlib
Content-Type: application/binary
EOD
    }
    print "\n";
    # We want precise control over whitespace here.
    print $xml_string;
}

sub poll_status {

    my (%response_hash) = ();

    $response_hash{'checkin_interval'} = $coder->string(1024);
    $response_hash{'server_status'}    = $coder->string('normal');

    send_xml($coder->encode_response(\%response_hash));
    return 0;
}

sub poll_packages {

    my ($version,$arch,$date) = @_;
    my ($system_date);
    my (%response_hash) = ();

    if (!($version =~ /^[0-9\.]+$/)) {
        die ("Bad os_release parameter.\nTrapped ");
    }

    # Open the date file to determine whether there are new updates
    if (open(DATE_FILE, "/var/spool/nrh-up2date/$version/nrh-listdate")) {
      $system_date = <DATE_FILE>;
      # System is up to date...
      if ($date >= $system_date) {
        $response_hash{'use_cached_copy'} = $coder->string(1);
        close(DATE_FILE);
        send_xml($coder->encode_response(\%response_hash));
        return 0;
      }
      # System is not up to date
      else {
        if (open(LIST_OF_PKGS, "/var/spool/nrh-up2date/$version/applet-errata.$system_date.zlib")) {
	   my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks, $string);
	   ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks)=stat LIST_OF_PKGS;
           read (LIST_OF_PKGS, $string, $size);
	   send_xml($string,1);
	   return 0;
        }
        else {
           http_error(500, "Internal Server Error: Have the admin check for the file /var/spool/nrh-up2date/$version/applet-errata.$system_date.zlib");
        }
      }
    }
    # Internal Server Error... We can't open the date file (nrh-listdate)
    else {
        http_error(500, "Internal Server Error: Have the admin check for the file 'nrh-listdate'");
    }
    return 0;
}

