Added a 'ls' command.

2 files changed, 119 insertions, 3 deletions

diff --git a/icevault b/icevault
index 943f1bf..7127c23 100755
--- a/icevault
+++ b/icevault
@@ -75,6 +75,7 @@ sub usage($) {
              ."  or: $0 [OPTIONS] dump scheme://hostname/identity\n"
              ."  or: $0 [OPTIONS] clip scheme://hostname/identity\n"
              ."  or: $0 [OPTIONS] edit scheme://hostname/identity\n"
+             ."  or: $0 [OPTIONS] ls [scheme://[hostname/[identity]]]\n"
              . "Consult the manual page for more information.\n";
     exit $rv;
 }
@@ -222,6 +223,76 @@ sub sendCommand(@) {
     getResponse();
 }
 
+# Get all identities with the given $prefix.  If there are multiple
+# matches and $all is false, limit the output to one depth.
+sub complete($;$) {
+    my $prefix = shift // '';
+    my $all = shift;
+    require 'File/Glob.pm';
+
+    my $pat = $CONFIG{store};
+    my ($s, $h, $i); # extract URI components from the prefix
+    if ($prefix =~ /\A([A-Za-z0-9-]+):\/\/([^\P{Graph}:\/]+(?::\d+)?)\/([^\P{Print}\/]*)\z/) {
+        ($s, $h, $i) = ($1, $2, $3);
+    } elsif ($prefix =~ /\A([A-Za-z0-9-]+):\/\/([^\P{Graph}\/]*)\z/) {
+        ($s, $h, $i) = ($1, $2, undef);
+    } elsif ($prefix =~ /\A([A-Za-z0-9-]*)(:\/?)?\z/) {
+        ($s, $h, $i) = ($1, (defined $2 ? '' : undef), undef);
+    } else {
+        exit;
+    }
+
+    # construct a glob pattern with these URI components
+    my ($gs, $gh, $gi) = ($s, $h, $i);
+    s/([\\\[\]\{\}\*\?\~])/\\$1/g foreach grep defined, ($gs, $gh, $gi); # escape meta chars
+
+    # add trailing wildcards
+    $gs .= '*' if defined $gs and !defined $gh;
+    $gh .= '*' if defined $gh and !defined $gi;
+    $gi .= '*' if defined $gi;
+
+    my $glob = $pat;
+    $glob =~ s/([\\\[\]\{\}\*\?\~])/\\$1/g;
+    $glob =~ s{\%(.)}{ $1 eq '%' ? '%' :
+                       $1 eq 's' ? $gs // '*' :
+                       $1 eq 'h' ? $gh // '*' :
+                       $1 eq 'i' ? $gi // '*' :
+                       die "Invalid placeholder %$1" }ge;
+
+    # construct regexp to extract the URI compontents of the matching URIs
+    my ($ps, $ph, $pi) = ($s, $h, $i);
+    $ps = defined $h ? qr/(?<s>\Q$s\E)/ : (defined $s and $s ne '') ? qr/(?<s>\Q$s\E[A-Za-z0-9-]*)/ : qr/(?<s>[A-Za-z0-9-]+)/;
+    $ph = defined $i ? qr/(?<h>\Q$h\E)/ : (defined $h and $h ne '') ? qr/(?<h>\Q$h\E[^\P{Graph}\/]*)/ : qr/(?<h>[^\P{Graph}\/]+)/;
+    $pi = (defined $i and $i ne '') ? qr/(?<i>\Q$i\E[^\P{Print}\/]*)/ : qr/(?<i>[^\P{Print}\/]+)/;
+
+    $pat =~ s/(\%.)([^\%]*)\z/$1.quotemeta($2)/e;
+    $pat =~ s{(.*?)\%(.)}{$2 eq '%' ? '%' :
+                          $2 eq 's' ? quotemeta($1).$ps :
+                          $2 eq 'h' ? quotemeta($1).$ph :
+                          $2 eq 'i' ? quotemeta($1).$pi :
+                          die "Invalid placeholder %$1"}ge;
+    $pat = qr/\A$pat\z/;
+
+    myprintf \*STDERR, "Using glob pattern C<%s>", $glob if $CONFIG{debug};
+    myprintf \*STDERR, "Using regexp C<%s>", "$pat"      if $CONFIG{debug};
+
+    my @matches;
+    foreach my $filename (File::Glob::bsd_glob($glob)) {
+        $LOCALE->decode($filename) =~ $pat or die "$filename doesn't match $pat";
+        push @matches, "$+{s}://$+{h}/$+{i}";
+    }
+    return @matches if $all or $#matches < 1;
+
+    if ($prefix =~ /\A[A-Za-z0-9-]+:\/\/[^\P{Graph}:\/]+(?::\d+)?\//) {
+    } elsif ($prefix =~ /\A[A-Za-z0-9-]+:\/\//) {
+        s#/[^\P{Print}\/]+\z#/# foreach @matches;
+    } elsif (defined $s) {
+        s#://[^\P{Graph}\/]+/[^\P{Print}\/]+\z#://# foreach @matches;
+    }
+    my %matches = map {( $_ => 1 )} @matches;
+    return keys %matches;
+}
+
 # Redact passwords, unless $CONFIG{'show-passwords'} is set.
 sub safeValue($;$) {
     my $field = shift;
@@ -450,7 +521,7 @@ sub sha256_file($) {
 
 #######################################################################
 
-GetOptions(\%CONFIG, qw/debug show-passwords|p socket|s=s help|?/) or usage(1);
+GetOptions(\%CONFIG, qw/debug show-passwords|p socket|s=s help|? zero|0/) or usage(1);
 usage(0) if $CONFIG{help};
 
 # Load configuration
@@ -473,7 +544,15 @@ usage(1) unless @ARGV;
 my $command = $ARGV[0] =~ /\A[A-Za-z0-9-]+:\/\//aa ? 'fill' : shift;
 
 # Process the commands
-if ($command eq 'insert') {
+if ($command eq '_complete') {
+    # used internaly for auto-completion
+    usage(1) unless $#ARGV == 0;
+    my $delim = $CONFIG{zero} ? "\0" : "\n";
+    print $LOCALE->encode($_), $delim foreach complete(shift @ARGV);
+    exit;
+}
+
+elsif ($command eq 'insert') {
     usage(1) unless $#ARGV < 1;
     my $uri = &connect($CONFIG{socket});
     myprintf "Importing HTML form from URI C<%s>", $uri;
@@ -776,13 +855,39 @@ elsif ($command eq 'clip') {
 
     my $pid = open my $fh, '|-', qw/xclip -loop 1 -selection clipboard/
         or error "Can't fork: %s", $!;
-    print $fh $LOCALE->encode($pw->{value});
+    print $fh encode_utf8($pw->{value});
     close $fh;
     waitpid $pid, 0;
     error "C<%s> exited with value %d", 'xclip', ($? >> 8) if $? and $? != -1;
     exit 0;
 }
 
+elsif ($command eq 'ls') {
+    usage(1) 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;
+
+    my $delim = $CONFIG{zero} ? "\0" : "\n";
+    my %matches = map {($_ => 1)} @matches;
+    print $LOCALE->encode($_), $delim foreach keys %matches;
+}
+
 else {
     myprintf "Unknown command: C<%s>", $command;
     usage(1);
diff --git a/icevault.1 b/icevault.1
index f2b3b76..e903b9c 100644
--- a/icevault.1
+++ b/icevault.1
@@ -13,6 +13,8 @@ IceVault \- IceVault client user interface
 .B icevault\fR [\fIOPTIONS\fR] \fBclip\fR \fIscheme\fR://\fIhostname\fR/\fIidentity\fR
 .br
 .B icevault\fR [\fIOPTIONS\fR] \fBedit\fR \fIscheme\fR://\fIhostname\fR/\fIidentity\fR
+.br
+.B icevault\fR [\fIOPTIONS\fR] \fBls\fR [\fIscheme\fR://[\fIhostname\fR/[\fIidentity\fR]]]
 
 
 .SH DESCRIPTION
@@ -93,6 +95,10 @@ editor exits, the file is reencrypted if the SHA-256 digest of its
 content differs.  Note that formatting and comments may not be preserved
 by subsequent updates of the \fIidentity\fR file.
 
+.TP
+.B icevault\fR [\fIOPTIONS\fR] \fBls\fR [\fIscheme\fR://[\fIhostname\fR/[\fIidentity\fR]]]
+List content of the given identity prefix.
+
 
 .SH OPTIONS
 .TP
@@ -119,6 +125,11 @@ there is no default profile) in the "~/.mozilla/firefox" directory.
 .B \-\-version
 Show the version number and exit.
 
+.TP
+.B \-0\fR, \fB\-\-zero
+With the \fBls\fR command, use NUL instead of newline as line delimiter.
+
+
 .SH CONFIGURATION FILE
 
 \fBicevault\fR reads it configuration from