mirror of https://github.com/BOINC/boinc.git
555 lines
12 KiB
Perl
555 lines
12 KiB
Perl
|
#!/usr/bin/perl
|
|||
|
|
|
|||
|
|
=head1 COPYRIGHT
|
|||
|
|
|
|||
|
|
This file is part of RemoteBOINC.
|
|||
|
|
|
|||
|
|
Copyright (C) 2010 Toni Giorgino, Universitat Pompeu Fabra
|
|||
|
|
|
|||
|
|
RemoteBOINC is free software; you can redistribute it and/or modify it
|
|||
|
|
under the terms of the GNU Lesser General Public License as published
|
|||
|
|
by the Free Software Foundation, either version 3 of the License, or
|
|||
|
|
(at your option) any later version.
|
|||
|
|
|
|||
|
|
RemoteBOINC 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
|
|||
|
|
Lesser General Public License for more details.
|
|||
|
|
|
|||
|
|
You should have received a copy of the GNU Lesser General Public
|
|||
|
|
License along with BOINC. If not, see <http://www.gnu.org/licenses/>.
|
|||
|
|
|
|||
|
|
=cut
|
|||
|
|
|
|||
|
|
|
|||
|
|
# $Id: boinc_submit.pl 356 2010-03-02 15:00:31Z toni $
|
|||
|
|
|
|||
|
|
use strict;
|
|||
|
|
|
|||
|
|
|
|||
|
|
use FindBin qw($Bin); # where was script installed?
|
|||
|
|
use lib $FindBin::Bin; # use that dir for libs, too
|
|||
|
|
use lib "$Bin/lib/$]";
|
|||
|
|
use Error qw(:try);
|
|||
|
|
|
|||
|
|
use Getopt::Long qw(:config ignore_case pass_through);
|
|||
|
|
use XML::Simple;
|
|||
|
|
use HTTP::Request::Common qw(POST);
|
|||
|
|
use HTTP::DAV;
|
|||
|
|
use LWP::UserAgent;
|
|||
|
|
use File::Basename;
|
|||
|
|
use File::Temp qw(tempfile);
|
|||
|
|
|
|||
|
|
require qw(boinc_lib.pl);
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
# ----------------------------------------
|
|||
|
|
|
|||
|
|
# Constants
|
|||
|
|
|
|||
|
|
use constant XMLROOT => "BoincRemote";
|
|||
|
|
|
|||
|
|
# The temporary description file
|
|||
|
|
my $description_file_xml="description_file.xml";
|
|||
|
|
my ($description_file_fh,$description_file)=
|
|||
|
|
tempfile("/tmp/description_temp.xml.XXXXX",
|
|||
|
|
UNLINK=>1);
|
|||
|
|
|
|||
|
|
|
|||
|
|
# Constant, relative to url
|
|||
|
|
my $cgi_submit="boinc_submit_server.pl";
|
|||
|
|
my $cgi_retrieve="boinc_retrieve_server.pl";
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
# Todo: replace config with longopts +
|
|||
|
|
# http://www.perl.com/pub/a/2007/07/12/options-and-configuration.html?page=2
|
|||
|
|
|
|||
|
|
my $unparsed_cli="@ARGV";
|
|||
|
|
|
|||
|
|
|
|||
|
|
# Keep these in the same order as help
|
|||
|
|
|
|||
|
|
my $url=$ENV{RBOINC_URL};
|
|||
|
|
my $app_name='meta';
|
|||
|
|
my $user=$ENV{USER};
|
|||
|
|
my $email='';
|
|||
|
|
my $authenticator='';
|
|||
|
|
|
|||
|
|
my $group='';
|
|||
|
|
my $name='';
|
|||
|
|
|
|||
|
|
my $metadata_file='';
|
|||
|
|
my $assign_user_all='';
|
|||
|
|
my $num_steps=1;
|
|||
|
|
my $priority=1;
|
|||
|
|
|
|||
|
|
my $fpops_est='';
|
|||
|
|
my $fpops_bound='';
|
|||
|
|
my $memory_bound='';
|
|||
|
|
my $target_nresults=1;
|
|||
|
|
my $balance=0;
|
|||
|
|
my $min_quorum=1;
|
|||
|
|
my $dry_run='';
|
|||
|
|
my $batch='';
|
|||
|
|
|
|||
|
|
my $help='';
|
|||
|
|
my $help_parameters='';
|
|||
|
|
our $verbose='';
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
# Do the first pass at option parsing.
|
|||
|
|
# Keep these in the same order as help
|
|||
|
|
|
|||
|
|
# This list should be as short as possible because it is validated BEFORE the server-passed list.
|
|||
|
|
# Any argument matched here will not be matched against the template-specific one.
|
|||
|
|
|
|||
|
|
GetOptions(
|
|||
|
|
'url=s' => \$url,
|
|||
|
|
'app_name=s' => \$app_name,
|
|||
|
|
'user=s' => \$user,
|
|||
|
|
'email=s' => \$email,
|
|||
|
|
'authenticator=s' => \$authenticator,
|
|||
|
|
|
|||
|
|
'help' => \$help,
|
|||
|
|
'help_parameters' => \$help_parameters,
|
|||
|
|
'verbose' => \$verbose,
|
|||
|
|
) or die "Error parsing command line";
|
|||
|
|
|
|||
|
|
|
|||
|
|
if($help) {
|
|||
|
|
printHelp();
|
|||
|
|
exit(0);
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
############
|
|||
|
|
# Option checking
|
|||
|
|
|
|||
|
|
checkMandatoryArguments(['url','app_name']) or exit 1;
|
|||
|
|
|
|||
|
|
|
|||
|
|
# Ask the server for the template and parse it
|
|||
|
|
logInfo("Getting WU template");
|
|||
|
|
my $wu_template=getWuTemplate("$url/$cgi_retrieve",$app_name);
|
|||
|
|
|
|||
|
|
logInfo("Parsing WU template");
|
|||
|
|
my $parameters=parseWuTemplate($wu_template);
|
|||
|
|
|
|||
|
|
if($help_parameters) {
|
|||
|
|
printParametersHelp($wu_template);
|
|||
|
|
exit(0);
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
# Second pass at option parsing. This is tricky. We will use a version
|
|||
|
|
# of getopts which requires two arguments:
|
|||
|
|
# a. a hash ref of ( optnameN => ref to destination )
|
|||
|
|
# b. a list of (optname1=s optname2=i ...) - note the =x part
|
|||
|
|
# To roll-back, go to SVN version 318
|
|||
|
|
|
|||
|
|
|
|||
|
|
# 1. create a hash ($parfiles) which will hold the variable options
|
|||
|
|
# and their content. It will be written through the references
|
|||
|
|
# created later
|
|||
|
|
my $parfiles={};
|
|||
|
|
|
|||
|
|
|
|||
|
|
# 2. create a hash specifying the VARIABLE options and their
|
|||
|
|
# destination, in parfiles
|
|||
|
|
my %getopt2_files_options=();
|
|||
|
|
|
|||
|
|
foreach my $opt (keys %$parameters) {
|
|||
|
|
$parfiles->{$opt}='';
|
|||
|
|
my $rr=\($parfiles->{$opt});
|
|||
|
|
$getopt2_files_options{$opt."=s"}=$rr;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
|
|||
|
|
# Now, we shall divide the options parsed at this stage in a
|
|||
|
|
# "constant" group and a "variable" one, taken from the template
|
|||
|
|
|
|||
|
|
# 3. create a hash specifying the CONSTANT options and their
|
|||
|
|
# destinations (in plain variables)
|
|||
|
|
my %getopt2_constant_options=(
|
|||
|
|
'group=s' => \$group,
|
|||
|
|
'name=s' => \$name,
|
|||
|
|
|
|||
|
|
'metadata_file=s' => \$metadata_file,
|
|||
|
|
'assign_user_all=i' => \$assign_user_all,
|
|||
|
|
'num_steps=i' => \$num_steps,
|
|||
|
|
'priority=i' => \$priority,
|
|||
|
|
|
|||
|
|
'fpops_est=f' => \$fpops_est,
|
|||
|
|
'fpops_bound=f' => \$fpops_bound,
|
|||
|
|
'memory_bound=f' => \$memory_bound,
|
|||
|
|
'target_nresults=i' => \$target_nresults,
|
|||
|
|
'balance=i' => \$balance,
|
|||
|
|
'min_quorum=i' => \$min_quorum,
|
|||
|
|
'dry_run' => \$dry_run,
|
|||
|
|
'batch=i' => \$batch,
|
|||
|
|
);
|
|||
|
|
|
|||
|
|
|
|||
|
|
# 4. merge 2+3 into "all options"
|
|||
|
|
my %getopt2_all_options=(%getopt2_files_options,%getopt2_constant_options);
|
|||
|
|
|
|||
|
|
|
|||
|
|
# 5. use "copy_fix_options" on 2+3 to generate variables required at
|
|||
|
|
# points a+b above
|
|||
|
|
my $temp_all_opts=copy_fix_options(\%getopt2_all_options);
|
|||
|
|
|
|||
|
|
|
|||
|
|
Getopt::Long::Configure("no_pass_through"); # this time strict parsing
|
|||
|
|
GetOptions($temp_all_opts, keys %getopt2_all_options) or die "Error parsing command line";
|
|||
|
|
|
|||
|
|
# End stage-2 option parsing.
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
# Mandatory ones
|
|||
|
|
checkMandatoryArguments(['name',
|
|||
|
|
'group']) or exit 1;
|
|||
|
|
|
|||
|
|
|
|||
|
|
# Now in parfiles we have the user-supplied arguments, minus the
|
|||
|
|
# missing ones, as a hash. In $parameters we have the complete
|
|||
|
|
# list. Check for missing arguments and unreadable files.
|
|||
|
|
|
|||
|
|
foreach my $o (keys %$parameters) {
|
|||
|
|
my $ov=$parfiles->{$o};
|
|||
|
|
if($ov) {
|
|||
|
|
logInfo("Option -$o has value $ov");
|
|||
|
|
if(! -r $ov) {
|
|||
|
|
die "Can't open file $ov";
|
|||
|
|
}
|
|||
|
|
} else {
|
|||
|
|
logInfo("Option -$o is empty");
|
|||
|
|
if($parameters->{$o}->{optional}) {
|
|||
|
|
logInfo("...which is allowed, server will supply a default");
|
|||
|
|
} else {
|
|||
|
|
print STDERR "Mandatory file for parameter -$o is missing.\n";
|
|||
|
|
exit 1;
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
############
|
|||
|
|
# Build up list of files to upload. Currently this is
|
|||
|
|
# "$description_file.xml", created above, plus those referenced by the
|
|||
|
|
# keys of the %parameters hash.
|
|||
|
|
|
|||
|
|
# Keys is the remote file, value the local one.
|
|||
|
|
# We already have this list.
|
|||
|
|
|
|||
|
|
my %toupload=%$parfiles;
|
|||
|
|
|
|||
|
|
$toupload{$description_file_xml}=$description_file;
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
############
|
|||
|
|
# Make a random number as an upload id
|
|||
|
|
my $rid=sprintf('up%06d',int(rand(999999)));
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
############
|
|||
|
|
# Build the description list
|
|||
|
|
|
|||
|
|
my $oh={};
|
|||
|
|
|
|||
|
|
$oh->{RandomId}=$rid;
|
|||
|
|
$oh->{UnparsedCommandLine}={content => $unparsed_cli};
|
|||
|
|
$oh->{UploadedFiles}={file => [values %toupload] };
|
|||
|
|
$oh->{TimeStamp}={Unix => time,
|
|||
|
|
String => scalar localtime};
|
|||
|
|
$oh->{ClientRevision}='$Revision: 356 $';
|
|||
|
|
$oh->{LoginName}=$user;
|
|||
|
|
|
|||
|
|
$oh->{Email}=$email;
|
|||
|
|
$oh->{Group}=$group;
|
|||
|
|
$oh->{Name}=$name;
|
|||
|
|
|
|||
|
|
$oh->{Template}=$app_name;
|
|||
|
|
$oh->{AssignUserAll}=$assign_user_all;
|
|||
|
|
$oh->{NumSteps}=$num_steps;
|
|||
|
|
$oh->{Priority}=$priority;
|
|||
|
|
$oh->{FPopsEst}=$fpops_est;
|
|||
|
|
$oh->{FPopsBound}=$fpops_bound;
|
|||
|
|
$oh->{MemoryBound}=$memory_bound;
|
|||
|
|
|
|||
|
|
$oh->{TargetNResults}=$target_nresults;
|
|||
|
|
$oh->{Balance}=$balance;
|
|||
|
|
$oh->{MinQuorum}=$min_quorum;
|
|||
|
|
$oh->{Batch}=$batch;
|
|||
|
|
|
|||
|
|
$oh->{DryRun}=$dry_run;
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
my $desc= XMLout($oh, RootName => XMLROOT, AttrIndent => 1 );
|
|||
|
|
print $description_file_fh $desc;
|
|||
|
|
close $description_file_fh;
|
|||
|
|
|
|||
|
|
logInfo("Description file:\n$desc\n",1);
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
##############
|
|||
|
|
# Make the DAV connection
|
|||
|
|
|
|||
|
|
logInfo("Requesting the DAV address");
|
|||
|
|
my $dav_url=getDavUrl("$url/$cgi_retrieve");
|
|||
|
|
|
|||
|
|
logInfo("Connecting to DAV server");
|
|||
|
|
my $dav = new HTTP::DAV;
|
|||
|
|
# optionally: set credentials $dav->credentials
|
|||
|
|
$dav->open( -url=> $dav_url )
|
|||
|
|
or die("Couldn’t open $dav_url: " .$dav->message . "\n");
|
|||
|
|
|
|||
|
|
# optionally: lock
|
|||
|
|
|
|||
|
|
# Create a directory and cd in it
|
|||
|
|
$dav->mkcol($rid);
|
|||
|
|
$dav->cwd($rid);
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
############
|
|||
|
|
# Upload files
|
|||
|
|
|
|||
|
|
logInfo("Uploading files in dir $rid.");
|
|||
|
|
|
|||
|
|
foreach my $upfile (keys %toupload) {
|
|||
|
|
$dav->put(-local=>$toupload{$upfile},
|
|||
|
|
-url=>$upfile);
|
|||
|
|
# add error checking
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
############
|
|||
|
|
# Remove the description file - not necessary: it is handled by UNLINK and tempfile()
|
|||
|
|
|
|||
|
|
# unlink $description_file or die "Error removing temporary description file: $!";
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
############
|
|||
|
|
# Call the remote endpoint
|
|||
|
|
|
|||
|
|
logInfo("Invoking remote CGI");
|
|||
|
|
|
|||
|
|
my $ua = new LWP::UserAgent;
|
|||
|
|
my $cgi_url = "$url/$cgi_submit";
|
|||
|
|
my $response = $ua->post( $cgi_url,
|
|||
|
|
{ random_id => $rid,
|
|||
|
|
# more parameters here if needed
|
|||
|
|
});
|
|||
|
|
# error will be checked after deleting the temporary directory
|
|||
|
|
my $content = $response->content;
|
|||
|
|
logInfo("Response received:\n$content",1);
|
|||
|
|
|
|||
|
|
|
|||
|
|
############
|
|||
|
|
# Delete uploaded dir
|
|||
|
|
|
|||
|
|
logInfo("Deleting temporary DAV directory");
|
|||
|
|
|
|||
|
|
$dav->cwd("..");
|
|||
|
|
$dav->delete($rid);
|
|||
|
|
|
|||
|
|
|
|||
|
|
############
|
|||
|
|
# Die if the response was an error
|
|||
|
|
|
|||
|
|
if(! $response->is_success) {
|
|||
|
|
my $stat= $response->status_line;
|
|||
|
|
print STDERR "The remote web server returned an error: $stat\n\n";
|
|||
|
|
exit 1;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
|
|||
|
|
############
|
|||
|
|
# Parse submission status
|
|||
|
|
|
|||
|
|
my $server_xml=XMLin($content);
|
|||
|
|
|
|||
|
|
if($server_xml->{Failure}) {
|
|||
|
|
print STDERR "The server CGI returned an error. Reason: $server_xml->{Failure}->{Reason}\n";
|
|||
|
|
exit 1;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
############
|
|||
|
|
# Print submission status
|
|||
|
|
|
|||
|
|
my $server_id=$server_xml->{Identifier};
|
|||
|
|
my $server_exitcode=$server_xml->{Return}->{ExitCode};
|
|||
|
|
my $server_stdout=$server_xml->{Return}->{StdOut};
|
|||
|
|
my $server_stderr=$server_xml->{Return}->{StdErr};
|
|||
|
|
|
|||
|
|
print <<EOF;
|
|||
|
|
|
|||
|
|
|
|||
|
|
Submission complete.
|
|||
|
|
|
|||
|
|
Stdout
|
|||
|
|
------
|
|||
|
|
$server_stdout
|
|||
|
|
|
|||
|
|
Stderr
|
|||
|
|
------
|
|||
|
|
$server_stderr
|
|||
|
|
EOF
|
|||
|
|
|
|||
|
|
if($server_exitcode) {
|
|||
|
|
print "\n\nDetailed error information follows.\n";
|
|||
|
|
print XMLout($server_xml->{Return},
|
|||
|
|
RootName => "Return",
|
|||
|
|
AttrIndent => 1 );
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
|
|||
|
|
exit $server_exitcode;
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
# ==================================================
|
|||
|
|
# Auxiliary functions
|
|||
|
|
|
|||
|
|
|
|||
|
|
# Check if the calling environment has all the given variables
|
|||
|
|
# defined. If not, print one of them. Else, return false. These are
|
|||
|
|
# passed as string in order to be able to be able to print their name.
|
|||
|
|
# Sadly, must be duplicated because otherwise does not have access to
|
|||
|
|
# scope.
|
|||
|
|
|
|||
|
|
sub checkMandatoryArguments {
|
|||
|
|
my $l=shift;
|
|||
|
|
foreach my $f (@$l) {
|
|||
|
|
if(! eval("defined \$$f")) {
|
|||
|
|
print STDERR "Missing mandatory argument: $f. See -help.\n";
|
|||
|
|
return 0;
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
return 1;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
# do this: { a=s => x } --> { a => x }
|
|||
|
|
|
|||
|
|
sub copy_fix_options {
|
|||
|
|
my $q=shift;
|
|||
|
|
my $r={};
|
|||
|
|
foreach my $k (keys %$q) {
|
|||
|
|
my ($oname,$otype)=split(/=/,$k);
|
|||
|
|
$r->{$oname}=$q->{$k};
|
|||
|
|
}
|
|||
|
|
return $r;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
sub printParametersHelp {
|
|||
|
|
my $t=shift;
|
|||
|
|
|
|||
|
|
my $p=parseWuTemplate($t);
|
|||
|
|
|
|||
|
|
print "\n";
|
|||
|
|
print "Remote application queue `$app_name'\n";
|
|||
|
|
print "Description: $t->{WuTemplate}->{rboinc}->{description}\n";
|
|||
|
|
print "Application on server: `$t->{WuTemplate}->{rboinc}->{application}'\n";
|
|||
|
|
print "\n";
|
|||
|
|
print "Options defined for this application queue:\n";
|
|||
|
|
foreach my $pn (sort keys %$p) {
|
|||
|
|
print " -$pn\t\t";
|
|||
|
|
if($p->{$pn}->{optional}) {
|
|||
|
|
print "(optional) ";
|
|||
|
|
}
|
|||
|
|
print $p->{$pn}->{description}."\t";
|
|||
|
|
print "\n";
|
|||
|
|
}
|
|||
|
|
print "\n";
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
# ==================================================
|
|||
|
|
|
|||
|
|
|
|||
|
|
# for sending requests: http://snippets.dzone.com/posts/show/3163
|
|||
|
|
|
|||
|
|
|
|||
|
|
sub printHelp {
|
|||
|
|
print <<EOF;
|
|||
|
|
Boinc remote submission. Usage: boinc_submit [OPTION]...
|
|||
|
|
|
|||
|
|
** SEE -help_parameters FOR SIMULATION PARAMETERS **
|
|||
|
|
|
|||
|
|
Authentication:
|
|||
|
|
-url URL RBoinc URL contact point (*)
|
|||
|
|
-app_name APP Remote application [$app_name]
|
|||
|
|
-user NAME Override username [$user]
|
|||
|
|
-email ADDRESS (Not implemented)
|
|||
|
|
-authenticator ID (Not implemented)
|
|||
|
|
|
|||
|
|
Simulation identifier (mandatory):
|
|||
|
|
-group ID The simulation group
|
|||
|
|
-name ID The individual job ID
|
|||
|
|
|
|||
|
|
Scheduling:
|
|||
|
|
-metadata_file FILE Additional metadata file
|
|||
|
|
-assign_user_all ID Assign to user [$assign_user_all]
|
|||
|
|
-num_steps NUM Number of steps to run [$num_steps]
|
|||
|
|
-priority NUM BOINC priority level [$priority]
|
|||
|
|
|
|||
|
|
Resources:
|
|||
|
|
-fpops_est FLOAT Estimated FP count [$fpops_est]
|
|||
|
|
-fpops_bound FLOAT Max FP count [$fpops_bound]
|
|||
|
|
-memory_bound FLOAT Memory requirement [$memory_bound]
|
|||
|
|
-target_nresults NUM Redundancy [$target_nresults]
|
|||
|
|
-balance ID Load balancing alg. (on=1)
|
|||
|
|
-min_quorum NUM (Not implemented)
|
|||
|
|
-dry_run Upload, but not start WUs
|
|||
|
|
-batch NUM Batch number [$batch]
|
|||
|
|
|
|||
|
|
Miscellaneous:
|
|||
|
|
-help_parameters Show list of parameters, ie files to be
|
|||
|
|
transferred (depending on the application)
|
|||
|
|
-help This message
|
|||
|
|
-verbose Be verbose
|
|||
|
|
|
|||
|
|
(*) You can also use the RBOINC_URL environment variable.
|
|||
|
|
For example: http://www.ps3grid.net:8383/rboinc_cgi
|
|||
|
|
|
|||
|
|
EOF
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|