#!/usr/bin/perl -w
#
# file    : fci-client.pl
# changed : 2005-02-23
# author  : Bas Couwenberg <sebastic@xs4all.nl>
#

use strict;
use LWP::UserAgent;
use HTTP::Request::Common;
use File::Basename;
use Sys::Hostname;
use Getopt::Mixed "nextOption";

my %http_info;

# default configuration
my $version = '0.4.3';

my $hostname = hostname;

my %cfg = (
		self		=> 'fci-client.pl',
		version		=> $version,
		url 		=> 'http://example.com/index.pl',
		client_name	=> $hostname,
		folding_dir	=> '/home/folding',
		useragent	=> 'fci-client/'.$version,
		verbose		=> 0,
		update_qd	=> 0,
		qd_bin		=> dirname($0).'/qd',
		qdinfo_file	=> dirname($0).'/qdinfo.dat',
		username	=> '',
		password	=> '',
		ds		=> '/',
		windows		=> 0
	);

$cfg{unitinfo_file} = $cfg{folding_dir}.$cfg{ds}.'unitinfo.txt';
$cfg{config_file}   = $cfg{folding_dir}.$cfg{ds}.'client.cfg';
$cfg{xyz_file}      = $cfg{folding_dir}.$cfg{ds}.'work'.$cfg{ds}.'current.xyz';

$cfg{qd_url}	    = $cfg{url};
if($cfg{qd_url}     =~ s/index.pl$//) {}
$cfg{qd_url}	   .= 'qd-files/';

$cfg{qdinfo_file}   = dirname($0).$cfg{ds}.'qdinfo.dat';
$cfg{qd_bin}        = $cfg{windows} ? dirname($0).$cfg{ds}.'qd.exe' : dirname($0).$cfg{ds}.'qd';


# get command line parameters
Getopt::Mixed::init("url=s client=s dir=s config=s unitinfo=s xyz=s useragent=s username=s password=s verbose help update-qd qd-url=s windows");
while (my ($option, $value) = nextOption()) {
	if($option eq 'help') {
		print_usage();
		Getopt::Mixed::cleanup();
		exit;
	}	
	if($option eq 'windows') {
		$cfg{windows}       = 1;
		$cfg{ds}            = '\\';
		$cfg{qd_bin}        = dirname($0).$cfg{ds}.'qd.exe';
		$cfg{qdinfo_file}   = dirname($0).$cfg{ds}.'qdinfo.dat';
		$cfg{folding_dir}   = 'C:\\Program Files\\Folding@Home';
		
		$cfg{unitinfo_file} = $cfg{folding_dir}.$cfg{ds}.'unitinfo.txt';
		$cfg{config_file}   = $cfg{folding_dir}.$cfg{ds}.'client.cfg';
		$cfg{xyz_file}      = $cfg{folding_dir}.$cfg{ds}.'work'.$cfg{ds}.'current.xyz';
	}
	if($option eq 'dir') {
		$cfg{folding_dir}   = $value;
		$cfg{unitinfo_file} = $cfg{folding_dir}.$cfg{ds}.'unitinfo.txt';
		$cfg{config_file}   = $cfg{folding_dir}.$cfg{ds}.'client.cfg';
		$cfg{xyz_file}      = $cfg{folding_dir}.$cfg{ds}.'work'.$cfg{ds}.'current.xyz';
	}
	if($option eq 'url') {
		$cfg{url} 	    = $value;
		$cfg{qd_url}	    = $value;
		
		# strip the index.pl suffix from the url and add the qd-files directory	
		if($cfg{qd_url}     =~ s/index.pl$//) {}
		$cfg{qd_url}        = $cfg{qd_url}.'qd-files/';
	}
	
	$cfg{client_name}   = $value if($option eq 'client');
	$cfg{config_file}   = $value if($option eq 'config');
	$cfg{unitinfo_file} = $value if($option eq 'unitinfo');
	$cfg{xyz_file}      = $value if($option eq 'xyz');
	$cfg{useragent}	    = $value if($option eq 'useragent');
	$cfg{verbose} 	    = 1      if($option eq 'verbose');
	$cfg{update_qd}	    = 1      if($option eq 'update-qd');
	$cfg{qd_url}	    = $value if($option eq 'qd-url');
	$cfg{username}	    = $value if($option eq 'username');
	$cfg{password}	    = $value if($option eq 'password');
}
Getopt::Mixed::cleanup();

print basename($0)." started\n\n" if($cfg{verbose});

# check Folding@Home directory & useragent settings
if(!$cfg{useragent} || $cfg{useragent} eq '' || $cfg{useragent} =~ /^\s+$/) {
	print "Error: Invalid User-Agent! ($cfg{useragent})\n";
	exit;
}

if($cfg{update_qd}) {
	my $qd_url     = $cfg{windows} ? $cfg{qd_url}.'qd.exe' : $cfg{qd_url}.'qd';
	my $qdinfo_url = $cfg{qd_url}.'qdinfo.dat';

	my $ua  = LWP::UserAgent->new();
	   $ua->agent($cfg{useragent});

	if(valid_url($qdinfo_url) == 2) {
		if($cfg{username} eq '' || $cfg{password} eq '') {
			print "Authentication required, please supply username & password!\n";
			exit;
		}
		else {
			my $netloc   = $cfg{url};
			my $realm    = $http_info{$qdinfo_url}{realm};
			my $username = $cfg{username};
			my $password = $cfg{password};
	
			if($realm) {
				$realm =~ s/^.*?realm="(.*)"$/$1/;
		
				$netloc  =~ s/^http:\/\/(.*?)\/.*$/$1/;
				$netloc .= ':80' if($netloc !~ /:\d+$/);
				
				if($cfg{verbose}) {
					print "Using authentication credentials:\n";
					print "Netlocation: $netloc\n";
					print "Realm      : $realm\n";
					print "Username   : $cfg{username}\n";
					print "Password   : $cfg{password}\n\n";
				}
			
				$ua->credentials($netloc, $realm, $username, $password);
			}
		}
	}

	print "Fetching latest qd version from $cfg{qd_url}\n" if($cfg{verbose});

	if(valid_url($qd_url) != 0 && valid_url($qdinfo_url) != 0) {
		print "\n" if($cfg{verbose});
		
		my $error = 0;
		my $msg   = '';
		
		if(valid_url($qdinfo_url) != 0) {	
			if(my $qdinfo_data = fetch_url($qdinfo_url, $ua)) {
				if(-w $cfg{qdinfo_file} && -r $cfg{qdinfo_file}) {
					# check if version of just downloaded qdinfo.dat is newer than the one on disc
		
					my %qdinfo = parse_qdinfo($cfg{qdinfo_file});
					
					(my $qdinfo_oldversion = $qdinfo{da}) =~ s/^(\d+ \w+ \d+).*?$/$1/;
					 my $qdinfo_newversion = $qdinfo_oldversion;

					#da 17 February 2005 (rph)
					if($qdinfo_data =~ /da (\d+ \w+ \d+)/) {
						$qdinfo_newversion = $1;
					}
			
					if($cfg{verbose}) {
						print "Current qdinfo version: $qdinfo_oldversion\n";
						print "Latest  qdinfo version: $qdinfo_newversion\n\n";
					}
			
					if($qdinfo_oldversion eq $qdinfo_newversion) {
						$msg .= "You already have the latest version\n";
					}
					else {
						save_file($cfg{qdinfo_file}, $qdinfo_data);
						
						$msg .= "Successfully updated qdinfo.dat  ($qdinfo_newversion fr $qdinfo{fr})\n";

						# check if version of qdinfo.dat is newer than the version of qd already on disc
				
						#qd released 6 February 2005 (fr 028)
						my $qd_version = `"$cfg{qd_bin}" -v`;
						if($qd_version =~ s/^qd released //) {}
					
						(my $qd_fr     = $qd_version)  =~ s/^.*fr (\d+).*$/$1/;
					
						#6 February 2005 (fr 028)
						if($qd_version =~ s/^(\d+ \w+ \d+) .*?$/$1/) {}

						my $qdinfo_version  = $qdinfo_newversion;
						my $qdinfo_fr       = $qdinfo{fr};

						chomp($qd_version, $qd_fr);
				
						if($cfg{verbose}) {
							print "Current functional revision: $qd_fr\n";
							print "Latest  functional revision: $qdinfo_fr\n\n";
						}
					
						if($qd_version ne $qdinfo_version) {
							# file has been changed
							# point table is updated
								
							if($qd_fr ne $qdinfo_fr) {
								# new functional revision, 
								# qd has changed more than just including the latest point table
								
								my $qd_url= $cfg{qd_url}.'qd';
								if($cfg{windows} == 1) {
									$qd_url .= '.exe';
								}
								
								if(valid_url($qd_url) != 0) {
									if(my $qd_data = fetch_url($qd_url, $ua)) {
										if(!-e $cfg{qd_bin} || -w $cfg{qd_bin}) {
											save_file($cfg{qd_bin}, $qd_data, 1);
										}
										else {
											$error = 1;
											$msg  .= "Cannot write file! ($cfg{qd_bin})\n";
										}
									}
									else {
										$error = 1;
										$msg  .= "Failed to fetch URL! ($qd_url)\n";
									}
								}
								else {
									$error = 1;
									$msg  .= "Invalid URL or HTTP error! ($qd_url)\n";
								}
									
								(my $qd_version = `"$cfg{qd_bin}" -v`) =~ s/^qd released //;
								    $qd_version =~ s/(\(|\))//g;
								chomp($qd_version);
			
								$msg .= "Successfully updated qd application ($qd_version)\n";
							}
							else {
								$msg .= "You already have the latest functional revision of qd and qd.exe\n";
							}
						}
					}
				}
				else {
					$error = 1;
					if(!-w $cfg{qdinfo_file}) {
						$msg  .= "Cannot write file! ($cfg{qdinfo_file})\n";
					}
					if(!-r $cfg{qdinfo_file}) {
						$msg  .= "Cannot read file! ($cfg{qdinfo_file})\n";
					}
				}
			}
			else {
				$error = 1;
				$msg  .= "Failed to fetch URL! ($qdinfo_url)\n";
			}
		}
		else {
			$error = 1;
			$msg  .= "Invalid URL or HTTP error! ($qdinfo_url)\n";
		}

		if($error) {
			print "One or more error were encounterd:\n$msg\n";
		}
		else {
			if($cfg{verbose}) {
				print "$msg\n";
			}
		}
	}
	elsif(valid_url($qd_url) != 0) {
		print "Error: Invalid URL or HTTP error! ($qdinfo_url)\n";
	}
	else {
		print "Error: Invalid URL or HTTP error! ($qd_url)\n";
	}

	exit;
}

my $url_return = valid_url($cfg{url});

# check file existance & other parameters
if(!-r $cfg{folding_dir}) {
	print "Error: Cannot read Folding\@Home client directory! ($cfg{folding_dir})\n";
	exit;
}
elsif(!-r $cfg{config_file}) {
	print "Error: Cannot read client configuration file! ($cfg{config_file})\n";
	exit;
}
elsif(!-r $cfg{unitinfo_file}) {
	print "Error: Cannot read unitinfo file!\n";
	exit;
}
elsif(!-r $cfg{xyz_file}) {
	print "Error: Cannot read xyz file!\n";
	exit;
}
elsif(!$cfg{client_name} || $cfg{client_name} eq '' || $cfg{client_name} =~ /^\s+$/) {
	print "Error: Invalid client name! ($cfg{client_name})\n";
	exit;
}
elsif($cfg{url} !~ /^http:\/\// || $url_return == 0) {
	print "Error: Invalid URL or HTTP error! ($cfg{url})\n";
	exit;
}

my $ua  = LWP::UserAgent->new();
   $ua->agent($cfg{useragent});

# set authentication credentials if http auth is required: valid_url() returns 2
if($url_return == 2) {
	if($cfg{username} eq '' || $cfg{password} eq '') {
		print "Authentication required, please supply username & password!\n";
		exit;
	}
	else {
		my $netloc   = $cfg{url};
		my $realm    = $http_info{$cfg{url}}{realm};
		my $username = $cfg{username};
		my $password = $cfg{password};
	
		if($realm) {
			$realm =~ s/^.*?realm="(.*)"$/$1/;
	
			$netloc  =~ s/^http:\/\/(.*?)\/.*$/$1/;
			$netloc .= ':80' if($netloc !~ /:\d+$/);
			
			if($cfg{verbose}) {
				print "Using authentication credentials:\n";
				print "Netlocation: $netloc\n";
				print "Realm      : $realm\n";
				print "Username   : $cfg{username}\n";
				print "Password   : $cfg{password}\n\n";
			}
			
			$ua->credentials($netloc, $realm, $username, $password);
		}
	}
}

# print configuration if verbose output is requested
print "Invocing `$cfg{qd_bin}` to parse queue.dat file: \"$cfg{qd_bin}\"-f \"$cfg{folding_dir}\" -n \"$cfg{qdinfo_file}\"\n\n" if($cfg{verbose});
my $qd_output = `"$cfg{qd_bin}" -f "$cfg{folding_dir}" -n "$cfg{qdinfo_file}"`;

if($cfg{verbose}) {
	print "Going to submit the following data to $cfg{url}:\n";
	print "client name    : $cfg{client_name}\n";
	print "config file    : $cfg{config_file}\n";
	print "unitinfo file  : $cfg{unitinfo_file}\n";
	print "xyz file       : $cfg{xyz_file}";
	print "qd data        :\n<!-- start qd data -->\n$qd_output\n<!-- end qd data -->\n";
	print "\n";
}

# post file data to the server
my $req = POST $cfg{url},
	  Content_Type => 'form-data',
	  Content      => [
		  	   submit        => 1,
			   action        => 'upload',
			   client_name   => $cfg{client_name},
			   qd_output	 => $qd_output,
			   unitinfo_file => [ $cfg{unitinfo_file} ],
			   config_file   => [ $cfg{config_file} ],
			   xyz_file	 => [ $cfg{xyz_file} ],
			   username	 => $cfg{username},
			   password	 => $cfg{password}
			  ];

my $res = $ua->request($req);

if ($res->is_success()) {
	if($cfg{verbose} == 1) {
		print "Successfully posted data to the server.\n";
		print $res->content."\n";
	}
} 
else {
	print "Error uploading unitinfo file ($cfg{unitinfo_file}), config file ($cfg{config_file}) ";
	print "to url ($cfg{url}) for client ($cfg{client_name}) with useragent ($cfg{useragent})!\n\n";
	print "Server Response\n";
	print "---------------\n";
	print "HTTP Status: ".$res->code.' '.$res->message."\n";
}

################[ Subroutines ]################

sub parse_qdinfo {
	my $file = $_[0];
	
	my %info;
	if(-r $file) {
		open(F, $file) || die "Cannot open file ($!)";
		while(<F>) {
			chomp;
			
			if(s/\r//) {}

			#fr 028
			if(/^(fr) (\d+)/) {
				$info{$1} = $2;
			}
			
			#da 17 February 2005 (rph)
			if(/^(da) (\d+ \w+ \d+ \(.*?\))/) {
				$info{$1} = $2;
			}

			#pg 09A7B4F9
			if(/^(pg) (\w+)/) {
				$info{$1} = $2;
			}

			#pt  101  7400   111   500   112   500   113   500   114   500
			#
			#not parsed at the moment
			
			#ph 1109  1100 0817020C
			#ph 1110 12800 0818619C  1110  7090 0818538C
			#ph 1113  2400 0881DEC4  1113 24000 087D79C4  1113 20000 08784FE4
			#
			#not parsed at the moment
		}
		close F;
	}

	return %info;
}

sub save_file {
	my $filename = $_[0];
	my $content  = $_[1];
	my $binary   = $_[2] ? $_[2] : 0;
	
	print "Saving to disc: $filename\n" if($cfg{verbose});
	if(!-e $filename || -w $filename) {
		open(F, "> $filename") || die "Cannot open file ($!)";
		binmode(F) if($binary && $cfg{windows}); # set to binary mode, needed for windows
		print F $content;
		close F;
		
		return 1;
	}
	else {
		print "Error: Cannot write file! ($filename)\n";
		
		return undef;
	}
}

sub fetch_url {
	my $url = $_[0];
	my $ua  = $_[1];
	
	my $req = HTTP::Request->new(GET => $url);
	
	print "Retrieving url: $url ... " if($cfg{verbose});
	my $res = $ua->request($req);
	if($res->is_success) {
		print "Success\n" if($cfg{verbose});
		
		return $res->content;
	}
	else {
		print "Failed!\n" if($cfg{verbose});
		print "Error: Failed to retrieve url! ($url)\n";
			
		return undef;
	}
}
																	
sub valid_url {
	my $url = $_[0];

	my $ua  = LWP::UserAgent->new();
	   $ua->agent($cfg{useragent});
	
	my $req = HTTP::Request->new(HEAD => $url);
	
	my $res = $ua->request($req);
	if($res->is_success()) {
		return 1;
	}
	else {
		if($res->code == 401) {
			$http_info{$url}{realm}  = $res->header('WWW-Authenticate');
			$http_info{$url}{status} = $res->code;

			return 2;
		}
		else {
			return 0;
		}
	}
}

sub print_usage {
	my $verbose    = $cfg{verbose}   ? 'on' : 'off';
	my $update_qd  = $cfg{update_qd} ? 'on' : 'off';
	my $windows    = $cfg{windows}   ? 'true' : 'false';
	chomp(my $qd_version = `"$cfg{qd_bin}" -v`);
	
	print "$cfg{self} v$cfg{version}\n";
	print "with qd [$qd_version] by Dick Howell <rph\@boston.quik.com>\n";
	print "\n";
	print "Usage: ".basename($0)." [OPTIONS]\n\n";
	print "Options:\n";
	print "--url <url>         URL to POST the data to         (default: $cfg{url})\n";
	print "--client <name>     Client name                     (default: $cfg{client_name})\n";
	print "--dir <directory>   Folding\@Home client directory   (default: $cfg{folding_dir})\n";
	print "--config <file>     Path to the client.cfg file     (default: $cfg{config_file})\n";
	print "--unitinfo <file>   Path to the unitinfo.txt file   (default: $cfg{unitinfo_file})\n";
	print "--useragent <name>  User-Agent string               (default: $cfg{useragent})\n";
	print "--username <string> Server authentication username  (default: $cfg{username})\n";
	print "--password <string> Server authentication password  (default: $cfg{password})\n";
	print "--windows           Set Operating System to Windows (default: $windows)\n";
	print "--verbose           Verbose (debug) output          (default: $verbose)\n";
	print "--help              Print this information\n";
	print "\n";
	print "Options for qd:\n";
	print "--update-qd         Download the latest qd version (default: $update_qd)\n";
	print "--qd-url <url>      URL to qd and qdinfo.dat       (default: $cfg{qd_url})\n";
}