| Subject: | Please add a method to GnuPG::Handles objects to process multiple handles at once. |
Hi there,
A common use of GnuPG in scripts is to parse the output and process it
as it comes. Therefore the following pattern is very common (at least
in my code) when working with GnuPG::Interface.
my $pid = $gpg->list_public_keys(handles => $handles, command_args => ...);
while ($handles->{stdout}->getlines()) {
# process line
}
waitpid $pid, 0;
$handles->{stdout}->close();
This is fine as it doesn't involve anything complicated; however it's
far more tricky when two IO::Handle objects have to be processed
simultaneously, since IO::Select has to enter into the picture.
Given that it's not so uncommon to have to process two handles at once
(force instance the standard output and the status descriptor when
editing a key), I propose to add the following method 'communicate'
(heavily inspired from caff's 'readwrite_gpg' function [1]) to
GnuPG::Handles objects.
$handles->communicate( writefd => "Some data to write in\n"
, readfd => sub { push @data, $_ }
, OPTIONS );
* writefd (resp. readfd) are input (resp. output) data members of
GnuPG::Handles objects. Possible values are qw/stdin passphrase
command/ (resp. qw/stdout stderr status logger/).
* When input data members are given, their value must be a scalar which
is written to the corresponding handle.
* When output data members are given, their value must be a reference
to either a subroutine (used as a callback processing each line,
bound as $_, which is read on the handle) or a regular expression
(which is matched against each line read on the handle). If the
callback returns a non-zero value, or if the regular expression
matches the current line, then the method exits.
* In list context, this method returns a hash where keys are the given
output data members, and values are string representing the data
read.
* The only option is keep_handles_open (default: undefined) which, if
set, don't autoclose the handles after writing/reading or when the
callback aborts.
Examples:
# Dump output and status FDs:
my %output = $handles->communicate();
print "Stdout is:\n$output{stdout}\nStatus is:\n$output{status}\n";
# Get the first public key found in a listing
$handles->communicate( stdout => sub {
if (/^pub:.:(?:[^:]*:){2,2}([^:]+):/) {
$key = $1;
return 1;
}
return;
});
# Store all public key found in a listing:
$handles->communicate( stdout => sub {
push @key, $1 if /^pub:.:(?:[^:]*:){2,2}([^:]+):/;
return;
});
# Select the first UID when editing a key, and keep the handles open:
$handles->communicate( command => "uid 1\n", status => qr/^\[GNUPG:\] GET_LINE keyedit\.prompt$/, keep_handles_open => 1);
# Store all UIDs as well as attributes
$handles->communicate( stdout => sub {
push @uids, $1 if /^(?:uid|uat):.:.*:[0-9A-F]{40}::([^:]+):$/
return;
}, status => sub {
push @photos, {key => $1, size => $2, revoked => $3 & 0x02}
if /^\[GNUPG:\] ATTRIBUTE [0-9A-F]{24}([0-9A-F]{16}) (\d+) 1 1 1 \d+ \d+ (\d+)$/
return;
});
# Delete a sig in the keyedit prompt, but remember which:
$handles->communicate( command => "yes\n", keep_handles_open => 1, status => qr/^\[GNUPG:\] GET_BOOL keyedit\.delsig\.(?:unknown|invalid|valid)$/, stdout => sub {
push @sigs, $1 if /^sig:.::\d+:([0-9A-F]{16}):\d+:.*:(1[0-3]|30)[lx]$/
return;
});
I attach a proof of concept (again, heavily inspired from caff's
'readwrite_gpg' function [1]). Feedback welcome.
Thanks,
cheers,
--
Guilhem.
[1] http://pgp-tools.alioth.debian.org/
| Subject: | communicate.pl |
sub communicate($%) {
my $self = shift;
my %args = @_;
my @wfds = qw/stdin passphrase command/; # known input handles
my @rfds = qw/stdout stderr status logger/; # known output handles
# ignore naked globs and unkown handles; ignore inputs we are not writing to
@wfds = grep {defined $self->{$_} and ref $self->{$_} eq 'IO::Handle' and defined $args{$_}} @wfds;
@rfds = grep {defined $self->{$_} and ref $self->{$_} eq 'IO::Handle'} @rfds;
$self->{$_}->blocking(0) foreach (@wfds, @rfds);
my $ws = IO::Select->new( @$self{@wfds} );
my $rs = IO::Select->new( @$self{@rfds} );
my %names = map { $self->{$_} => $_ } (@rfds,@wfds);
my %left = map {$_ => length $args{$_}} @wfds; # #bytes left to write
my %output = map {$_ => ''} @rfds;
my $done = 0;
while ($rs->count() or $ws->count()) {
my @ready = IO::Select::select($rs, $ws, undef, $done ? 0 : 1);
$_ //= [] foreach @ready[0,1];
# if we exited due to an aborted callback, we keep processing
# the other handles (but select without timeout) to give a
# chance for the related data (e.g. interleaving handles) to
# show up
last if $done and !@{$ready[0]} and !@{$ready[1]};
foreach my $fd (@{$ready[0]}) { # readers
my $name = $names{$fd};
if ($fd->eof) { # done reading from $fd
$rs->remove($fd);
$fd->close() unless $args{keep_handles_open};
next;
}
foreach my $line ($fd->getlines()) {
$output{$name} .= $line if wantarray;
if (defined $args{$name}) { # callback
local $_ = $line;
my $r = ref $args{$name} eq 'CODE' ? $args{$name}->() :
ref $args{$name} eq 'Regexp' ? $line =~ /$args{$name}/ :
die "Unrecognized reference for $name: ".(ref $args{$name});
if ($r) {
$done = 1;
$rs->remove($fd); # stop processing that fd
$fd->close() unless $args{keep_handles_open};
last; # exit the getlines
}
}
}
}
foreach my $fd (@{$ready[1]}) { # writers
my $name = $names{$fd};
if ($left{$name}) {
my $written = $fd->syswrite($args{$name}, $left{$name}, -$left{$name});
$left{$name} -= $written;
};
unless ($left{$name}) { # done writing in $fd
$ws->remove($fd);
$fd->close() unless $args{keep_handles_open};
}
}
}
return %output if wantarray;
}