~ubuntu-branches/ubuntu/precise/boinc/precise

« back to all changes in this revision

Viewing changes to rboinc/client/boinc_retrieve.pl

Tags: 6.12.8+dfsg-1
* New upstream release.
* Simplified debian/rules

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
#!/usr/bin/perl
 
2
 
 
3
=head1 COPYRIGHT
 
4
 
 
5
This file is part of RemoteBOINC.
 
6
 
 
7
Copyright (C) 2010 Toni Giorgino, Universitat Pompeu Fabra
 
8
 
 
9
RemoteBOINC is free software; you can redistribute it and/or modify it
 
10
under the terms of the GNU Lesser General Public License as published
 
11
by the Free Software Foundation, either version 3 of the License, or
 
12
(at your option) any later version.
 
13
 
 
14
RemoteBOINC is distributed in the hope that it will be useful, but
 
15
WITHOUT ANY WARRANTY; without even the implied warranty of
 
16
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 
17
Lesser General Public License for more details.
 
18
 
 
19
You should have received a copy of the GNU Lesser General Public
 
20
License along with BOINC.  If not, see <http://www.gnu.org/licenses/>.
 
21
 
 
22
=cut
 
23
 
 
24
 
 
25
# $Id: boinc_retrieve.pl 356 2010-03-02 15:00:31Z toni $
 
26
 
 
27
use strict;
 
28
 
 
29
 
 
30
use FindBin qw($Bin);           # where was script installed?
 
31
use lib $FindBin::Bin;          # use that dir for libs, too
 
32
use lib "$Bin/lib/$]";
 
33
 
 
34
use Getopt::Long qw(:config ignore_case auto_help);
 
35
use XML::Simple;
 
36
use HTTP::Request::Common qw(POST);
 
37
use HTTP::DAV;
 
38
use LWP::UserAgent;
 
39
use File::Basename;
 
40
use Pod::Usage;
 
41
use Error qw(:try);
 
42
 
 
43
use constant XMLROOT => "BoincRemote";
 
44
 
 
45
require qw(boinc_lib.pl);
 
46
 
 
47
 
 
48
 
 
49
# Constant, relative to url
 
50
my $cgi_retrieve="boinc_retrieve_server.pl";
 
51
 
 
52
 
 
53
 
 
54
# ----------------
 
55
# Parsing command line
 
56
 
 
57
my $group='';
 
58
 
 
59
my $name='';
 
60
my $into='',
 
61
our $verbose='';
 
62
my $quiet='';
 
63
my $keep='';
 
64
my $purge='';
 
65
my $stop='';
 
66
my $status='';
 
67
my $gridstatus='';
 
68
my $help='';
 
69
 
 
70
my $url=$ENV{RBOINC_URL};
 
71
my $user=$ENV{USER};
 
72
my $email='';
 
73
my $authenticator='';
 
74
 
 
75
 
 
76
 
 
77
GetOptions(
 
78
    'group=s' => \$group,
 
79
 
 
80
    'name=s' => \$name,
 
81
    'into=s' => \$into,
 
82
    'verbose' => \$verbose,
 
83
    'quiet' => \$quiet,
 
84
    'keep'  => \$keep,
 
85
    'purge' => \$purge,
 
86
    'stop' => \$stop,
 
87
    'status' => \$status,
 
88
    'gridstatus' => \$gridstatus,
 
89
    'help' => \$help,
 
90
 
 
91
    'url=s' => \$url,
 
92
    'user=s' => \$user,
 
93
    'email=s' => \$email,
 
94
    'authenticator=s' => \$authenticator,
 
95
    ) or die "Error parsing command line";
 
96
 
 
97
 
 
98
pod2usage(1) if $help;
 
99
 
 
100
 
 
101
 
 
102
# ----------------
 
103
# Check arguments
 
104
 
 
105
checkMandatoryArguments(["group","url"]) or exit 1;
 
106
my $cgi_url = "$url/$cgi_retrieve";
 
107
 
 
108
 
 
109
 
 
110
 
 
111
# ----------------
 
112
# Authentication TODO
 
113
 
 
114
 
 
115
 
 
116
 
 
117
 
 
118
# ----------------
 
119
# Remote action invocation
 
120
 
 
121
if($purge) {
 
122
    handlePurge();
 
123
} elsif($stop) {
 
124
    handleStop();
 
125
} elsif($status) {
 
126
    handleStatus();
 
127
} elsif($gridstatus) {
 
128
    handleGridStatus();
 
129
} else {
 
130
    handleRetrieve();
 
131
}
 
132
 
 
133
exit(0);
 
134
 
 
135
 
 
136
 
 
137
 
 
138
 
 
139
 
 
140
 
 
141
 
 
142
 
 
143
 
 
144
########################################
 
