Commit af71f3e3 authored by Jonathon Duerig's avatar Jonathon Duerig

Merge branch 'master' of git-public.flux.utah.edu:/flux/git/emulab-devel

parents 3248998e d3af5225
......@@ -83,6 +83,7 @@ common-script-install: dir-install
$(INSTALL) -m 755 $(SRCDIR)/bootsubnodes $(BINDIR)/bootsubnodes
$(INSTALL) -m 755 $(SRCDIR)/bootvnodes $(BINDIR)/bootvnodes
$(INSTALL) -m 755 $(SRCDIR)/startcmddone $(BINDIR)/startcmddone
$(INSTALL) -m 755 $(SRCDIR)/getblob $(BINDIR)/getblob
(cd config; $(MAKE) DESTDIR=$(DESTDIR) script-install)
subboss-common-script-install: dir-install
......
#!/usr/bin/perl -w
#
# EMULAB-COPYRIGHT
# Copyright (c) 2010 University of Utah and the Flux Group.
# All rights reserved.
#
use strict;
use libtmcc;
my $blobid = undef;
my $debug = 0;
my @transport = ();
my $outputfilename = undef;
sub Usage($) {
my ($code) = @_;
print "Usage:\n\n";
print " $0 [-d] [-h] [-o file] [-t transport]... [-v] blobid\n\n";
print "Options:\n";
print " -d debug mode (verbose)\n";
print " -h help\n";
print " -o file output file name\n";
print " -t transport specify transports, in decreasing priority\n";
print " where transport can include:\n";
print " http HTTP\n";
print " https HTTP over TLS/SSL\n";
print " -v show version\n";
exit( $code );
}
# Perl's Getopt::Std won't handle multiple occurrences of the same
# option, so we have to do it ourselves. Bleh.
while( my $arg = shift ) {
if( $arg eq "-d" || $arg eq "--debug" ) {
# Turn off all bugs.
$debug = 1;
} elsif( $arg eq "-h" || $arg eq "--help" ) {
Usage( 0 );
} elsif( $arg eq "-o" || $arg eq "--output" ) {
$outputfilename = shift;
if( !defined( $outputfilename ) ) {
print "Option \"-o\" requires an argument.\n";
Usage( 1 );
}
} elsif( $arg eq "-t" || $arg eq "--transport" ) {
my $t = shift;
if( !defined( $t ) ) {
print "Option \"-t\" requires an argument.\n";
Usage( 1 );
}
push( @transport, $t );
} elsif( $arg eq "-v" || $arg eq "--version" ) {
print "getblob version 6.297864\n"; # who really cares?
exit( 0 );
} elsif( $arg =~ /^-/ ) {
print "Unknown option \"$arg\".\n";
Usage( 1 );
} else {
$blobid = $arg;
last;
}
}
Usage( 1 ) unless defined( $blobid );
@transport = ( "https", "http" ) unless @transport;
libtmcc::blob::getblob( $blobid, $outputfilename, @transport, $debug );
......@@ -40,6 +40,7 @@ use Exporter;
# Must come after package declaration!
use English;
use Data::Dumper;
use Fcntl qw(:DEFAULT :seek);
#
# Turn off line buffering on output
......@@ -659,5 +660,173 @@ sub tmccgetconfig()
return 0;
}
#
package libtmcc::blob;
my $SERVER = "www.emulab.net"; # FIXME where can this be obtained???
# tmcc.c jumps through hoops to get it... do we have to, too?
my $NICKNAMEFILE = "$BOOTDIR/nickname";
my $KEYHASHFILE = "$BOOTDIR/tmcc/keyhash";
# Load up the paths. Done like this in case init code is needed.
BEGIN
{
if (! -e "/etc/emulab/paths.pm") {
die("Yikes! Could not require /etc/emulab/paths.pm!\n");
}
require "/etc/emulab/paths.pm";
import emulabpaths;
}
my $blobid = undef;
my $canhash;
my $hash = undef;
my $key;
my $existing = undef;
my $output = undef;
my $tempfilename = undef;
my $finalfilename = undef;
my $project;
sub hash() {
return $hash if defined( $hash );
return undef unless defined( $existing );
my $digest = Digest::SHA1->new;
my $hex;
$digest->addfile( $existing );
$hash = $digest->hexdigest;
print "Computed hash $hash\n" if( $debug );
return $hash;
}
sub lwp_callback($$$) {
my ($chunk, $response, $protocol) = @_;
print $output $chunk;
# FIXME would be nice to hash as we go
}
sub http_common($) {
my ($prefix) = @_;
my $cachedhash = hash();
my $URL = $prefix . "://" . $SERVER . "/blob/read/" . $key . "/" . $blobid;
print "Attempting to retrieve $URL\n" if( $debug );
$URL .= "?hash=" . $cachedhash if( defined( $cachedhash ) );
my $ua = LWP::UserAgent->new;
my $request = HTTP::Request->new( GET => $URL );
my $response = $ua->request( $request, \&lwp_callback );
if( $response->code == 304 ) { # Not modified
print "Cached copy is current.\n" if( $debug );
unlink( $tempfilename ) if( defined( $tempfilename ) );
exit( 0 );
}
if( $response->is_success ) {
print "Retrieved successfully.\n" if( $debug );
if( defined( $tempfilename ) ) {
rename( $tempfilename, $finalfilename )
or die( "$finalfilename: $!" );
}
exit( 0 );
}
print $response->status_line . "\n" if( $debug );
}
sub http() {
http_common( "http" );
}
sub https() {
http_common( "https" );
}
sub getblob($$\@$) {
$blobid = $_[ 0 ];
my $outputfilename = $_[ 1 ];
my $transport = $_[ 2 ];
my $options = $_[ 3 ];
$debug = 1 if( $options ); # the only option right now
require Digest::SHA1;
require LWP::UserAgent;
open NICKNAME, $NICKNAMEFILE or die "$NICKNAMEFILE: $!";
<NICKNAME> =~ /.+[.].+[.](.+)/;
$project = $1;
close NICKNAME;
open KEYHASH, $KEYHASHFILE or die "$KEYHASHFILE: $!";
<KEYHASH> =~ /HASH='(.+)'/;
$key = $1;
close KEYHASH;
if( $debug ) {
$, = " ";
print "Blob ID: $blobid\n";
print "Key: $key\n";
print "Output: " .
( $outputfilename ? $outputfilename : "(standard output)" ) . "\n";
print "Project: $project\n";
print "Transports: @$transport\n";
}
if( defined( $outputfilename ) ) {
$finalfilename = $outputfilename;
$tempfilename = $finalfilename . ".$$";
open( OUTPUT, $outputfilename )
and $existing = *OUTPUT{IO};
open( TEMP, ">$tempfilename" )
or die( "$tempfilename: $!\n" );
$output = *TEMP{IO};
$canhash = 1;
} else {
$output = *STDOUT{IO};
$canhash = 0;
}
foreach( @$transport ) {
print "Attempting transport $_...\n" if( $debug );
if( /^http$/i ) {
http();
} elsif( /^https$/i ) {
https();
} else {
print "Unknown transport $_\n";
}
}
print STDERR "$0: failed to retrieve blob $blobid\n";
unlink( $tempfilename ) if( defined( $tempfilename ) );
return undef;
}
1;
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment