Fix multipart upload & download

* lib/App/Glacier/Command/Get.pm: Fix chunk alignment and the use of shared
variables.
* lib/App/Glacier/Command/ListVault.pm: Fix typo.
* lib/App/Glacier/Command/Put.pm (_upload_multipart): Rewrite.
* lib/App/Glacier/DB/GDBM.pm: Don't keep the DB mapped through the
lifetime of the object, as this interacts badly with the threaded
code (it causes coredumps when the copies of the object are destroyed
in their corresponding threads, which means that the underlying
gdbm_close gets called multiple times on the same GDBM structure. See
comment to the _tied method, for details).

1 files changed, 27 insertions, 16 deletions

diff --git a/lib/App/Glacier/Command/Get.pm b/lib/App/Glacier/Command/Get.pm
index b00b658..09e739f 100644
--- a/lib/App/Glacier/Command/Get.pm
+++ b/lib/App/Glacier/Command/Get.pm
@@ -78,18 +78,18 @@ sub run {
 						   $filename, $ver);
 
     if ($self->{_options}{test}) {
-	$self->error("downloading file $filename initialized on",
-		     $job->get('CreationDate')->canned_format('full-iso'));
-	$self->error("job id:", $job->id);
+	print "downloading file $filename initialized on",
+	      $job->get('CreationDate')->canned_format('full-iso'),"\n";
+	print "job id: ", $job->id, "\n";
 	my ($status, $message) = $job->status;
-	$self->error("current status:", $status);
+	print "current status: $status\n";
 	if ($message) {
-	    $self->error("status message: $message\n");
+	    print "status message: $message\n";
 	}
 	
 	if ($job->is_completed) {
-	    $self->error("completed on",
-			 $job->get('CompletionDate')->canned_format('full-iso'));
+	    print "completed on ",
+	          $job->get('CompletionDate')->canned_format('full-iso'),"\n";
 	}
 	exit(0);
     }
@@ -112,13 +112,16 @@ sub run {
     }
 }
 
+use constant MB => 1024*1024;
+use constant TWOMB => 2*MB;
+
 sub download {
     my ($self, $job, $localname) = @_;
 
     use threads;
     use threads::shared;
 
-    my $fd :shared;    
+    my $fd;    
     open($fd, '>', $localname)
 	or $self->abort(EX_FAILURE, "can't open $localname: $!");
     binmode($fd);
@@ -130,12 +133,18 @@ sub download {
     my $part_size;
     if ($self->{_options}{jobs}) {
 	$njobs = $self->{_options}{jobs};
+	# Compute approximate part size
 	$part_size = int(($archive_size + $njobs - 1) / $njobs);
     } else {
-	$part_size = $self->{_options}{part_size} || 10*1024*1024*1024; # FIXME
-	$njobs = int(($archive_size + $part_size - 1) / $part_size);
+	$part_size = ($self->{_options}{part_size} || 10 * MB);
     }
 
+    # Make sure the chunk is Tree-Hash aligned
+    # http://docs.aws.amazon.com/amazonglacier/latest/dev/checksum-calculations-range.html?shortFooter=true#checksum-calculations-upload-archive-with-ranges
+    $part_size = TWOMB * 2 ** int(log($part_size / TWOMB) / log(2));
+    # Adjust the number of jobs
+    $njobs = int(($archive_size + $part_size - 1) / $part_size);
+
     my $glacier = $self->{_glacier};
 
     my $tree_hash;
@@ -152,7 +161,7 @@ sub download {
 	$self->debug(1,
 		     "downloading", $job->file_name(1), "to $localname in chunks of $part_size bytes, in $njobs jobs");
 
-	my @part_hashes = ();
+	my @part_hashes :shared = ();
 	my $read_bytes;
 	my $rest_size = $archive_size;
 	my $off = 0;
@@ -163,13 +172,14 @@ sub download {
 	    my ($thr) = threads->create(
 		sub {
 		    my ($part_idx, $off) = @_;
-		    my $range = $off . '-' . ($off + $part_size);
+		    my $range = 'bytes=' . $off . '-' . ($off + $part_size - 1);
 		    my ($res, $hash) =
 			$glacier->get_job_output($job->vault, $job->id, $range);
-		    lock $fd;
+		    lock @part_hashes;
 		    seek($fd, $off, SEEK_SET);
 		    syswrite($fd, $res);
-		    return ($part_idx, $hash);
+		    $part_hashes[$part_idx] = $hash;
+		    return 1;
 		},
 		$i, $off);
 	}
@@ -177,17 +187,18 @@ sub download {
 	$self->debug(2, "waiting for download to finish");
 	foreach my $thr (threads->list()) {
 	    # FIXME: error handling
-	    my ($idx, $hash) = $thr->join() or croak "thread $thr failed";
-	    $part_hashes[$idx] = $hash;
+	    $thr->join() or croak "thread $thr failed";
 	}
 	$tree_hash = $glacier->_tree_hash_from_array_ref(\@part_hashes);
     }
 
     close($fd);
+#   print $tree_hash. ' ', $job->get('ArchiveSHA256TreeHash') , "\n";
     if ($tree_hash ne $job->get('ArchiveSHA256TreeHash')) {
 	unlink $localname;
 	$self->abend(EX_SOFTWARE, "downloaded file is corrupt");
     }
+    print "finished\n";
 }
     
 1;