Implement sync

12 files changed, 341 insertions, 52 deletions

diff --git a/lib/App/Glacier/Command.pm b/lib/App/Glacier/Command.pm
index 3875a53..b669b67 100644
--- a/lib/App/Glacier/Command.pm
+++ b/lib/App/Glacier/Command.pm
@@ -31,6 +31,8 @@ use Net::Amazon::Glacier;
 use App::Glacier::HttpCatch;
 use App::Glacier::DB::GDBM;
 use App::Glacier::Timestamp;
+use App::Glacier::Directory;
+
 use Digest::SHA qw(sha256_hex);
 use File::Path qw(make_path);
 use Getopt::Long qw(GetOptionsFromArray :config gnu_getopt no_ignore_case require_order);
@@ -57,6 +59,13 @@ use constant {
     EX_CONFIG       => 78 
 };
 
+sub ck_number {
+    my ($vref) = @_;
+    return "not a number"
+        unless $$vref =~ /^\d+/;
+    return undef;
+}
+
 my %parameters = (
     glacier => {
 	section => {
@@ -77,7 +86,8 @@ my %parameters = (
 	    inv => {
 		section => {
 		    directory => { default => '/var/lib/glacier/inv' },
-		    mode => { default => 0644 }
+		    mode => { default => 0644 },
+		    ttl => { default => 86400, check => \&ck_number },
 		}
 	    }
 	}
@@ -197,24 +207,6 @@ sub jobdb {
     return $self->{_jobdb};
 }
 
-sub invdb {
-    my ($self, $vault) = @_;
-    
-    unless ($self->{_invdb}{$vault}) {
-	my $digest = sha256_hex($vault);
-	my $file = $self->{_config}->get(qw(database inv directory));
-	$self->touchdir($file);
-	$file .= '/' . $digest . 'db';
-
-	$self->{_invdb}{$vault} = new App::Glacier::DB::GDBM(
-	    $file,
-	    encoding => 'json',
-	    mode => $self->{_config}->get(qw(database inv mode))
-        );
-    }
-    return $self->{_invdb}{$vault};
-}
-
 sub describe_vault {
     my ($self, $vault_name) = @_;
     my $res = $self->glacier_eval('describe_vault', $vault_name);
@@ -229,13 +221,28 @@ sub describe_vault {
     return timestamp_unserialize($res);
 }
 
+sub _filename {
+    my ($self, $name) = @_;
+    $name =~ s/([^A-Za-z_0-9\.-])/sprintf("%%%02X", ord($1))/gex;
+    return $name;
+}
+
 sub directory {
     my ($self, $vault_name) = @_;
     unless ($self->{_dir}{$vault_name}) {
 	my $vault = $self->describe_vault($vault_name);
 	return undef unless $vault;
+
+	my $file = $self->{_config}->get(qw(database inv directory));
+	$self->touchdir($file);
+	$file .= '/' . $self->_filename($vault_name) . '.db';
+
 	$self->{_dir}{$vault_name} =
-	    new App::Glacier::Directory($self->invdb($vault_name));
+	    new App::Glacier::Directory(
+		$file,
+		encoding => 'json',
+		mode => $self->{_config}->get(qw(database inv mode))
+	    );
     }
     return $self->{_dir}{$vault_name};
 }
diff --git a/lib/App/Glacier/Command/ListVault.pm b/lib/App/Glacier/Command/ListVault.pm
index 56c6a4a..b381d0c 100644
--- a/lib/App/Glacier/Command/ListVault.pm
+++ b/lib/App/Glacier/Command/ListVault.pm
@@ -4,8 +4,6 @@ use strict;
 use warnings;
 use App::Glacier::Command;
 use parent qw(App::Glacier::Command);
-use App::Glacier::HttpCatch;
-use Getopt::Long qw(GetOptionsFromArray :config gnu_getopt no_ignore_case require_order);
 use App::Glacier::DateTime;
 use App::Glacier::Timestamp;
 use App::Glacier::Glob;
@@ -67,6 +65,7 @@ sub getopt {
 	    $self->abend(EX_USAGE, "unrecognized time style: $self->{_options}{time_style}");
 	}
     }
+    $self->{_options}{d} = 1 if (@ARGV == 0);
 }
     
 sub run {
@@ -74,6 +73,8 @@ sub run {
     
     if ($self->{_options}{d}) {
 	$self->list_vaults($self->get_vault_list(@_));
+    } else {
+	$self->list_archives($self->get_vault_inventory(@_));
     }
 }
 
@@ -136,4 +137,33 @@ sub show_vault {
     }
 }
 
+sub list_archives {
+    my $self = shift;
+}
+
+sub get_vault_inventory {
+    my ($self, $vault_name) = @_;
+    my $dir = $self->directory($vault_name);
+    $self->abend(EX_FAILURE, "no such vault: $vault_name")
+	unless defined $dir;
+    if (time - ($dir->last_sync_time || 0) >
+	$self->{_config}->get(qw(database inv ttl))) {
+	my $job = new App::Glacier::Job::InventoryRetrieval($self, $vault_name);
+	if ($job->is_completed) {
+	    my $res = $self->glacier_eval('get_job_output', $job->id);
+	    if ($self->lasterr) {
+		$self->abend(EX_FAILURE, "can't list vault $vault_name: ",
+			     $self->last_error_message);
+	    }
+#	    FIXME
+	    #$job->store([map { timestamp_unserialize($_) } @$res]);
+	} else {
+	    $self->abend(EX_TEMPFAIL, "inventory retrieval job for $vault_name initiated at " . $job->get('Created')->canned_format
+			 . "; please retry later to get the listing")
+		unless $dir->last_sync_time;
+	}
+	
+    }
+}
+
 1;
diff --git a/lib/App/Glacier/Command/Sync.pm b/lib/App/Glacier/Command/Sync.pm
new file mode 100644
index 0000000..bb9af9b
--- /dev/null
+++ b/lib/App/Glacier/Command/Sync.pm
@@ -0,0 +1,92 @@
+package App::Glacier::Command::Sync;
+
+use strict;
+use warnings;
+use App::Glacier::Command;
+use parent qw(App::Glacier::Command);
+use App::Glacier::DateTime;
+use App::Glacier::Timestamp;
+use App::Glacier::Job::InventoryRetrieval;
+use JSON;
+
+=head1 NAME
+
+glacier sync - synchronize vault inventory cache
+
+=head1 SYNOPSIS
+
+B<glacier sync> I<VAULT>
+
+=cut
+
+sub run {
+    my $self = shift;
+    $self->abend(EX_USAGE, "one argument expected") unless $#_ == 0;
+    my $vault_name = shift;
+
+    my $dir = $self->directory($vault_name);
+    my $job = new App::Glacier::Job::InventoryRetrieval($self, $vault_name);
+    if ($job->is_completed) {
+	my $res = $self->glacier_eval('get_job_output', $vault_name, $job->id);
+	if ($self->lasterr) {
+	    $self->abend(EX_FAILURE, "can't list vault $vault_name: ",
+			 $self->last_error_message);
+	}
+	$res = decode_json($res);
+	$self->_sync($dir, [map { timestamp_unserialize($_) }
+			        @{$res->{ArchiveList}}]);
+    } else {
+	$self->abend(EX_TEMPFAIL,
+		     "inventory retrieval job for $vault_name initiated at " .
+		     $job->get('CreationDate')->canned_format
+			 . "; please retry later to get the listing")
+	    unless $dir->last_sync_time;
+    }
+}
+
+sub _sync {
+    my ($self, $dir, $invref) = @_;
+    my %arch;
+
+    @arch{map { $_->{ArchiveId} } @{$invref}} = @{$invref};
+	  
+    # 1. Iterate over records in the invdb
+    # 2. For each record, see if its ArchiveID is present in the input array
+    # 2.1. If so, retain it, and remove the item from the input
+    # 2.2. Otherwise, remove it
+    # 3. For each remaining element in the input
+    # 3.1. Add the record to the DB
+
+    $dir->foreach(sub {
+	my ($key, $val) = @_;
+	for (my $i = 0; $i <= $#{$val}; ) {
+	    if (exists($arch{$val->[$i]{ArchiveId}})) {
+		delete $arch{$val->[$i]{ArchiveId}};
+		$i++
+	    } else {
+		splice(@{$val}, $i, 1);
+	    }
+	}
+	$dir->delete($key) unless @{$val};
+		  });
+
+    while (my ($aid, $val) = each %arch) {
+	my $file_name;
+	
+	if (exists($self->{_name_decoder})) {
+	    $file_name = &{$self->{_name_decoder}}($val);
+	} else {
+	    $file_name = $val->{ArchiveDescription};
+	}
+	if ($file_name eq '') {
+	    $file_name = $dir->tempname();
+	}
+
+	$dir->add_version($file_name, $val);
+    }
+}
+    
+1;
+
+    
+    
diff --git a/lib/App/Glacier/DB.pm b/lib/App/Glacier/DB.pm
index 91e70f3..b522cc1 100644
--- a/lib/App/Glacier/DB.pm
+++ b/lib/App/Glacier/DB.pm
@@ -1,4 +1,6 @@
 package App::Glacier::DB;
+use strict;
+use warnings;
 require Exporter;
 use parent 'Exporter';
 use JSON;
@@ -35,13 +37,10 @@ sub new {
     if ($v = delete $_{encoding}) {
 	croak "unsupported encoding $v"
 	    unless exists $transcode{$v};
-    } else {
-	$v = 'storable';
+	$self->{_encode} = $transcode{$v}[ENCODE];
+	$self->{_decode} = $transcode{$v}[DECODE];
     }
 
-    $self->{_encode} = $transcode{$v}[ENCODE];
-    $self->{_decode} = $transcode{$v}[DECODE];
-
     if (keys(%_)) {
 	croak "unrecognized parameters: ".join(', ', keys(%_));
     }
@@ -51,11 +50,13 @@ sub new {
 
 sub decode {
     my ($self, $val) = @_;
+    return $val unless defined($self->{_decode});
     return &{$self->{_decode}}($val);
 }
 
 sub encode {
     my ($self, $val) = @_;
+    return $val unless defined($self->{_encode});
     return &{$self->{_encode}}($val);
 }
 
diff --git a/lib/App/Glacier/DB/GDBM.pm b/lib/App/Glacier/DB/GDBM.pm
index 44d7823..6110ab7 100644
--- a/lib/App/Glacier/DB/GDBM.pm
+++ b/lib/App/Glacier/DB/GDBM.pm
@@ -4,6 +4,7 @@ use strict;
 use warnings;
 use parent qw(App::Glacier::DB);
 use GDBM_File;
+use Carp;
 
 sub new {
     my $class = shift;
@@ -11,8 +12,8 @@ sub new {
     local %_ = @_;
     my %map;
     my $mode = delete $_{mode} || 0644;
-    tie %map, 'GDBM_FILE', $filename, GDBM_WRCREAT, $mode;
-    my $self = $class->SUPER::new($filename, %_);
+    tie %map, 'GDBM_File', $filename, GDBM_WRCREAT, $mode;
+    my $self = $class->SUPER::new(%_);
     $self->{_map} = \%map;
     return $self;
 }
@@ -38,4 +39,12 @@ sub delete {
     delete $self->{_map}{$key};
 }
 
+sub foreach {
+    my ($self, $code) = @_;
+    croak "argument must be a CODE" unless ref($code) eq 'CODE';
+    while (my ($key, $val) = each %{$self->{_map}}) {
+	&{$code}($key, $self->decode($val));
+    }
+}
+
 1;
diff --git a/lib/App/Glacier/Directory.pm b/lib/App/Glacier/Directory.pm
new file mode 100644
index 0000000..c16f8df
--- /dev/null
+++ b/lib/App/Glacier/Directory.pm
@@ -0,0 +1,81 @@
+package App::Glacier::Directory;
+use strict;
+use warnings;
+require App::Glacier::DB::GDBM;
+use parent 'App::Glacier::DB::GDBM';
+use Carp;
+
+use constant DB_INFO_KEY => ';00INFO';
+    
+# locate(FILE, VERSION)
+sub locate {
+    my ($self, $file, $version) = @_;
+    $version = 1 unless defined $version;
+    my $rec = $self->SUPER::retrieve($file);
+    return undef unless defined $rec || $version-1 > $#{$rec};
+    return wantarray ? ($rec->[$version-1], $version) : $rec->[$version-1];
+}
+
+sub info {
+    my ($self, $key, $val) = @_;
+    my $rec = $self->retrieve(DB_INFO_KEY);
+    if ($val) {
+	$rec->{$key} = $val;
+	$self->SUPER::store(DB_INFO_KEY, $rec);
+    } elsif (!defined($rec)) {
+	return undef;
+    }
+    return $rec->{$key};
+}
+
+sub last_sync_time {
+    my ($self) = @_;
+    return $self->info('SyncTimeStamp');
+}
+
+sub foreach {
+    my ($self, $code) = @_;
+    $self->SUPER::foreach(sub {
+	                      my ($k, $v) = @_;
+			      &{$code}($k, $v) unless $k eq DB_INFO_KEY;
+			  });
+}
+	    
+sub add_version {
+    my ($self, $file_name, $val) = @_;
+    my $rec = $self->retrieve($file_name);
+    if ($rec) {
+	my $t = $val->{CreationDate}->epoch;
+	my $i;
+	for ($i = 0; $i <= $#{$rec}; $i++) {
+	    last if $t <= $rec->[$i]{CreationDate}->epoch;
+	}
+	splice(@{$rec}, $i, 0, $val);
+    } else {
+	$rec = [ $val ];
+    }
+    $self->SUPER::store($file_name, $rec);
+}
+
+sub tempname {
+    my ($self, $namelen) = @_;
+    $namelen = 10 unless defined $namelen; 
+    my @alphabet =
+	split //,
+	      '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
+    my @name;
+
+    for (my $i = 0; $i < $namelen; $i++) {
+	push @name, rand($#alphabet);
+    }
+    my @orig = @name;
+    my $s;
+    while ($self->has($s = 'TMP_'.join('', map { $alphabet[$_] } @name))) {
+	for (my $i = 0; ; $i++) {
+	    die "all permutations exhausted" if ($i > $namelen);
+	    $name[$i] = ($name[$i] + 1) % @alphabet;
+	    last if $name[$i] != $orig[$i];
+	}
+    }
+    return $s;
+}
diff --git a/lib/App/Glacier/Glob.pm b/lib/App/Glacier/Glob.pm
index 6859e33..ac6a359 100644
--- a/lib/App/Glacier/Glob.pm
+++ b/lib/App/Glacier/Glob.pm
@@ -1,4 +1,6 @@
 package App::Glacier::Glob;
+use strict;
+use warnings;
 use Exporter;
 use parent 'Exporter';
 use Carp;
diff --git a/lib/App/Glacier/Job.pm b/lib/App/Glacier/Job.pm
index d570c66..37d724b 100644
--- a/lib/App/Glacier/Job.pm
+++ b/lib/App/Glacier/Job.pm
@@ -1,8 +1,12 @@
 package App::Glacier::Job;
+use strict;
+use warnings;
 require Exporter;
 use parent qw(Exporter);
 use Carp;
-    
+use App::Glacier::Command;
+use App::Glacier::Timestamp;
+
 # new(CMD, VAULT, KEY, INIT)
 
 sub new {
@@ -26,22 +30,40 @@ sub _get_job {
 	my $job = $db->retrieve($self->{_key});
 	if (!$job) {
 	    my $jid = $self->{_cmd}->glacier_eval(@{$self->{_init}});
-	    if ($self->lasterr) {
-		$self->abend(EX_FAILURE,
-			     "can't create job: ", $self->last_error_message);
+	    if ($self->{_cmd}->lasterr) {
+		if ($self->{_cmd}->lasterr('code') == 404) {
+		    $self->{_cmd}->abend(EX_TEMPFAIL, "vault is empty");
+		} else {
+		    $self->{_cmd}->abend(EX_FAILURE,
+					 "can't create job: ",
+					 $self->{_cmd}->lasterr('code'),
+					 $self->{_cmd}->last_error_message);
+		}
 	    }
-	    $job = { jid => $jid };
+	    $job = { JobId => $jid, Completed => 0 };
 	    $db->store($self->{_key}, $job);
 	}
-	
-	if (!exists($job->{job}) || !$job->{job}{Completed}) {
+
+	if (!$job->{Completed}) {
 	    my $res = $self->{_cmd}->glacier_eval('describe_job',
 						  $self->{_vault},
-						  $job->{jid});
-	    unless ($self->lasterr) {
-		$db->store($self->{_key}, { jid => $jid,
-					    job => $res });
-	    }
+						  $job->{JobId});
+	    croak "describe_job returned wrong datatype for \"$job->{JobId}\""
+		unless ref($res) eq 'HASH';
+	    if ($self->{_cmd}->lasterr) {
+		if ($self->{_cmd}->lasterr('code') == 404) {
+		    $db->delete($self->{_key});
+		    return $self->_get_job;
+		} else {
+		    $self->{_cmd}->abend(EX_UNAVAILABLE,
+					 "can't describe job $job->{JobId}: ",
+					 $self->{_cmd}->last_error_message);
+		}
+	    } else {
+		$res = timestamp_unserialize($res);
+		$db->store($self->{_key}, $res);
+		$job = $res;
+	    }		
 	}
 	$self->{_job} = $job;
     }
@@ -51,14 +73,20 @@ sub _get_job {
 sub id {
     my $self = shift;
     my $job = $self->_get_job;
-    return $job->{jid};
+    return $job->{JobId};
 }
 
 sub get {
     my ($self, $key) = @_;
     my $job = $self->_get_job;
-    return undef unless exists $job->{job}{$key};
-    return $job->{job}{$key};
+    return undef unless exists $job->{$key};
+    return $job->{$key};
+}
+
+sub is_completed {
+    my $self = shift;
+    my $db = $self->_get_db;
+    return ($self->get('StatusCode') || '') eq 'Succeeded';
 }
 
 sub forget {
diff --git a/lib/App/Glacier/Job/ArchiveRetrieval.pm b/lib/App/Glacier/Job/ArchiveRetrieval.pm
index 5534e0d..649658e 100644
--- a/lib/App/Glacier/Job/ArchiveRetrieval.pm
+++ b/lib/App/Glacier/Job/ArchiveRetrieval.pm
@@ -1,4 +1,6 @@
 package App::Glacier::Job::ArchiveRetrieval;
+use strict;
+use warnings;
 
 require App::Glacier::Job;
 use parent qw(App::Glacier::Job);
diff --git a/lib/App/Glacier/Job/FileRetrieval.pm b/lib/App/Glacier/Job/FileRetrieval.pm
index 717b082..b8b5607 100644
--- a/lib/App/Glacier/Job/FileRetrieval.pm
+++ b/lib/App/Glacier/Job/FileRetrieval.pm
@@ -1,4 +1,6 @@
 package App::Glacier::Job::FileRetrieval;
+use strict;
+use warnings;
 
 require App::Glacier::Job::ArchiveRetrieval;
 use parent qw(App::Glacier::Job::ArchiveRetrieval);
diff --git a/lib/App/Glacier/Job/InventoryRetrieval.pm b/lib/App/Glacier/Job/InventoryRetrieval.pm
index f0cc1a7..a42f806 100644
--- a/lib/App/Glacier/Job/InventoryRetrieval.pm
+++ b/lib/App/Glacier/Job/InventoryRetrieval.pm
@@ -1,4 +1,6 @@
 package App::Glacier::Job::InventoryRetrieval;
+use strict;
+use warnings;
 
 require App::Glacier::Job;
 use parent qw(App::Glacier::Job);
@@ -11,3 +13,4 @@ sub new {
     return $class->SUPER::new($cmd, $vault, $vault,
 			   [ 'initiate_inventory_retrieval', $vault, 'JSON' ]);
 }
+
diff --git a/lib/App/Glacier/Timestamp.pm b/lib/App/Glacier/Timestamp.pm
index d89d8b4..cb60582 100644
--- a/lib/App/Glacier/Timestamp.pm
+++ b/lib/App/Glacier/Timestamp.pm
@@ -5,12 +5,29 @@ use Carp;
 our @ISA = qw(Exporter);
 our @EXPORT = qw(timestamp_serialize timestamp_unserialize);
 use DateTime::Format::ISO8601;
+use App::Glacier::DateTime;
+use Storable qw(dclone);
 
 sub _to_timestamp {
     my $obj = shift;
-    foreach my $attr (@_) {
-	if (exists($obj->{$attr}) && defined($obj->{$attr})) {
-    	    $obj->{$attr} = bless DateTime::Format::ISO8601->parse_datetime($obj->{$attr}), 'App::Glacier::DateTime';
+    if (ref($obj) eq 'ARRAY') {
+	foreach my $s (@{$obj}) {
+	    _to_timestamp($s, @_);
+	}
+    } else {
+	foreach my $attr (@_) {
+	    if (exists($obj->{$attr}) && defined($obj->{$attr})) {
+		$obj->{$attr} = bless DateTime::Format::ISO8601->parse_datetime($obj->{$attr}), 'App::Glacier::DateTime';
+	    }
+	}
+	while (my ($k, $val) = each %{$obj}) {
+	    if (ref($val) eq 'HASH') {
+		_to_timestamp($val, @_);
+	    } elsif (ref($val) eq 'ARRAY') {
+		foreach my $x (@{$val}) {
+		    _to_timestamp($x, @_);
+		}
+	    }
 	}
     }
     return $obj;
@@ -18,9 +35,24 @@ sub _to_timestamp {
 
 sub _from_timestamp {
     my $obj = shift;
-    foreach my $attr (@_) {
-	if (exists($obj->{$attr}) && defined($obj->{$attr})) {
-    	    $obj->{$attr} = $obj->{$attr}->strftime('%Y-%m-%dT%H:%M:%SZ');
+    if (ref($obj) eq 'ARRAY') {
+	foreach my $s (@{$obj}) {
+	    _from_timestamp($s, @_);
+	}
+    } else {
+	foreach my $attr (@_) {
+	    if (exists($obj->{$attr}) && defined($obj->{$attr})) {
+		$obj->{$attr} = $obj->{$attr}->strftime('%Y-%m-%dT%H:%M:%SZ');
+	    }
+	}
+	while (my ($k, $val) = each %{$obj}) {
+	    if (ref($val) eq 'HASH') {
+		_from_timestamp($val, @_);
+	    } elsif (ref($val) eq 'ARRAY') {
+		foreach my $x (@{$val}) {
+		    _from_timestamp($x, @_);
+		}
+	    }
 	}
     }
     return $obj;
@@ -29,11 +61,11 @@ sub _from_timestamp {
 my @attrnames = ('CreationDate', 'CompletionDate', 'LastInventoryDate');
 
 sub timestamp_serialize {
-    return _from_timestamp(shift, @attrnames);
+    return _from_timestamp(dclone(shift), @attrnames);
 }
 
 sub timestamp_unserialize {
-    return _to_timestamp(shift, @attrnames);
+    return _to_timestamp(dclone(shift), @attrnames);
 }
 
 1;