1 files changed, 64 insertions, 2 deletions

diff --git a/cli/icevault b/cli/icevault
index 67e06ec..20a8f63 100755
--- a/cli/icevault
+++ b/cli/icevault
@@ -285,6 +285,30 @@ sub myglob(;$$$) {
     return File::Glob::bsd_glob($glob);
 }
 
+# Find identities matching a given prefix
+sub matches($) {
+    my $prefix = shift;
+
+    my ($s, $h, $i);
+    if (!defined $prefix) {
+    } elsif ($prefix =~ /\A([A-Za-z0-9-]+):\/\/([^\P{Graph}:\/]+(?::\d+)?)\/([^\P{Print}\/]*)\z/) {
+        ($s, $h, $i) = ($1, $2, ($3 eq '' ? undef : $3));
+    } elsif ($prefix =~ /\A([A-Za-z0-9-]+):\/\/([^\P{Graph}\/]*)\z/) {
+        ($s, $h, $i) = ($1, ($2 eq '' ? undef : $2), undef);
+    } elsif ($prefix =~ /\A([A-Za-z0-9-]*)(:\/?)?\z/) {
+        ($s, $h, $i) = ($1, undef, undef);
+    } else {
+        error "Invalid identity prefix C<%s>", $prefix;
+    }
+
+    s/([\\\[\]\{\}\*\?\~])/\\$1/g foreach grep defined, ($s, $h, $i); # escape meta chars
+
+    my @matches = myglob($s,$h,$i);
+    error "No matches for identity prefix C<%s>", $prefix unless @matches;
+    error "No such identity C<%s>", $prefix if defined $i and ! -f $matches[0];
+    return @matches;
+}
+
 # Get all identities with the given $prefix.  If there are multiple
 # matches and $all is false, limit the output to one depth more than the
 # longuest common prefix.
@@ -395,8 +419,9 @@ sub getIdentityFile($) {
 }
 
 # Decrypt the given identity file.  In scalar context, return the
-# YAML-parsed form; in void context, must be given a file handle (closed
-# afterwards) where to dump the (unparsed) decrypted content.
+# YAML-parsed form; in list context, return the list of the forked PID
+# and its standard output; in void context, must be given a file handle
+# (closed afterwards) where to dump the (unparsed) decrypted content.
 open my $NULL, '<', '/dev/null';
 sub loadIdentityFile($;$) {
     my ($filename, $fh) = @_;
@@ -407,6 +432,7 @@ sub loadIdentityFile($;$) {
                                , "<&".fileno($NULL)
                                , @GPG, qw/-o - --decrypt --/, $filename)
                 or error "Can't fork: %s", $!;
+    return ($pid, $fh) if wantarray;
     my $str = do { local $/ = undef; <$fh> } if defined wantarray;
     waitpid $pid, 0;
     error "C<%s> exited with value %d", $GPG[0], ($? >> 8) if $? and $? != -1;
@@ -462,6 +488,20 @@ sub saveIdentityFile($$) {
     }
 }
 
+# Copy the given filename to a new destination, and reencrypt it the
+# file.  The filenames may be identical since 'saveIdentityFile' uses a
+# temporary destination.
+sub copyIdentityFile($$) {
+    my ($oldname, $newname) = @_;
+
+    my ($pid, $fh) = loadIdentityFile $oldname;
+    saveIdentityFile($fh, $newname);
+
+    waitpid $pid, 0;
+    error "C<%s> exited with value %d", $GPG[0], ($? >> 8) if $? and $? != -1;
+    close $fh;
+}
+
 # Get the visible form list from the server, and croak if it's empty.
 sub getForms() {
     my $forms = sendCommand 'GETFORMS';
@@ -621,6 +661,7 @@ my @USAGE = (
     git => "GIT-COMMAND [GIT-ARG ...]",
     insert => "[-f, --force] [-s, --socket=PATH] [identity]",
     ls => "[-0, --zero] [scheme://[hostname/[identity]]]",
+    reencrypt => "[scheme://[hostname/[identity]] ...]",
 );
 
 if ($ARGV[0] eq '--help' or $ARGV[0] eq '-?') {
@@ -1084,6 +1125,27 @@ elsif ($COMMAND eq 'git') {
     exec {$GIT[0]} @GIT, @ARGV;
 }
 
+elsif ($COMMAND eq 'reencrypt') {
+    getopts();
+
+    my @matches = @ARGV ? map {matches($_)} @ARGV : myglob(undef, undef, undef);
+    error "No such identity C<%s>", $_ foreach grep { ! -f $_ } @matches;
+
+    my @filenames;
+    foreach my $filename (@matches) {
+        $filename = $LOCALE->decode($filename);
+        myprintf "Reencrypting C<%s>", $filename;
+
+        $filename =~ /\A(\/\p{Print}+)\z/ or error "Insecure C<%s>", $filename;
+        $filename = $1; # untaint $filename
+
+        copyIdentityFile $filename, $filename;
+        push @filenames, $filename;
+    }
+
+    commit 'Reencryption.', @filenames;
+}
+
 else {
     print STDERR "Usage: $NAME [COMMAND] [OPTION ...] [ARG ...]\n";
     error "Unknown command C<%s>.  Try C<%s> for more information.", $COMMAND, "$NAME --help";