mirror of https://github.com/BOINC/boinc.git
added -intotree option
automatic renaming of downloaded results svn path=/trunk/boinc/; revision=23081
This commit is contained in:
Toni Giorgino
parent
0731e726b1
commit
412395a8c9
|
|
@ -22,7 +22,7 @@ License along with BOINC. If not, see <http://www.gnu.org/licenses/>.
|
|||
=cut
|
||||
|
||||
|
||||
# $Id: boinc_lib.pl 356 2010-03-02 15:00:31Z toni $
|
||||
# $Id: boinc_lib.pl 735 2011-02-22 19:16:59Z toni $
|
||||
|
||||
use XML::Simple;
|
||||
use LWP::UserAgent;
|
||||
|
|
@ -120,6 +120,25 @@ sub parseWuTemplate {
|
|||
|
||||
|
||||
|
||||
# Parse result name and split into components
|
||||
sub parseResultName {
|
||||
my $n=shift;
|
||||
my ($name,$user,$group,$step,$maxsteps,$rnd,$ext) = ($n=~/^(.+)-(.+)_(.+)-(.+)-(.+)-(.+)_(.+)$/);
|
||||
my $r={
|
||||
name => $name,
|
||||
user => $user,
|
||||
group => $group,
|
||||
step => $step,
|
||||
maxsteps => $maxsteps,
|
||||
rnd => $rnd,
|
||||
ext => $ext
|
||||
};
|
||||
return $r;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
# Check if the given files (as list) are all readable.
|
||||
|
|
|
|||
|
|
@ -22,7 +22,7 @@ License along with BOINC. If not, see <http://www.gnu.org/licenses/>.
|
|||
=cut
|
||||
|
||||
|
||||
# $Id: boinc_retrieve.pl 356 2010-03-02 15:00:31Z toni $
|
||||
# $Id: boinc_retrieve.pl 735 2011-02-22 19:16:59Z toni $
|
||||
|
||||
use strict;
|
||||
|
||||
|
|
@ -37,6 +37,7 @@ use HTTP::Request::Common qw(POST);
|
|||
use HTTP::DAV;
|
||||
use LWP::UserAgent;
|
||||
use File::Basename;
|
||||
use File::Spec;
|
||||
use Pod::Usage;
|
||||
use Error qw(:try);
|
||||
|
||||
|
|
@ -58,6 +59,7 @@ my $group='';
|
|||
|
||||
my $name='';
|
||||
my $into='',
|
||||
my $intotree='',
|
||||
our $verbose='';
|
||||
my $quiet='';
|
||||
my $keep='';
|
||||
|
|
@ -79,6 +81,7 @@ GetOptions(
|
|||
|
||||
'name=s' => \$name,
|
||||
'into=s' => \$into,
|
||||
'intotree=s' => \$intotree,
|
||||
'verbose' => \$verbose,
|
||||
'quiet' => \$quiet,
|
||||
'keep' => \$keep,
|
||||
|
|
@ -105,6 +108,9 @@ pod2usage(1) if $help;
|
|||
checkMandatoryArguments(["group","url"]) or exit 1;
|
||||
my $cgi_url = "$url/$cgi_retrieve";
|
||||
|
||||
if($intotree) {
|
||||
$into=$intotree;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
|
@ -235,6 +241,8 @@ sub handleGridStatus {
|
|||
########################################
|
||||
# Handle retrieve action
|
||||
|
||||
# TODO -intotree, rename
|
||||
|
||||
|
||||
sub handleRetrieve {
|
||||
|
||||
|
|
@ -276,24 +284,32 @@ sub handleRetrieve {
|
|||
logInfo("Connecting to DAV server");
|
||||
my $dav = new HTTP::DAV;
|
||||
$dav->open( -url=> $dav_url )
|
||||
or die("Couldn’t open $dav_url: " .$dav->message . "\n");
|
||||
or die("Couldn't open $dav_url: " .$dav->message . "\n");
|
||||
$dav->cwd($dav_dir)
|
||||
or die("Couldn’t set remote directory $dav_dir: " .$dav->message . "\n");
|
||||
or die("Couldn't set remote directory $dav_dir: " .$dav->message . "\n");
|
||||
|
||||
my $ndone=0;
|
||||
my $nskip=0;
|
||||
my @skiplist=();
|
||||
my $nexpected=scalar @$rfilelist;
|
||||
foreach my $fn (@$rfilelist) {
|
||||
if( fileOrAliasExists($fn,$aliasTable) ) {
|
||||
my $targetfn=$fn;
|
||||
if($intotree) {
|
||||
my $tmp=parseResultName($fn);
|
||||
my $name=$tmp->{name};
|
||||
mkdir $name; # may well fail if dir exists
|
||||
$targetfn=File::Spec->catfile($name,$fn); # OS indepen
|
||||
}
|
||||
if( fileOrAliasExists($targetfn,$aliasTable) ) {
|
||||
if(!$quiet && $nskip==0) {
|
||||
print "Warning: some files are present locally and will not be overwritten.\n";
|
||||
}
|
||||
$nskip++;
|
||||
push @skiplist,$fn;
|
||||
} else {
|
||||
$targetfn = $targetfn . aliasExtension($fn,$aliasTable);
|
||||
$dav->get(-url => $fn,
|
||||
-to => ".") and
|
||||
-to => $targetfn) and
|
||||
$ndone++;
|
||||
}
|
||||
if(!$quiet) {
|
||||
|
|
@ -329,13 +345,10 @@ sub handleRetrieve {
|
|||
my $mess=$ex->text();
|
||||
print STDERR "Error requesting removal of remote files: $mess; continuing.\n";
|
||||
}
|
||||
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
# ----------------
|
||||
# Finalize
|
||||
|
||||
|
|
@ -350,6 +363,34 @@ sub handleRetrieve {
|
|||
|
||||
|
||||
|
||||
# Return the first extension defined in the alias table
|
||||
|
||||
sub aliasExtension {
|
||||
my $fn=shift;
|
||||
my $at=shift;
|
||||
|
||||
# Extract trailing number
|
||||
$fn=~/_([0-9]+)$/;
|
||||
my $fileExt=$1;
|
||||
|
||||
my $newExt="";
|
||||
|
||||
# iterate over the alias list
|
||||
my $rAliasList=$at->{File};
|
||||
foreach my $curAlias ( @$rAliasList ) {
|
||||
if($curAlias->{Extension} eq "_$fileExt") {
|
||||
# if alias for current extension, return first Alias
|
||||
$newExt=$curAlias->{Alias}->[0];
|
||||
logInfo("Found suffix $fileExt -> $newExt");
|
||||
last;
|
||||
}
|
||||
}
|
||||
return $newExt;
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
# Check if file exists in current directory (1st arg), checking both
|
||||
# the literal file name and its aliases, appending extensions
|
||||
|
|
@ -507,6 +548,7 @@ boinc_retrieve [options]
|
|||
|
||||
-name NAME Retrieve only a specific job and its metadata
|
||||
-into DIR Put files into specified directory (default ".")
|
||||
-intotree DIR Put files into specified directory, with NAMEs in subdirs
|
||||
-verbose Be verbose
|
||||
-quiet Hide download progress indicator
|
||||
-keep Do not remove retrieved files from server
|
||||
|
|
|
|||
|
|
@ -1,284 +0,0 @@
|
|||
$Id: NOTE 192 2009-04-20 16:07:25Z toni $
|
||||
|
||||
|
||||
----------------------------------------
|
||||
|
||||
|
||||
* The unity for a submission is the Job.
|
||||
** A Job has a set of input files
|
||||
which are associated to it as soon as it is created.
|
||||
** Jobs are created by "submit" operations.
|
||||
** A job has a user-decided JOBID, which is required for retrieval.
|
||||
*** The user-decided JOBID can also be left empty,
|
||||
in which case a random one will be generated
|
||||
** A job may have ore or more TAGs, which are used to facilitate retrieval
|
||||
** Current step, maximum step
|
||||
** Owner (user name)
|
||||
** Current safety level
|
||||
** URL (or project)
|
||||
|
||||
|
||||
|
||||
* Files are cached in a pool to avoid duplicate uploads
|
||||
|
||||
* Files are cached in a pool to avoid duplicate storage
|
||||
** cache is in <WR>/pool
|
||||
|
||||
* Retrieve operations fetch a given ID or all those with a given TAG
|
||||
|
||||
* Workflow files are kept in <WR>/userid_jobid
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
----------------------------------------
|
||||
|
||||
RBOINC_TRASH_DIR=/home/boinc/projects/LUNA/workflow_results/rboinc_trash_dir
|
||||
0 * * * * find $RBOINC_TRASH_DIR -depth -not -type d -mtime +2 -print
|
||||
0 * * * * find $RBOINC_TRASH_DIR -depth -not -type d -mtime +2 -delete
|
||||
0 * * * * find $RBOINC_TRASH_DIR -depth -mindepth 1 -type d -empty -delete
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
----------------------------------------
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
SUBMIT
|
||||
|
||||
* die if files !xsist OK
|
||||
* die if !authenticator OK
|
||||
* make description xml OK
|
||||
* make random upload_id OK
|
||||
* create 0 index, if not given OK
|
||||
* up to dav OK
|
||||
* call rpc, send random id OK
|
||||
|
||||
(Better? first authenticate, get rid from server.
|
||||
Alternatively: use webdav authentication based on server tables)
|
||||
|
||||
|
||||
* rpc callee
|
||||
- args: random_id
|
||||
url
|
||||
auth
|
||||
- authenticate (-)
|
||||
- if OK
|
||||
- build work_id=name/dir in wft
|
||||
- cp/mv to wfr
|
||||
- create_work
|
||||
- return work_id
|
||||
- if NOTOK
|
||||
- remove dav dir (not)
|
||||
- return error code
|
||||
|
||||
|
||||
* get result id
|
||||
* if error: remove dav upload_id
|
||||
* print result
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
* dav area
|
||||
Enable mod_dav, mod_dav_fs. On debian: use a2enmod
|
||||
Need a DAV area $DAV_AREA
|
||||
Make an user for uploading and an user file OUTSIDE of the DAV area
|
||||
A good solution: put them in PROJECT_DIR
|
||||
|
||||
The dav area will be good for downloading (via symlinks), as well.
|
||||
No indexes will be shown.
|
||||
|
||||
|
||||
|
||||
* wfr area
|
||||
- */user/job
|
||||
|
||||
Remember that it must be writable by the user which executes
|
||||
apache (on debian: www-data)
|
||||
|
||||
|
||||
|
||||
|
||||
----------------------------------------
|
||||
|
||||
|
||||
|
||||
RETRIEVE
|
||||
|
||||
|
||||
|
||||
* call rpc
|
||||
|
||||
* callee:
|
||||
- authenticate user with boinc
|
||||
- generate a random identifier
|
||||
- create dir in DAV
|
||||
- make symlinks from a download area to the wfr
|
||||
all non-recent result files can be symlinked
|
||||
- return id as xml
|
||||
|
||||
* cd to the DAV/code dir
|
||||
- retrieve stuff
|
||||
- optionally delete them
|
||||
|
||||
Note that symlinks in the DAV directory are not visible when listed.
|
||||
|
||||
|
||||
|
||||
|
||||
----------------------------------------
|
||||
|
||||
Cpan: add modules on boinc@grosso
|
||||
|
||||
export PERL5LIB=/home/boinc/toni/perl/lib/
|
||||
perl -MCPAN -eshell
|
||||
o conf makepl_arg "LIB=~/toni/perl/lib PREFIX=~/toni/perl"
|
||||
|
||||
DEPLOY:
|
||||
copy perl modules from boinc to ps3grid
|
||||
|
||||
|
||||
|
||||
|
||||
----------------------------------------
|
||||
|
||||
SECURITY TODO
|
||||
|
||||
* Add boinc authentication to S/R
|
||||
* Retrieve: check for user "owning" the directory
|
||||
* Restrict TCL command set
|
||||
* Restrict parameters:
|
||||
- Priority
|
||||
- N. of runs
|
||||
- ...
|
||||
* Possibly, add digest authentication to DAV (pre-shared secret, not great).
|
||||
* Refuse odd chars in tag name OK
|
||||
* get DAV from authentication step
|
||||
|
||||
|
||||
TODO
|
||||
|
||||
* Remove getopt::simple
|
||||
* Refactor server OK
|
||||
* stop/resume
|
||||
* status/status all
|
||||
|
||||
|
||||
|
||||
----------------------------------------
|
||||
|
||||
# Figure out the current step with respect to the others
|
||||
|
||||
|
||||
pushd $GROUP_DIR
|
||||
shopt -s nullglob
|
||||
|
||||
namelist=`ls -1 *_0 | cut -f1 -d- | sort | uniq`
|
||||
catchup=0
|
||||
|
||||
if [[ -n $namelist ]]; then
|
||||
maxlist=""
|
||||
for i in $namelist; do
|
||||
maxstepi=`ls -1 $i-*_0 | cut -f3 -d- |sort -n|tail -1`
|
||||
maxlist="$maxlist $maxstepi"
|
||||
done
|
||||
|
||||
# use perl to decide
|
||||
threshold=`perl -e '
|
||||
@l=reverse sort {$a<=>$b} @ARGV;
|
||||
print $l[0]-2;
|
||||
' $maxlist`
|
||||
|
||||
if (( $NEW_STEP < $threshold )); then
|
||||
echo "I should run in catchup mode, thr $threshold"
|
||||
catchup=1
|
||||
fi
|
||||
fi
|
||||
|
||||
shopt -u nullglob
|
||||
popd
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
----------------------------------------
|
||||
|
||||
|
||||
http://www.perl.com/pub/a/2002/11/14/exception.html
|
||||
|
||||
|
||||
|
||||
use Error qw(:try);
|
||||
|
||||
try {
|
||||
some code;
|
||||
code that might thrown an exception;
|
||||
more code;
|
||||
return;
|
||||
}
|
||||
catch Error with {
|
||||
my $ex = shift; # Get hold of the exception object
|
||||
handle the exception;
|
||||
}
|
||||
finally {
|
||||
cleanup code;
|
||||
}; # <-- Remember the semicolon
|
||||
|
||||
|
||||
|
||||
|
||||
----------------------------------------
|
||||
|
||||
Installing Perl packages as non-root
|
||||
|
||||
http://tldp.org/LDP/LGNET/139/okopnik.html
|
||||
|
||||
|
||||
----------------------------------------
|
||||
|
||||
http://boinc.berkeley.edu/trac/wiki/WebRpc#lookup_account
|
||||
|
||||
----------------------------------------
|
||||
|
||||
|
||||
EXAMPLE INVOCATION
|
||||
|
||||
|
||||
ON GROSSO
|
||||
|
||||
echo \
|
||||
perl -w boinc_submit.pl -name N1 -group TONIR3 \
|
||||
-conf sample/TONI/input_boinc_gpu.conf -pdb sample/TONI/grama.ionized.pdb \
|
||||
-psf sample/TONI/grama.ionized.psf -coor sample/TONI/equil.coor \
|
||||
-vel sample/TONI/equil.vel -par sample/TONI/parameters \
|
||||
-url http://www.ps3grid.net:8383/rboinc_cgi -dry
|
||||
|
||||
echo \
|
||||
perl -w boinc_retrieve.pl -group TONIR3 -name N1 \
|
||||
-url http://www.ps3grid.net:8383/rboinc_cgi \
|
||||
-into /tmp/
|
||||
|
||||
|
||||
|
||||
Prerequisites for client:
|
||||
|
||||
XML::Simple
|
||||
Error
|
||||
|
||||
|
||||
Binary file not shown.
|
|
@ -1,6 +1,6 @@
|
|||
#!/usr/bin/perl -w
|
||||
|
||||
# $Id: boinc_authentication.pl 355 2010-03-02 14:56:57Z toni $
|
||||
# $Id: boinc_authentication.pl 736 2011-02-22 19:17:34Z toni $
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
|
@ -173,59 +173,46 @@ sub isNameReserved {
|
|||
|
||||
# Template-handling
|
||||
|
||||
# Parse a template and return it as a hash
|
||||
sub parse_template {
|
||||
my $tpl=shift;
|
||||
|
||||
if(!isTagValid($tpl)) {
|
||||
die "Invalid character in application request";
|
||||
}
|
||||
|
||||
# Read the template's content
|
||||
my $tfile=$config->{PROJECT_DIR}."/templates/";
|
||||
$tfile=$tfile.$tpl;
|
||||
|
||||
open F,"<$tfile" or die "Error opening template: $!";
|
||||
my @lines=<F>;
|
||||
close F;
|
||||
my $ttext=join "",@lines;
|
||||
|
||||
# Add the root element, otherwise ill-formed
|
||||
my $txml=XMLin("<opt>$ttext</opt>",
|
||||
ForceArray => ["file_ref"]);
|
||||
return $txml;
|
||||
}
|
||||
|
||||
|
||||
# Parse the wu template and return it as an hash
|
||||
sub parse_wu_template {
|
||||
my $tpl=shift;
|
||||
|
||||
if(!isTagValid($tpl)) {
|
||||
die "Invalid character in application request";
|
||||
}
|
||||
|
||||
# Read the template's content
|
||||
my $tfile=$config->{PROJECT_DIR}."/templates/";
|
||||
$tfile=$tfile."rboinc_".$tpl."_wu";
|
||||
|
||||
open F,"<$tfile" or die "Error opening template: $!";
|
||||
my @lines=<F>;
|
||||
close F;
|
||||
my $ttext=join "",@lines;
|
||||
|
||||
# Add the root element, otherwise ill-formed
|
||||
my $txml=XMLin("<opt>$ttext</opt>",
|
||||
ForceArray => ["file_ref"]);
|
||||
return $txml;
|
||||
|
||||
return parse_template("rboinc_".$tpl."_wu");
|
||||
}
|
||||
|
||||
|
||||
|
||||
# Parse the wu template and return it as an hash
|
||||
sub parse_result_template {
|
||||
my $tpl=shift;
|
||||
|
||||
if(!isTagValid($tpl)) {
|
||||
die "Invalid character in application request";
|
||||
}
|
||||
|
||||
# Read the template's content
|
||||
my $tfile=$config->{PROJECT_DIR}."/templates/";
|
||||
$tfile=$tfile."rboinc_".$tpl."_result";
|
||||
|
||||
open F,"<$tfile" or die "Error opening template: $!";
|
||||
my @lines=<F>;
|
||||
close F;
|
||||
my $ttext=join "",@lines;
|
||||
|
||||
# Add the root element, otherwise ill-formed
|
||||
my $txml=XMLin("<opt>$ttext</opt>",
|
||||
ForceArray => ["file_ref"]);
|
||||
return $txml;
|
||||
|
||||
return parse_template("rboinc_".$tpl."_result");
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
# Convert the input list into an ORDERED array of hash refs.
|
||||
# Each hash ref contains info for an input file
|
||||
sub build_input_files_list {
|
||||
|
|
@ -288,6 +275,26 @@ EOF
|
|||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
# Parse result name and split into components
|
||||
sub parseResultName {
|
||||
my $n=shift;
|
||||
my ($name,$user,$group,$step,$maxsteps,$rnd,$ext) = ($n=~/^(.+)-(.+)_(.+)-(.+)-(.+)-(.+)_(.+)$/);
|
||||
my $r={
|
||||
name => $name,
|
||||
user => $user,
|
||||
group => $group,
|
||||
step => $step,
|
||||
maxsteps => $maxsteps,
|
||||
rnd => $rnd,
|
||||
ext => $ext
|
||||
};
|
||||
return $r;
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -45,23 +45,6 @@ return {
|
|||
ENCODE_EXECUTABLE => "$cgi/etc/encodeinput",
|
||||
ENCODE_CODE => -1,
|
||||
|
||||
# File extension table. The funny layout is to simplify XML-ing &
|
||||
# lookups later. The server will send this list to the client. The
|
||||
# client will NOT download files if a file with the same name exists,
|
||||
# OR one with the appended extensions.
|
||||
ALIAS_TABLE => [
|
||||
{ Extension => "_0",
|
||||
Alias => [ ".log", ".log.gz", ".log.gz.bad" ] },
|
||||
{ Extension => "_1",
|
||||
Alias => [ ".coor" ] },
|
||||
{ Extension => "_2",
|
||||
Alias => [ ".vel" ] },
|
||||
{ Extension => "_3",
|
||||
Alias => [ ".idx" ] },
|
||||
{ Extension => "_4",
|
||||
Alias => [ ".dcd", ".dcd.gz", ".dcd.gz.bad" ] },
|
||||
],
|
||||
|
||||
|
||||
# Directory for miscellaneous files (eg. defaults)
|
||||
ETC_DIR => "$cgi/etc",
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
#!/usr/bin/perl -w
|
||||
|
||||
# $Id: boinc_retrieve_server.pl 354 2010-03-02 14:56:33Z toni $
|
||||
# $Id: boinc_retrieve_server.pl 736 2011-02-22 19:17:34Z toni $
|
||||
|
||||
# The remote-boinc server-side perl script. Should run as a CGI in an
|
||||
# Apache2 instance.
|
||||
|
|
@ -148,8 +148,9 @@ do { # ???
|
|||
voidAnswer();
|
||||
} elsif ($action eq 'get_dav_url') {
|
||||
handleGetDavUrl();
|
||||
} elsif ($action eq 'get_wu_template') {
|
||||
handleGetWuTemplate($form->{application});
|
||||
} elsif ($action eq 'get_wu_template') {
|
||||
# action slightly misnomed - will get both
|
||||
handleGetTemplate($form->{application});
|
||||
} elsif ($action eq 'retrieve') {
|
||||
my $form_group=$form->{group};
|
||||
my $form_name=$form->{name};
|
||||
|
|
@ -201,7 +202,7 @@ exit(0);
|
|||
sub handleGetDavUrl {
|
||||
my $oh={};
|
||||
$oh->{DavUrl}=$config->{DAV_URL};
|
||||
$oh->{ServerRevision}='$Revision: 354 $';
|
||||
$oh->{ServerRevision}='$Revision: 736 $';
|
||||
|
||||
my $xr=XMLout($oh, RootName => $xmlroot, AttrIndent => 1);
|
||||
|
||||
|
|
@ -214,13 +215,17 @@ sub handleGetDavUrl {
|
|||
|
||||
##################################################
|
||||
|
||||
sub handleGetWuTemplate {
|
||||
# Get wu and result templates
|
||||
sub handleGetTemplate {
|
||||
my $app=shift;
|
||||
my $thash=parse_wu_template($app);
|
||||
my $rhash=parse_result_template($app);
|
||||
|
||||
my $oh={};
|
||||
$oh->{WuTemplate}=$thash;
|
||||
$oh->{ServerRevision}='$Revision: 354 $';
|
||||
my $oh={
|
||||
WuTemplate => $thash,
|
||||
ResultTemplate => $rhash,
|
||||
ServerRevision => '$Revision: 736 $'
|
||||
};
|
||||
|
||||
my $xr=XMLout($oh, RootName => $xmlroot, AttrIndent => 1);
|
||||
|
||||
|
|
@ -233,6 +238,7 @@ sub handleGetWuTemplate {
|
|||
|
||||
|
||||
|
||||
|
||||
##################################################
|
||||
# Prevent the WU from spawning more work
|
||||
|
||||
|
|
@ -424,7 +430,7 @@ sub sendRemoveSuccess {
|
|||
my $r={};
|
||||
$r->{Success}->{NumberRemoved}=$nr;
|
||||
$r->{Success}->{NumberKept}=$nk;
|
||||
$r->{ServerRevision}='$Revision: 354 $';
|
||||
$r->{ServerRevision}='$Revision: 736 $';
|
||||
|
||||
my $xr=XMLout($r, RootName => $xmlroot, AttrIndent => 1);
|
||||
|
||||
|
|
@ -492,14 +498,18 @@ sub handleRetrieve {
|
|||
# TODO: find files to be downloaded
|
||||
|
||||
my @flist;
|
||||
if($name) {
|
||||
my $aliastable;
|
||||
if($name) { # name given
|
||||
@flist=glob("$groupdir/$name-$group-*");
|
||||
$aliastable=getAliasTable($name,$group);
|
||||
if(-r "$groupdir/$name/metadata_file") {
|
||||
push @flist,"$groupdir/$name/metadata_file";
|
||||
$metadata++;
|
||||
}
|
||||
} else {
|
||||
} else { # name not given
|
||||
@flist=glob("$groupdir/*-$group-*");
|
||||
my $tmp=parseResultName(basename($flist[0])); # NAME of first retrieved item
|
||||
$aliastable=getAliasTable($tmp->{name},$group);
|
||||
}
|
||||
|
||||
if(! scalar @flist) {
|
||||
|
|
@ -515,25 +525,14 @@ sub handleRetrieve {
|
|||
symlink $f,"$retrdir/$bn";
|
||||
}
|
||||
|
||||
|
||||
sendRetrieveSuccess($random_id,\@blist,$expouts,$metadata);
|
||||
|
||||
}
|
||||
|
||||
|
||||
sub sendRetrieveSuccess {
|
||||
my $reason=shift;
|
||||
my $rblist=shift;
|
||||
my $eo=shift;
|
||||
my $meta=shift;
|
||||
|
||||
# Send response
|
||||
my $r={};
|
||||
$r->{Success}->{Directory}=$reason;
|
||||
$r->{Success}->{FinalOutputs}=$eo;
|
||||
$r->{Success}->{MetadataFileCount}=$meta;
|
||||
$r->{AliasTable}={File=>$config->{ALIAS_TABLE}};
|
||||
$r->{FileList}={File=>$rblist};
|
||||
$r->{ServerRevision}='$Revision: 354 $';
|
||||
$r->{Success}->{Directory}=$random_id;
|
||||
$r->{Success}->{FinalOutputs}=$expouts;
|
||||
$r->{Success}->{MetadataFileCount}=$metadata;
|
||||
$r->{AliasTable}={File=>$aliastable};
|
||||
$r->{FileList}={File=>\@blist};
|
||||
$r->{ServerRevision}='$Revision: 736 $';
|
||||
|
||||
my $xr=XMLout($r, RootName => $xmlroot, AttrIndent => 1);
|
||||
|
||||
|
|
@ -544,6 +543,29 @@ sub sendRetrieveSuccess {
|
|||
|
||||
|
||||
|
||||
# Make alias table for given group, name (from template)
|
||||
sub getAliasTable {
|
||||
my $name=shift;
|
||||
my $group=shift;
|
||||
my $groupdir=$config->{WORKFLOW_DIR}."/$group";
|
||||
my $desc=XMLin("$groupdir/$name/$xml_description_file");
|
||||
my $app=$desc->{Template};
|
||||
my $tpl=parse_result_template($app);
|
||||
my @ata=();
|
||||
my $i=0;
|
||||
while ($tpl->{file_info}->[$i]) {
|
||||
my $ext="_$i";
|
||||
my $aliases=$tpl->{file_info}->[$i]->{rboinc}->{aliases};
|
||||
my @alist=split(' ',$aliases);
|
||||
push(@ata, { Extension => $ext,
|
||||
Alias => \@alist } );
|
||||
$i++;
|
||||
}
|
||||
return \@ata;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -628,7 +650,7 @@ sub handleGridStatus {
|
|||
die "invalid user supplied" if(! isUserValid($user));
|
||||
|
||||
my $cmd=<<"EOL";
|
||||
echo "call mon_status('$user')" | mysql -t -p XXX YYY
|
||||
echo "call mon_status('$user')" | mysql -t -pc0c4c0la LUNA
|
||||
EOL
|
||||
my $list=`$cmd`;
|
||||
|
||||
|
|
@ -706,7 +728,7 @@ sub sendSuccess {
|
|||
my $m=shift;
|
||||
my $r=shift || {};
|
||||
$r->{Success}->{Message}=$m;
|
||||
$r->{ServerRevision}='$Revision: 354 $';
|
||||
$r->{ServerRevision}='$Revision: 736 $';
|
||||
|
||||
my $xr=XMLout($r, RootName => $xmlroot, AttrIndent => 1);
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue