Check for job expiration

* glacier: Document the database.*.ttl statements
* lib/App/Glacier/Command.pm (parameters): New database statements: "ttl"
* lib/App/Glacier/Command/Get.pm (run): Fix malformed message.
* lib/App/Glacier/Job.pm (new): New keyword argument ttl.
(_get_job): Re-check completed job older than _ttl using describe_job.
* lib/App/Glacier/Job/ArchiveRetrieval.pm (new): Pass additional data
(including the description) via keyword arguments.
* lib/App/Glacier/Job/FileRetrieval.pm (new): Pass ttl and description
as keyword arguments.
* lib/App/Glacier/Job/InventoryRetrieval.pm (new): Pass ttl

6 files changed, 23 insertions, 13 deletions

diff --git a/lib/App/Glacier/Command.pm b/lib/App/Glacier/Command.pm
index 44dfe18..90bac26 100644
--- a/lib/App/Glacier/Command.pm
+++ b/lib/App/Glacier/Command.pm
@@ -121,13 +121,14 @@ my %parameters = (
 		section => {
 		    file => { default => '/var/lib/glacier/job.db' },
 		    mode => { default => 0644 },
+		    ttl => { default => 72000, check => \&ck_number },
 		},
 	    },
 	    inv => {
 		section => {
 		    directory => { default => '/var/lib/glacier/inv' },
 		    mode => { default => 0644 },
-		    ttl => { default => 86400, check => \&ck_number },
+		    ttl => { default => 72000, check => \&ck_number },
 		}
 	    }
 	}
diff --git a/lib/App/Glacier/Command/Get.pm b/lib/App/Glacier/Command/Get.pm
index 5b62552..3a420f5 100644
--- a/lib/App/Glacier/Command/Get.pm
+++ b/lib/App/Glacier/Command/Get.pm
@@ -126,7 +126,7 @@ sub run {
 						   $filename, $ver);
 
     if ($self->{_options}{test}) {
-	print "downloading file $filename initialized on",
+	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;
diff --git a/lib/App/Glacier/Job.pm b/lib/App/Glacier/Job.pm
index 4cd3de5..06e768f 100644
--- a/lib/App/Glacier/Job.pm
+++ b/lib/App/Glacier/Job.pm
@@ -13,7 +13,8 @@ sub new {
     croak "bad number of arguments" unless $#_ >= 4;
     my ($class, $cmd, $vault, $key, $init, %opts) = @_;
     my $invalidate = delete $opts{invalidate};
-
+    my $ttl = delete $opts{ttl};
+    
     if (keys(%opts)) {
 	croak "unrecognized parameters: ".join(', ', keys(%opts));
     }
@@ -23,6 +24,7 @@ sub new {
 		   _vault => $vault,
 		   _key => $key,
 		   _job => undef,
+		   _ttl => $ttl,
 		   _invalidate => $invalidate }, $class;
 }
 
@@ -61,13 +63,13 @@ sub _get_job {
 	    $db->store($self->{_key}, $job);
 	}
 
-	if (!$job->{Completed}) {
+	if (!$job->{Completed}
+	    || ($self->{_ttl} 
+		&& (time - $job->{CompletionDate}->epoch) > $self->{_ttl})) {
 	    $self->debug(2, "checking status of job $self->{_key}");
 	    my $res = $self->{_cmd}->glacier_eval('describe_job',
 						  $self->{_vault},
 						  $job->{JobId});
-	    croak "describe_job returned wrong datatype (".ref($res).") for \"$job->{JobId}\""
-		unless ref($res) eq 'HASH';
 	    if ($self->{_cmd}->lasterr) {
 		if ($self->{_cmd}->lasterr('code') == 404) {
 		    $self->debug(2, "job $self->{_key} expired");
@@ -78,6 +80,8 @@ sub _get_job {
 					 "can't describe job $job->{JobId}: ",
 					 $self->{_cmd}->last_error_message);
 		}
+	    } elsif (ref($res) ne 'HASH') {
+		croak "describe_job returned wrong datatype (".ref($res).") for \"$job->{JobId}\"";
 	    } else {
 		$res = timestamp_unserialize($res);
 		$self->debug(2, $res->{StatusCode});
diff --git a/lib/App/Glacier/Job/ArchiveRetrieval.pm b/lib/App/Glacier/Job/ArchiveRetrieval.pm
index 649658e..660c4c9 100644
--- a/lib/App/Glacier/Job/ArchiveRetrieval.pm
+++ b/lib/App/Glacier/Job/ArchiveRetrieval.pm
@@ -6,14 +6,16 @@ require App::Glacier::Job;
 use parent qw(App::Glacier::Job);
 use Carp;
 
-# new(CMD, VAULT, ARCHIVE[, DESCR])
+# new(CMD, VAULT, ARCHIVE[, description => DESCR, OPTS...])
 sub new {
-    croak "bad number of arguments" if $#_ < 3 || $#_ > 4;
-    my ($class, $cmd, $vault, $archive, $descr) = @_;
+    croak "bad number of arguments" if $#_ < 3;
+    my ($class, $cmd, $vault, $archive, %opts) = @_;
+    my $descr = delete $opts{description};
     return $class->SUPER::new(
 	$cmd,
 	$vault,
 	$vault . ':' . $archive,
-	[ 'initiate_archive_retrieval', $vault, $archive, $descr ]
+	[ 'initiate_archive_retrieval', $vault, $archive, $descr ],
+	%opts
     );
 }
diff --git a/lib/App/Glacier/Job/FileRetrieval.pm b/lib/App/Glacier/Job/FileRetrieval.pm
index 05f3f3c..3838e36 100644
--- a/lib/App/Glacier/Job/FileRetrieval.pm
+++ b/lib/App/Glacier/Job/FileRetrieval.pm
@@ -21,11 +21,13 @@ sub new {
     ($archive, $version) = $dir->locate($file, $version);
     unless ($archive) {
 	$version = 1 unless defined $version;
-	$cmd->abend(EX_NOINPUT, "$vault:$file;$version not found; make sure directory listing is up-to-date");
+	$cmd->abend(EX_NOINPUT,
+		    "$vault:$file;$version not found; make sure directory listing is up-to-date");
     }
     
-    my $descr = "Retrieval of $file;$version";
-    my $self = $class->SUPER::new($cmd, $vault, $archive->{ArchiveId}, $descr);
+    my $self = $class->SUPER::new($cmd, $vault, $archive->{ArchiveId},
+				  description => "Retrieval of $file;$version",
+				  ttl => $cmd->cfget(qw(database job ttl)));
     $self->{_filename} = $file;
     $self->{_fileversion} = $version;
     return $self;
diff --git a/lib/App/Glacier/Job/InventoryRetrieval.pm b/lib/App/Glacier/Job/InventoryRetrieval.pm
index 9980a09..1ba67ba 100644
--- a/lib/App/Glacier/Job/InventoryRetrieval.pm
+++ b/lib/App/Glacier/Job/InventoryRetrieval.pm
@@ -13,6 +13,7 @@ sub new {
     return $class->SUPER::new(
 	$cmd, $vault, $vault,
 	[ 'initiate_inventory_retrieval', $vault, 'JSON' ],
+	ttl => $cmd->cfget(qw(database inv ttl)),
 	%opts);
 }