145
# Handle purge action
 
146
 
 
147
 
 
148
sub handlePurge {
 
149
 
 
150
    if($into)  {
 
151
        print STDERR "Action --purge deletes only. It makes no sense in combination with --into.\n";
 
152
        exit 1;
 
153
    }
 
154
 
 
155
    confirmOrDie("The operation will IRREVERSIBLY delete results from the server.\n".
 
156
                 "Note: You won't be able to submit new WUs with equal names until old ones\nwill be pending in the server (check with -gridstatus).\nConfirm? ");
 
157
    my $xmlcontent=invokeRMI({action=>'purge',group=>$group,name=>$name});
 
158
    my $message=$xmlcontent->{Success}->{Message};
 
159
    print "Success. Message from server: $message\n";
 
160
}
 
161
 
 
162
 
 
163
 
 
164
 
 
165
########################################
 
166
# Handle stop action
 
167
 
 
168
 
 
169
sub handleStop {
 
170
 
 
171
    if($into || $name) {
 
172
        print STDERR "Action --stop  makes no sense in combination with --into or --name.\n";
 
173
    }
 
174
 
 
175
    confirmOrDie("The operation will IRREVERSIBLY stop the WU. Results can still be retrieved. Confirm? ");
 
176
    my $xmlcontent=invokeRMI({action=>'stop',group=>$group});
 
177
    my $message=$xmlcontent->{Success}->{Message};
 
178
    print "Success. Message from server: $message\n";
 
179
}
 
180
 
 
181
 
 
182
 
 
183
 
 
184
########################################
 
185
# Handle status action
 
186
 
 
187
 
 
188
sub handleStatus {
 
189
 
 
190
    if($into || $name) {
 
191
        print STDERR "Action --status  makes no sense in combination with --into or --name.\n";
 
192
    }
 
193
 
 
194
    my $xmlcontent=invokeRMI({action=>'status',group=>$group});
 
195
    my $message=$xmlcontent->{Success}->{Message};
 
196
    print "Success. Message from server: $message\n";
 
197
 
 
198
    my $steps=$xmlcontent->{Success}->{StepList};
 
199
    my %st=%$steps;
 
200
    foreach my $n (keys %st) {
 
201
        my $nn=$n;              # strip "bin_"
 
202
        $nn=~s/^Bin_//;
 
203
        print "$nn\t".$st{$n}."\n";
 
204
    }
 
205
 
 
206
}
 
207
 
 
208
 
 
209
 
 
210
########################################
 
211
# Handle status action
 
212
 
 
213
 
 
214
sub handleGridStatus {
 
215
 
 
216
    if($into || $name) {
 
217
        print STDERR "Action --gridstatus  makes no sense in combination with --into or --name.\n";
 
218
    }
 
219
 
 
220
    my $xmlcontent=invokeRMI({action=>'gridstatus'});
 
221
    my $message=$xmlcontent->{Success}->{Message};
 
222
    print "Success. Message from server: $message\n";
 
223
 
 
224
    my $list=$xmlcontent->{Success}->{content};
 
225
    print "$list\n";
 
226
 
 
227
}
 
228
 
 
229
 
 
230
 
 
231
 
 
232
 
 
233
 
 
234
 
 
235
########################################
 
236
# Handle retrieve action
 
237
 
 
238
 
 
239
sub handleRetrieve {
 
240
 
 
241
# ----------------
 
242
# Change dir and fail early
 
243
    if($into) {
 
244
        chdir $into or do {
 
245
            print STDERR "Cannot chdir to -into directory `$into': $!\n";
 
246
            exit 1;
 
247
        }
 
248
    }
 
249
 
 
250
# ----------------
 
251
# Invoke RMI
 
252
    my $xmlcontent=invokeRMI({action=>'retrieve',group=>$group,name=>$name});
 
253
 
 
254
# ----------------
 
255
# Check outcome
 
256
    my $rfilelist=$xmlcontent->{FileList}->{File};
 
257
    if(!$rfilelist) {
 
258
        die "No files ready for retrieval.\n";
 
259
    } 
 
260
 
 
261
    my $dav_dir=$xmlcontent->{Success}->{Directory};
 
262
    if(!$dav_dir) {
 
263
        die "Error requesting download location";
 
264
    }
 
265
 
 
266
    my $aliasTable=$xmlcontent->{AliasTable};
 
267
    my $finalOutputs=$xmlcontent->{Success}->{FinalOutputs};
 
268
    my $nMeta=$xmlcontent->{Success}->{MetadataFileCount};
 
269
 
 
270
 
 
271
# ----------------
 
272
# Download
 
273
    logInfo("Requesting the  DAV address");
 
274
    my $dav_url=getDavUrl($cgi_url);
 
275
 
 
276
    logInfo("Connecting to DAV server");
 
277
    my $dav = new HTTP::DAV;
 
278
    $dav->open( -url=> $dav_url )
 
279
        or die("Couldn’t open $dav_url: " .$dav->message . "\n");
 
280
    $dav->cwd($dav_dir)              
 
281
        or die("Couldn’t set remote directory $dav_dir: " .$dav->message . "\n");
 
282
 
 
283
    my $ndone=0;
 
284
    my $nskip=0;
 
285
    my @skiplist=();
 
286
    my $nexpected=scalar @$rfilelist;
 
287
    foreach my $fn (@$rfilelist) {
 
288
        if( fileOrAliasExists($fn,$aliasTable) ) {
 
289
            if(!$quiet && $nskip==0) {
 
290
                print "Warning: some files are present locally and will not be overwritten.\n";
 
291
            }
 
292
            $nskip++;
 
293
            push @skiplist,$fn;
 
294
        } else {
 
295
            $dav->get(-url => $fn,
 
296
                      -to => ".") and
 
297
                          $ndone++;
 
298
        }
 
299
        if(!$quiet) {
 
300
            local $|=1;
 
301
            print sprintf("Retrieved $ndone, already present $nskip, out of $nexpected (% 3d%%)\r",100.*($ndone+$nskip)/$nexpected);
 
302
        }
 
303
    }
 
304
 
 
305
    if($verbose) {
 
306
        print "The following files were not overwritten: @skiplist\n";
 
307
    }
 
308
 
 
309
    print "Successfully retrieved $ndone, already present $nskip, out of $nexpected ($nMeta metadata).\n";
 
310
 
 
311
 
 
312
 
 
313
# ----------------
 
314
# Request deletion of remote files
 
315
 
 
316
    if(! $keep) {
 
317
        logInfo("Going to remove retrieved files");
 
318
        try {
 
319
            $xmlcontent=invokeRMI({action=>'remove',dir=>$dav_dir});
 
320
 
 
321
            my $nremoved=$xmlcontent->{Success}->{NumberRemoved};
 
322
            my $nkept=   $xmlcontent->{Success}->{NumberKept} ;  
 
323
            
 
324
            if(!$quiet) {
 
325
                print "Removed $nremoved server files, $nkept were too recent to remove.\n";
 
326
            }
 
327
        } catch Error with {
 
328
            my $ex=shift;
 
329
            my $mess=$ex->text();
 
330
            print STDERR "Error requesting removal of remote files: $mess; continuing.\n";
 
331
        }
 
332
 
 
333
 
 
334
    }
 
335
 
 
336
 
 
337
 
 
338
 
 
339
# ----------------
 
340
# Finalize
 
341
 
 
342
    logInfo("Removing retrieval directory");
 
343
    foreach my $fn (@$rfilelist) {
 
344
        $dav->delete(-url => $fn);
 
345
    }
 
346
    $dav->cwd("..");
 
347
    $dav->delete($dav_dir);
 
348
 
 
349
}
 
350
 
 
351
 
 
352
 
 
353
 
 
354
# Check if file exists in current directory (1st arg), checking both
 
355
# the literal file name and its aliases, appending extensions
 
356
# described in the alias list (2nd arg)
 
357
 
 
358
sub fileOrAliasExists {
 
359
    my $fn=shift;
 
360
    my $at=shift;
 
361
 
 
362
    logInfo("Testing existence of $fn...");
 
363
    if(-e $fn) {
 
364
        logInfo("...is there");
 
365
        return 1;
 
366
    }
 
367
 
 
368
    # Extract trailing number
 
369
    $fn=~/_([0-9]+)$/;
 
370
    my $fileExt=$1;
 
371
 
 
372
    # iterate over the alias list
 
373
    my $rAliasList=$at->{File};
 
374
    foreach my $curAlias ( @$rAliasList ) {
 
375
        if($curAlias->{Extension} eq "_$fileExt") {
 
376
            # if alias for current extension, check appending all extensions
 
377
            my $rExtList=$curAlias->{Alias};
 
378
            foreach my $extToTest (@$rExtList) {
 
379
                logInfo("Testing existence of $fn + $extToTest...");
 
380
                if(-e $fn.$extToTest) {
 
381
                    logInfo("...is there");
 
382
                    return 1;
 
383
                }
 
384
            }
 
385
        }
 
386
    }
 
387
 
 
388
    return 0;
 
389
 
 
390
}
 
391
 
 
392
 
 
393
 
 
394
 
 
395
 
 
396
 
 
397
 
 
398
# ########################################
 
399
# Misc. utility functions, shared by all handlers
 
400
 
 
401
 
 
402
 
 
403
# ----------------
 
404
# Ask for positive confirmation, or throw exception.
 
405
 
 
406
sub confirmOrDie {
 
407
    my $answer=promptUser(shift,"N");
 
408
    die "Operation aborted." if($answer !~ /^[yY]/ );
 
409
}
 
410
 
 
411
 
 
412
 
 
413
 
 
414
# ----------------
 
415
# Performs the remote method invokation, die-ing on failure
 
416
# Returns a parsed XML structure or throws an exception.
 
417
# Will use the $user global variable
 
418
 
 
419
sub invokeRMI {
 
420
    my $params=shift;
 
421
 
 
422
    logInfo("Invoking CGI");
 
423
 
 
424
    $params->{loginname}=$user;
 
425
 
 
426
    my $xmlcontent;
 
427
    my $ua = new LWP::UserAgent;
 
428
    my $response = $ua->post( $cgi_url,
 
429
                              $params  );
 
430
    if($response->is_success) {
 
431
        my $content = $response->content; 
 
432
        if($verbose) {
 
433
            print "Response received:\n";
 
434
            print $content;
 
435
        }
 
436
        $xmlcontent=XMLin($content,ForceArray=>["File","Alias"]);
 
437
    } else {
 
438
        my $reason=$response->status_line;
 
439
        die "Error in POST from remote: $reason. Server may be down.\n";
 
440
    }
 
441
 
 
442
    if($xmlcontent->{Failure}) {
 
443
        die "Server error message: $xmlcontent->{Failure}->{Reason}";
 
444
    } elsif(!$xmlcontent->{Success}) {
 
445
        die "Undefined state returned. This is a bug.";
 
446
    } 
 
447
        
 
448
    return($xmlcontent);
 
449
}
 
450
 
 
451
 
 
452
 
 
453
 
 
454
 
 
455
 
 
456
 
 
457
 
 
458
 
 
459
# Check if the calling environment has all the given variables
 
460
# defined.  If not, print one of them. Else, return false. These are
 
461
# passed as string in order to be able to be able to print their name.
 
462
# Sadly, must be duplicated because otherwise does not have access to
 
463
# scope.
 
464
 
 
465
sub checkMandatoryArguments {
 
466
    my $l=shift;
 
467
    foreach my $f (@$l) {
 
468
        if(! eval('$'."$f")) {
 
469
            print STDERR "Missing mandatory argument: $f. See -help.\n";
 
470
            return 0;
 
471
        }
 
472
    }
 
473
    return 1;
 
474
}
 
475
 
 
476
 
 
477
 
 
478
 
 
479
 
 
480
 
 
481
__END__
 
482
 
 
483
=pod
 
484
=head1 NAME
 
485
 
 
486
boinc_retrieve - Retrieving and administering remote boinc jobs
 
487
 
 
488
 
 
489
=head1 SYNOPSIS
 
490
 
 
491
boinc_retrieve [options]
 
492
 
 
493
 
 
494
=head1 OPTIONS
 
495
 
 
496
=head2 Mandatory parameters
 
497
 
 
498
=begin text
 
499
 
 
500
    -group GROUP         The simulation group to be retrieved
 
501
 
 
502
=end text
 
503
 
 
504
=head2 Modifiers
 
505
 
 
506
=begin text
 
507
 
 
508
    -name NAME           Retrieve only a specific job and its metadata
 
509
    -into DIR            Put files into specified directory (default ".")
 
510
    -verbose             Be verbose
 
511
    -quiet               Hide download progress indicator
 
512
    -keep                Do not remove retrieved files from server 
 
513
    -purge               Completely remove GROUP from server (if finished)
 
514
    -stop                Prevent more work to be spawned for a given group
 
515
    -status              Show step numbers for given group
 
516
    -gridstatus          Show resources consumed and statuses for all groups
 
517
    -help                This message
 
518
 
 
519
=end text
 
520
 
 
521
=head2 Authentication
 
522
 
 
523
=begin text
 
524
 
 
525
    -url URL             RBoinc URL contact point (*)
 
526
    -user NAME           Override username [$user]
 
527
    -email ADDRESS       (Not implemented)
 
528
    -authenticator ID    (Not implemented)
 
529
 
 
530
    (*) You can also use the RBOINC_URL environment variable
 
531
        For example: http://www.ps3grid.net:8383/rboinc_cgi
 
532
 
 
533
=end text
 
534
 
 
535
 
 
536
 
 
537
=head1 SEE ALSO
 
538
 
 
539
L<boinc_submit>
 
540
 
 
541
 
 
542
=head1 AUTHOR
 
543
 
 
544
Toni Giorgino
 
545
 
 
546
=cut
 
547