[LOSTWAGES] cgi script for controlling winrash clients

[Brian Vincent]

This script will eventually be used to distribute cross-compiled tests 
to PC's running Chris Morgan's winrash service.  

It serves two purposes:
 1) When cross-compiled tests have been built and are available, the
    build script will hit this cgi script to inform WineHQ that new
    builts are available.  The syntax for that is:
	?publish=winetest&url=[ url where builds live ]&cookie=[ md5sum ]

 2) Winrash clients also hit the script and using a small command set
    we tell them to do one of three things:
	- download a new set of tests
        - tell them no new builds are available, but give them an
          expected time to wait 
	- tell them their winrash service is out of date and needs to
          be updated (and we send commands to automatically do it) 
    The syntax sent by the winrash clients is:
	?servicekey=1&winetestkey=[ md5sum ]

Newman - here's a short to-do list for setting this up:

1) Install the Perl module Date::Calc (sorry, couldn't think of a way
   to avoid using it that preserved my sanity.)

2) Define the three paths for files we create.  Preferably keep these
   somewhere not accessible via the web.  Actually creating the files
   can be done later.

3) I like the idea of calling this service.cgi.  

This isn't too usable now, some stuff is hardcoded that needn't be.  

Paul Millar is working on hosting cross-compiled winetest builds (thanks
Paul!)  
  

-brian 


 
#!/usr/bin/perl

use Date::Calc qw(Delta_DHMS);

$hour_we_do_build = "2";        	# hour, such as 2 or 17, in localtime
$path_buildurl="./build.url";
$path_winetestkey="./winetest.key";
$path_servicekey="./service.key";

%data_received = &User_Data();
&read_keys();

if ($data_received{"publish"} eq "winetest") {
    &save_new_key;      
    exit;
}

if ($data_received{"servicekey"} ne $newservicekey) {
    &send_service_upgrade;	
    exit;
}

if ($data_received{"winetestkey"} eq $newwinetestkey) { 
    &send_wait;		
    exit;
}
else {
    &send_winetest_upgrade;
    exit;
}

# We should never execute this.. but if some parameter was wrong it would
# happen.  This way we return some useful info for debugging.. assuming 
# there's a way to catch it.

print "Content-type: text/html\n\n";
print "<h3>Fell through to here.  That shouldn't have happened.. </h3>\n";
print "<h3>So let's examine the keys:</h3>\n";

foreach $command (sort keys(%data_received)) {
    $command_string .= "<p>$command is ";
    foreach (split(" : ", $data_received{$command})) {
	$command_string .= "$_</p>";
    }
}
print "$command_string\n";

##########################################################################
#
# When Paul finishes compiling winetests he sends us some info we need
# to remember.  Clients use this info to find out if they have an up
# to date copy of Wine tests.
#
##########################################################################

sub save_new_key {

    # the md5sum Paul submits should never be the same as what we have
    if  ($data_received{"cookie"} eq $newwinetestkey) {
	print "Content-type: text/plain\n\n";
   	print "UHOH\n";					  
	return;
    }

    if(length($data_received{"cookie"}) != 32) {
	die "Why isn't our MD5sum 32 characters long?\n";
    }

    if($data_received{"cookie"} =~ /[^0-9^A-Z^a-z]/) {
	die "Why do we have non-alpha characters in the MD5sum?\n";
    }

    open(WINETESTKEY_FH, "> $path_winetestkey") 
	or die "Can't open $path_winetestkey for writing.\n";
    print WINETESTKEY_FH "$data_received{\"cookie\"}";
    close(WINETESTKEY_FH);

    # do some kind of test here so we know it's Paul, for now
    # just comment out this part

    # open(BUILDURL_FH, "> $path_buildurl")
    #    or die "Can't open $path_buildurl for writing.\n";
    # print BUILDURL_FH "$data_received{\"url\"}";
    # close(BUILDURL_FH);

    print "Content-type: text/plain\n\n";
    print "OK\n";
}


##########################################################################
# 
# Process requests from winrash clients.  We can do one of 3 things.
# 1. send_service_upgrade 
# 2. send_wait 
# 3. send_winetest_upgrade
#
##########################################################################


sub send_service_upgrade {
   print "Content-type: text/plain\n\n";
   print "download winetests20031127.exe http://www.theshell.com/~vinn/winetests20031127.exe";
   print "\n";  
   print "fork winetests20031127.exe";
   print "\n";
 
   #unused commands that might apply here: exit and unzip
}

sub send_wait {
 
    $waittime = ret_random_wait();

    print "Content-type: text/plain\n\n";
    print "wait $waittime";
}

sub send_winetest_upgrade {

    $waittime = ret_random_wait();

    print "Content-type: text/plain\n\n";
    print "download winetest.zip $buildurl";
    print "\n";
    print "unzip winetest.zip";
    print "\n";
    print "run winetest.exe";
    print "\n";
    print "winetestkey $newwinetestkey";
    print "\n";
    print "wait $waittime";
}

##########################################################################
#
# Here we figure out when the next build will be ready and return a 
# wait time that is slightly randomized.   
#  
##########################################################################

sub ret_random_wait {

    # figure out what time it is right now
    ($nowyear, $nowmonth, $nowday, $nowhour, $nowmin, $nowsec)
       = (localtime)[5,4,3,2,1,0];

    # if the hour value is less than the build time, we know that at some
    # point today we'll have a build coming up
    # otherwise, we know the next build will happen tomorrow = $nowday + i1
    if($nowhour < $hour_we_do_build) {
        ($diffdays, $diffhour, $diffmin, $diffsec) =
        Delta_DHMS( $nowyear, $nowmonth, $nowday, $nowhour, $nowmin, $nowsec,
                    $nowyear, $nowmonth, $nowday, $hour_we_do_build, "0", "0");
    }
    else {
        ($diffdays, $diffhour, $diffmin, $diffsec) =
        Delta_DHMS( $nowyear, $nowmonth, $nowday, $nowhour, $nowmin, $nowsec,
                   $nowyear, $nowmonth, $nowday+1, $hour_we_do_build, "0", "0");
    }

    my $waittime = ($diffdays * 24 * 60) + ($diffhour * 60) + $diffmin;
    my $randwait = int ( rand(60));


    return $randwait;
    return $waittime + $randwait;
}


##########################################################################
#
# We just split the name/value pairs into a hash here. 
# Works for GET or POST.
#  
##########################################################################

sub User_Data {
    local (%user_data, $user_string, $name_value_pair, @name_value_pairs,
	$name, $value);

    if ($ENV{'REQUEST_METHOD'} eq "POST") {
	read(STDIN,$user_string,$ENV{'CONTENT_LENGTH'});
    } 
    else {
	$user_string = $ENV{'QUERY_STRING'};
    }

    $user_string =~ s/\+/ /g;

    @name_value_pairs = split(/&/, $user_string);

    foreach $name_value_pair (@name_value_pairs) {
	($name, $value) = split(/=/, $name_value_pair);
	$name  =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/ge;
	$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/ge;
	
	if (defined($user_data{$name})) {
	    $user_data{$name} .= " : " . $value;
        } 
	else {
	    $user_data{$name} = $value;
	}
    }
    return %user_data;
}

##########################################################################
#
# Read the key files to determine the versions of service and tests.
#
##########################################################################

sub read_keys {
    open(SERVICEKEY_FH, "< $path_servicekey") 
	or die "Can't open service key.\n";
    do { $newservicekey = <SERVICEKEY_FH> } until $. == 1;
    close(SERVICEKEY_FH);
    chomp $newservicekey;

    open(WINETESTKEY_FH, "< $path_winetestkey") 
	or die "Can't open winetest key.\n";
    do { $newwinetestkey = <WINETESTKEY_FH> } until $. == 1; 
    close(WINETESTKEY_FH);
    chomp $newwinetestkey;

    open(BUILDURL_FH, "< $path_buildurl") 
	or die "Can't open file containing URL of build: $path_buildurl.\n";
    do { $buildurl = <BUILDURL_FH> } until $. == 1; 
    close(BUILDURL_FH);
    chomp $buildurl;

}