Fix 'ls', and add a --recursive flag.

2 files changed, 79 insertions, 35 deletions

diff --git a/cli/icevault b/cli/icevault
index 20a8f63..3c31f1d 100755
--- a/cli/icevault
+++ b/cli/icevault
@@ -403,7 +403,7 @@ sub fill($$@) {
 
 # Parse a scheme://hostname(:port)?/identity, and return the associated
 # file.
-sub getIdentityFile($) {
+sub identity2File($) {
     my $id = shift;
     $id =~ /\A([A-Za-z0-9-]+):\/\/([^\P{Graph}:\/]+(?::\d+)?)\/([^\P{Print}\/]+)\z/
         or error "Invalid identity C<%s>", $id;
@@ -418,6 +418,24 @@ sub getIdentityFile($) {
     return "$CONFIG{store}/$template";
 }
 
+# Parse a filename as a scheme://hostname(:port)?/identity.
+sub file2Identity($) {
+    my $filename = shift;
+    my $store = $CONFIG{store};
+    my $template = $CONFIG{template};
+
+    $template =~ s/(\%.)([^\%]*)\z/$1.quotemeta($2)/e;
+    $template =~ s{(.*?)\%(.)}{$2 eq '%' ? '%' :
+                               $2 eq 's' ? quotemeta($1).'(?<s>[A-Za-z0-9-]+)' :
+                               $2 eq 'h' ? quotemeta($1).'(?<h>[^\P{Graph}:\/]+(?::\d+)?)' :
+                               $2 eq 'i' ? quotemeta($1).'(?<i>[^\P{Print}\/]+)' :
+                               die "Invalid placeholder %$1"}ge;
+    my $pattern = qr/\A\Q$store\/\E$template\z/;
+    myprintf \*STDERR, "Using regexp C<%s>", "$pattern" if $CONFIG{debug};
+    $filename =~ $pattern or die;
+    return "$+{s}://$+{h}/$+{i}";
+}
+
 # Decrypt the given identity file.  In scalar context, return the
 # 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
@@ -644,6 +662,45 @@ sub commit($@) {
     mysystem @GIT, 'commit', '-m', $msg, '--', @filenames;
 }
 
+# List all identites matching the given prefixes, along with their
+# filename
+sub list(@) {
+    my @args = @_;
+
+    my @matches;
+    if (!@args) {
+        @matches = map { my $file = $LOCALE->decode($_); { filename => $file, id => file2Identity $file } }
+                       myglob(undef, undef, undef);
+        unless ($CONFIG{recursive}) {
+            $_->{id} =~ s/:\/\/.*// foreach @matches; # keep the scheme only
+        }
+    }
+    else {
+        foreach my $prefix (@args) {
+            my @matches1 = map { my $file = $LOCALE->decode($_); { filename => $file, id => file2Identity $file } }
+                               matches($prefix);
+            if ($CONFIG{recursive}) {
+                # don't remove suffix
+            } elsif ($prefix =~ /\A[A-Za-z0-9-]+:\/\/[^\P{Graph}:\/]+(?::\d+)?\/[^\P{Print}\/]+\z/) {
+                @matches1 = grep { $_->{id} =~ /\A\Q$prefix\E\z/ } @matches1;
+            } elsif ($prefix =~ /\A([A-Za-z0-9-]+:\/\/[^\P{Graph}\/]+)\/?\z/) {
+                my $x = $1;
+                @matches1 = grep defined, map { $_->{id} !~ s/\A\Q$x\E\/// ? undef : $_ } @matches1;
+            } elsif ($prefix =~ /\A([A-Za-z0-9-]+)(:\/{0,2})?\z/) {
+                my $x = $1;
+                @matches1 = grep defined, map { $_->{id} !~ s/\A\Q$x\E:\/\/// ? undef :
+                                                $_->{id} !~ s/\/[^\P{Print}\/]+\z// ? undef : $_ } @matches1;
+            } else {
+                @matches1 = ();
+            }
+            error "No such identity C<%s>", $prefix unless @matches1;
+            push @matches, @matches1;
+        }
+    }
+    map { $_->{filename} =~ /\A(\/\p{Print}+)\z/ or error "Insecure C<%s>", $_->{filename};
+          $_->{filename} = $1; $_; # untaint $_->{filename}
+        } @matches;
+}
 
 
 #######################################################################
@@ -660,7 +717,7 @@ my @USAGE = (
     edit => "scheme://hostname/identity",
     git => "GIT-COMMAND [GIT-ARG ...]",
     insert => "[-f, --force] [-s, --socket=PATH] [identity]",
-    ls => "[-0, --zero] [scheme://[hostname/[identity]]]",
+    ls => "[-0, --zero] [-r, --recursive] [scheme://[hostname/[identity]] ...]",
     reencrypt => "[scheme://[hostname/[identity]] ...]",
 );
 
@@ -774,7 +831,7 @@ elsif ($COMMAND eq 'insert') {
             if ($r !~ /\A[^\P{Print}\/]+\z/) {
                 myprintf \*STDERR, "Invalid identity: C<%s>", $r;
             }
-            elsif (-e getIdentityFile "$uri/$r" and !$CONFIG{force}) {
+            elsif (-e identity2File "$uri/$r" and !$CONFIG{force}) {
                 myprintf \*STDERR, "Identity C<%s> already exists", "$uri/$r";
             }
             else {
@@ -784,7 +841,7 @@ elsif ($COMMAND eq 'insert') {
         }
     }
 
-    my $filename = getIdentityFile "$uri/$id";
+    my $filename = identity2File "$uri/$id";
     error "Identity C<%s> already exists", "$uri/$id" if -e $filename and !$CONFIG{force};
 
     my @passIdx = grepIdx { $_->{type} eq 'password' } @{$form->{fields}};
@@ -848,7 +905,7 @@ elsif ($COMMAND eq 'fill') {
     usage() unless $#ARGV == 0;
 
     my $id = shift;
-    my $filename = getIdentityFile $id;
+    my $filename = identity2File $id;
     error "No such identity C<%s>", $id unless -f $filename;
 
     my $uri = &connect($CONFIG{socket});
@@ -997,7 +1054,7 @@ elsif ($COMMAND eq 'dump') {
     usage() unless $#ARGV == 0;
 
     my $id = shift;
-    my $filename = getIdentityFile $id;
+    my $filename = identity2File $id;
     error "No such identity C<%s>", $id unless -f $filename;
 
     my $form = loadIdentityFile $filename;
@@ -1012,7 +1069,7 @@ elsif ($COMMAND eq 'edit') {
     usage() unless $#ARGV == 0;
 
     my $id = shift;
-    my $filename = getIdentityFile $id;
+    my $filename = identity2File $id;
     error "No such identity C<%s>", $id unless -f $filename;
     require 'File/Temp.pm';
 
@@ -1064,7 +1121,7 @@ elsif ($COMMAND eq 'clip') {
     usage() unless $#ARGV == 0;
 
     my $id = shift;
-    my $filename = getIdentityFile $id;
+    my $filename = identity2File $id;
     error "No such identity C<%s>", $id unless -f $filename;
 
     my $form = loadIdentityFile $filename;
@@ -1081,30 +1138,12 @@ elsif ($COMMAND eq 'clip') {
 }
 
 elsif ($COMMAND eq 'ls') {
-    getopts( 'zero|0' => "-0, --zero\tUse NUL instead of newline as line delimiter" );
-    usage() if $#ARGV > 0;
-
-    my $prefix = shift @ARGV;
-    my @matches = complete $prefix // '', 1;
-
-    if (!defined $prefix) {
-        s/:\/\/.*// foreach @matches;
-    } elsif ($prefix =~ /\A[A-Za-z0-9-]+:\/\/[^\P{Graph}:\/]+(?::\d+)?\/[^\P{Print}\/]+\z/) {
-        @matches = grep /\A\Q$prefix\E\z/, @matches;
-    } elsif ($prefix =~ /\A([A-Za-z0-9-]+:\/\/[^\P{Graph}\/]+)\/?\z/) {
-        my $x = $1;
-        @matches = grep defined, map { !s/\A\Q$x\E\/// ? undef : $_ } @matches;
-    } elsif ($prefix =~ /\A([A-Za-z0-9-]+)(:\/{0,2})?\z/) {
-        my $x = $1;
-        @matches = grep defined, map { !s/\A\Q$x\E:\/\/// ? undef :
-                                       !s/\/[^\P{Print}\/]+\z// ? undef : $_ } @matches;
-    } else {
-        @matches = ();
-    }
-    error "No such identity C<%s>", $prefix // '' unless @matches;
+    getopts( 'zero|0'      => "-0, --zero     \tUse NUL instead of newline as line delimiter"
+           , 'recursive|r' => "-r, --recursive\tList identities recursively"
+    );
 
     my $delim = $CONFIG{zero} ? "\0" : "\n";
-    my %matches = map {($_ => 1)} @matches;
+    my %matches = map {($_->{id} => 1)} list(@ARGV);
     print $LOCALE->encode($_), $delim foreach sort keys %matches;
 }
 
@@ -1134,16 +1173,18 @@ elsif ($COMMAND eq 'reencrypt') {
     my @filenames;
     foreach my $filename (@matches) {
         $filename = $LOCALE->decode($filename);
-        myprintf "Reencrypting C<%s>", $filename;
+        my $id = file2Identity($filename);
+        myprintf "Reencrypting C<%s>", $id;
 
         $filename =~ /\A(\/\p{Print}+)\z/ or error "Insecure C<%s>", $filename;
         $filename = $1; # untaint $filename
 
         copyIdentityFile $filename, $filename;
-        push @filenames, $filename;
+        push @filenames, { filename => $filename, id => $id };
     }
 
-    commit 'Reencryption.', @filenames;
+    commit( "Reencryption.".$filenames[0]->{id}.(scalar @filenames > 1 ? ' ...' : '')
+          , map {$_->{filename}} @filenames );
 }
 
 else {
diff --git a/cli/icevault.1 b/cli/icevault.1
index b0308a5..d49601f 100644
--- a/cli/icevault.1
+++ b/cli/icevault.1
@@ -123,9 +123,12 @@ socket.  If the flag \fB-f\fR is set, override the \fIidentity\fR file
 if it already exists (the default is to abort).
 
 .TP
-.B ls\fR [\fB-0\fR, \fB--zero\fR] [\fIscheme\fR://[\fIhostname\fR/[\fIidentity\fR]]]
+.B ls\fR [\fB-0\fR, \fB--zero\fR] [\fB-r\fR, \fB--recursive\fR] [\fIscheme\fR://[\fIhostname\fR/[\fIidentity\fR]] ...]
 List content of the given identity prefix.  If the flag \fB-0\fR is set,
-use NUL as line separator.
+use NUL as line separator.  If the flag \fB-r\fR is set and
+\fIidentity\fR (resp. \fIhostname\fR/\fIidentity\fR) is omitted, list
+recursively all identities under \fIscheme\fR://\fIhostname\fR/ (resp.
+\fIscheme\fR://).
 
 .TP
 .B reencrypt\fR [\fIscheme\fR://[\fIhostname\fR/[\fIidentity\fR]] ...]