3 # caff -- CA - fire and forget
5 # Copyright (c) 2004 Peter Palfrader <peter@palfrader.org>
9 # Redistribution and use in source and binary forms, with or without
10 # modification, are permitted provided that the following conditions
12 # 1. Redistributions of source code must retain the above copyright
13 # notice, this list of conditions and the following disclaimer.
14 # 2. Redistributions in binary form must reproduce the above copyright
15 # notice, this list of conditions and the following disclaimer in the
16 # documentation and/or other materials provided with the distribution.
17 # 3. The name of the author may not be used to endorse or promote products
18 # derived from this software without specific prior written permission.
20 # THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
21 # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
22 # OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
23 # IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
24 # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
25 # NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
26 # DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
27 # THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
28 # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
29 # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
35 use File
::Temp
qw{tempdir
};
42 my $VERSION = '0.0.0.1';
45 my $config = $ENV{'HOME'} . '/.caffrc';
46 -f
$config or die "No file $config present. See caffrc(5).\n";
47 unless (scalar eval `cat $config`) {
48 die "Couldn't parse $config: $EVAL_ERROR\n" if $EVAL_ERROR;
51 die ("caffhome is not defined.\n") unless defined $CONFIG{'caffhome'};
52 die ("owner is not defined.\n") unless defined $CONFIG{'owner'};
53 die ("email is not defined.\n") unless defined $CONFIG{'email'};
54 die ("keyid is not defined.\n") unless defined $CONFIG{'keyid'};
55 die ("keyid is not an array ref\n") unless (ref $CONFIG{'keyid'} eq 'ARRAY');
56 for my $keyid (@
{$CONFIG{'keyid'}}) {
57 $keyid =~ /^[A-Fa-z0-9]{16}$/ or die ("key $keyid is not a long (16 digit) keyid.\n");
59 @
{$CONFIG{'keyid'}} = map { uc } @
{$CONFIG{'keyid'}};
60 $CONFIG{'export-sig-age'}= 24*60*60 unless defined $CONFIG{'export-sig-age'};
61 $CONFIG{'keyserver'} = 'subkeys.pgp.net' unless defined $CONFIG{'keyserver'};
62 $CONFIG{'gpg'} = 'gpg' unless defined $CONFIG{'gpg'};
63 $CONFIG{'gpg-sign'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-sign'};
64 $CONFIG{'gpg-delsig'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-delsig'};
65 $CONFIG{'secret-keyring'} = $ENV{'HOME'}.'/.gnupg/secring.gpg' unless defined $CONFIG{'secret-keyring'};
70 print "[NOTICE] $line\n";
74 print "[INFO] $line\n";
78 #print "[DEBUG] $line\n";
82 #print "[trace] $line\n";
86 #print "[trace2] $line\n";
91 stdin
=> IO
::Handle
->new(),
92 stdout
=> IO
::Handle
->new(),
93 stderr
=> IO
::Handle
->new(),
94 status
=> IO
::Handle
->new() );
95 my $handles = GnuPG
::Handles
->new( %fds );
96 return ($fds{'stdin'}, $fds{'stdout'}, $fds{'stderr'}, $fds{'status'}, $handles);
99 sub readwrite_gpg
($$$$$%) {
100 my ($in, $inputfd, $stdoutfd, $stderrfd, $statusfd, %options) = @_;
102 trace
("Entering readwrite_gpg.");
104 my ($first_line, $dummy) = split /\n/, $in;
105 debug
("readwrite_gpg sends ".(defined $first_line ?
$first_line : "<nothing>"));
107 local $INPUT_RECORD_SEPARATOR = undef;
108 my $sout = IO
::Select
->new();
109 my $sin = IO
::Select
->new();
112 trace
("input is $inputfd; output is $stdoutfd; err is $stderrfd; status is ".(defined $statusfd ?
$statusfd : 'undef').".");
114 $inputfd->blocking(0);
115 $stdoutfd->blocking(0);
116 $statusfd->blocking(0) if defined $statusfd;
117 $stderrfd->blocking(0);
118 $sout->add($stdoutfd);
119 $sout->add($stderrfd);
120 $sout->add($statusfd) if defined $statusfd;
123 my ($stdout, $stderr, $status) = ("", "", "");
124 my $exitwhenstatusmatches = $options{'exitwhenstatusmatches'};
125 trace
("doign stuff until we find $exitwhenstatusmatches") if defined $exitwhenstatusmatches;
127 my ($readyr, $readyw, $written);
128 while ($sout->count() > 0 || (defined($sin) && ($sin->count() > 0))) {
129 if (defined $exitwhenstatusmatches) {
130 if ($status =~ /$exitwhenstatusmatches/m) {
131 trace
("readwrite_gpg found match on $exitwhenstatusmatches");
136 trace
("select waiting for ".($sout->count())." fds.");
137 ($readyr, $readyw, undef) = IO
::Select
::select($sout, $sin, undef, 1);
138 trace
("ready: write: ".(defined $readyw ?
scalar @
$readyw : 0 )."; read: ".(defined $readyr ?
scalar @
$readyr : 0));
139 for my $wfd (@
$readyw) {
140 if (length($in) != $offset) {
141 trace
("writing to $wfd.");
142 $written = $wfd->syswrite($in, length($in) - $offset, $offset);
145 if ($offset == length($in)) {
146 trace
("writing to $wfd done.");
147 unless ($options{'nocloseinput'}) {
149 trace
("$wfd closed.");
156 next unless (defined(@
$readyr)); # Wait some more.
158 for my $rfd (@
$readyr) {
160 trace
("reading from $rfd done.");
165 trace
("reading from $rfd.");
166 if ($rfd == $stdoutfd) {
168 trace2
("stdout is now $stdout\n================");
171 if (defined $statusfd && $rfd == $statusfd) {
173 trace2
("status is now $status\n================");
176 if ($rfd == $stderrfd) {
178 trace2
("stderr is now $stderr\n================");
183 trace
("readwrite_gpg done.");
184 return ($stdout, $stderr, $status);
188 my ($question, $default) = @_;
191 print $question,' ',($default ?
'[Y/n]' : '[y/N]'), ' ';
194 last if ((defined $answer) && (length $answer <= 1));
198 my $result = $default;
199 $result = 1 if $answer =~ /y/i;
200 $result = 0 if $answer =~ /n/i;
208 my $KEYEDIT_PROMPT = '^\[GNUPG:\] GET_LINE keyedit.prompt';
209 my $KEYEDIT_DELUID_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.uid.okay';
210 my $KEYEDIT_DELSIG_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.delsig';
211 my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = '^\[GNUPG:\] (GET_BOOL keyedit.delsig|GET_LINE keyedit.prompt)';
212 my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey';
215 my $USER_AGENT = "caff $VERSION - (c) 2004 Peter Palfrader";
217 my $KEYSBASE = $CONFIG{'caffhome'}.'/keys';
218 my $GNUPGHOME = $CONFIG{'caffhome'}.'/gnupghome';
220 -d
$KEYSBASE || mkpath
($KEYSBASE , 0, 0700) or die ("Cannot create $KEYSBASE: $!\n");
221 -d
$GNUPGHOME || mkpath
($GNUPGHOME, 0, 0700) or die ("Cannot create $GNUPGHOME: $!\n");
224 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($NOW);
225 my $DATE_STRING = sprintf("%04d-%02d-%02d", $year+1900, $mon+1, $mday);
229 print STDERR
"Usage: $PROGRAM_NAME [-u <yourkeyid] <keyid> [<keyid> ...]\n";
234 my ($gnupghome, $keyid) = @_;
236 my $gpg = GnuPG
::Interface
->new();
237 $gpg->call( $CONFIG{'gpg'} );
238 $gpg->options->hash_init(
239 'homedir' => $gnupghome,
241 $gpg->options->meta_interactive( 0 );
242 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
243 my $pid = $gpg->export_keys(handles
=> $handles, command_args
=> [ $keyid ]);
244 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
250 #send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
251 sub send_mail
($$$@
) {
252 my ($address, $can_encrypt, $key_id, @keys) = @_;
254 my $message = "Hi,\n\n";
256 $message .= 'please find attached the user id'.(scalar @keys >= 2 ?
's' : '')."\n";
257 for my $key (@keys) {
258 $message .= "\t".$key->{'text'}."\n";
260 $message .= qq{of your key
$key_id signed by me
.
262 Note that I did
not upload your key to any keyservers
. If you want this
263 new signature to be available to others
, please upload it yourself
.
264 With GnuPG this can be done using
265 gpg
--keyserver subkeys
.pgp
.net
--send-key
$key_id
267 If you have any questions
, don
't hesitate to ask.
272 my $message_entity = MIME::Entity->build(
273 Type => "text/plain",
275 Disposition => 'inline
',
279 for my $key (@keys) {
280 $message_entity->attach(
281 Type => "application/pgp-keys",
282 Disposition => 'attachment
',
284 Description => "PGP Key 0x$key_id, uid ".($key->{'text
'}).' ('.($key->{'serial
'}).')',
285 Data => $key->{'key
'},
286 Filename => "0x$key_id.".$key->{'serial
'}.".asc");
290 my $message = $message_entity->stringify();
292 my $gpg = GnuPG::Interface->new();
293 $gpg->call( $CONFIG{'gpg
'} );
294 $gpg->options->hash_init( 'homedir
' => $GNUPGHOME,
295 'extra_args
' => '--always
-trust
',
297 $gpg->options->meta_interactive( 0 );
298 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
299 $gpg->options->push_recipients( $key_id );
300 $gpg->options->push_recipients( $CONFIG{'also
-encrypt
-to
'} ) if defined $CONFIG{'also
-encrypt
-to
'};
301 my $pid = $gpg->encrypt(handles => $handles);
302 my ($stdout, $stderr, $status) = readwrite_gpg($message, $inputfd, $stdoutfd, $stderrfd, $statusfd);
305 warn ("No data from gpg for list-key $key_id\n");
310 $message_entity = MIME::Entity->build(
311 Type => 'multipart
/encrypted; protocol="application/pgp-encrypted
"');
313 $message_entity->attach(
314 Type => "application
/pgp
-encrypted
",
315 Disposition => 'attachment',
317 Data => "Version
: 1\n");
319 $message_entity->attach(
320 Type => "application
/octet
-stream
",
321 Filename => 'msg.asc',
322 Disposition => 'inline',
327 $message_entity->head->add("Subject
", "Your signed PGP key
0x
$key_id");
328 $message_entity->head->add("To
", $address);
329 $message_entity->head->add("From
", $CONFIG{'owner'}.' <'.$CONFIG{'email'}.'>');
330 $message_entity->head->add("User
-Agent
", $USER_AGENT);
331 $message_entity->send();
332 $message_entity->stringify();
338 usage() unless scalar @ARGV >= 1;
339 if ($ARGV[0] eq '-u') {
340 usage() unless scalar @ARGV >= 3;
343 unless ($USER =~ /^[A-Za-z0-9]{8,8}([A-Za-z0-9]{8})?$/) {
344 print STDERR "-u
$USER is
not a keyid
.\n";
349 for my $keyid (@ARGV) {
350 unless ($keyid =~ /^[A-Za-z0-9]{8}([A-Za-z0-9]{8})?$/) {
351 print STDERR "$keyid is
not a keyid
.\n";
354 push @KEYIDS, uc($keyid);
358 #############################
359 # receive keys from keyserver
360 #############################
361 my $gpg = GnuPG::Interface->new();
362 $gpg->call( $CONFIG{'gpg'} );
363 $gpg->options->hash_init(
364 'homedir' => $GNUPGHOME,
365 'extra_args' => '--keyserver='.$CONFIG{'keyserver'} );
366 $gpg->options->meta_interactive( 0 );
367 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
368 my $pid = $gpg->recv_keys(handles => $handles, command_args => [ @KEYIDS ]);
369 my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
374 # [GNUPG:] IMPORT_OK 0 5B00C96D5D54AEE1206BAF84DE7AAF6E94C09C7F
377 # [GNUPG:] IMPORT_OK 0 25FC1614B8F87B52FF2F99B962AF4031C82E0039
378 for my $line (split /\n/, $status) {
379 if ($line =~ /^\[GNUPG:\] IMPORT_OK/) {
380 push @keyids_ok, shift @KEYIDS;
381 } elsif ($line =~ /^\[GNUPG:\] NODATA/) {
382 push @keyids_failed, shift @KEYIDS;
385 die ("Still
keys in \
@KEYIDS. This should
not happen
.") if scalar @KEYIDS;
386 notice ("Import failed
for: ". (join ' ', @keyids_failed).".") if scalar @keyids_failed;
391 info("Sign the following
keys according to your policy
...");
392 for my $keyid (@keyids_ok) {
394 push @command, $CONFIG{'gpg-sign'};
395 push @command, '--local-user', $USER if (defined $USER);
396 push @command, "--homedir
=$GNUPGHOME";
397 push @command, '--secret-keyring', $CONFIG{'secret-keyring'};
398 push @command, '--sign-key', $keyid;
399 print join(' ', @command),"\n";
407 for my $keyid (@keyids_ok) {
410 $gpg = GnuPG::Interface->new();
411 $gpg->call( $CONFIG{'gpg'} );
412 $gpg->options->hash_init( 'homedir' => $GNUPGHOME );
413 $gpg->options->meta_interactive( 0 );
414 ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
415 $gpg->options->hash_init( 'extra_args' => [ '--with-colons', '--fixed-list-mode' ] );
416 $pid = $gpg->list_public_keys(handles => $handles, command_args => [ $keyid ]);
417 ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
420 warn ("No data from gpg
for list
-key
$keyid\n");
423 my $keyinfo = $stdout;
424 my @publine = grep { /^pub/ } (split /\n/, $stdout);
425 my ($dummy1, $dummy2, $dummy3, $dummy4, $longkeyid, $dummy6, $dummy7, $dummy8, $dummy9, $dummy10, $dummy11, $flags) = split /:/, pop @publine;
426 my $can_encrypt = $flags =~ /E/;
427 unless (defined $longkeyid) {
428 warn ("Didn
't find public keyid in edit dialog of key $keyid.\n");
434 my $asciikey = export_key($GNUPGHOME, $keyid);
435 if ($asciikey eq '') {
436 warn ("No data from gpg for export $keyid\n");
443 my $this_uid_text = '';
445 info("Doing key $keyid, uid $uid_number");
447 # import into temporary gpghome
448 ###############################
449 my $tempdir = tempdir( "caff-$keyid-XXXXX", DIR => '/tmp/', CLEANUP => 1);
450 my $gpg = GnuPG::Interface->new();
451 $gpg->call( $CONFIG{'gpg
'} );
452 $gpg->options->hash_init( 'homedir
' => $tempdir );
453 $gpg->options->meta_interactive( 0 );
454 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
455 my $pid = $gpg->import_keys(handles => $handles);
456 my ($stdout, $stderr, $status) = readwrite_gpg($asciikey, $inputfd, $stdoutfd, $stderrfd, $statusfd);
459 if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
460 warn ("Could not import $keyid into temporary gnupg.\n");
466 $gpg = GnuPG::Interface->new();
467 $gpg->call( $CONFIG{'gpg
-delsig
'} );
468 $gpg->options->hash_init(
469 'homedir
' => $tempdir,
470 'extra_args
' => [ '--with
-colons
', '--fixed
-list
-mode
', '--command
-fd
=0', '--no-tty
' ] );
471 ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
472 $pid = $gpg->wrap_call(
473 commands => [ '--edit
' ],
474 command_args => [ $keyid ],
475 handles => $handles );
477 debug("Starting edit session");
478 ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
482 my $number_of_subkeys = 0;
487 debug("Parsing stdout output.");
488 for my $line (split /\n/, $stdout) {
489 debug("Checking line $line");
490 my ($type, $dummy2, $dummy3, $dummy4, $dummy5, $dummy6, $dummy7, $dummy8, $dummy9, $uidtext) = split /:/, $line;
491 if ($type eq 'sub') {
492 $number_of_subkeys++;
494 next unless ($type eq 'uid
' || $type eq 'uat
');
495 debug("line is interesting.");
496 if ($uid_number != $i) {
497 debug("mark for deletion.");
498 readwrite_gpg("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
503 $this_uid_text = ($type eq 'uid
') ? $uidtext : 'attribute
';
504 $is_uat = $type eq 'uat
';
508 debug("Parsing stdout output done.");
510 notice("Can't handle attribute userid of key
$keyid.");
514 info("key
$keyid done
.");
518 debug("need to
delete a few uids
.");
519 readwrite_gpg("deluid
\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELUID_PROMPT, nocloseinput => 1);
520 readwrite_gpg("yes
\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
525 if ($number_of_subkeys > 0) {
526 for (my $i=1; $i<=$number_of_subkeys; $i++) {
527 readwrite_gpg("key
$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
529 readwrite_gpg("delkey
\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSUBKEY_PROMPT, nocloseinput => 1);
530 readwrite_gpg("yes
\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
535 my $signed_by_me = 0;
536 readwrite_gpg("1\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
537 ($stdout, $stderr, $status) =
538 readwrite_gpg("delsig
\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSIG_PROMPT, nocloseinput => 1);
540 while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) {
541 # sig:?::17:EA2199412477CAF8:1058095214:::::13x:
542 my @sigline = grep { /^sig/ } (split /\n/, $stdout);
543 my $line = pop @sigline;
545 if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance
546 my ($dummy1, $dummy2, $dummy3, $dummy4, $signer, $created, $dummy7, $dummy8, $dummy9) = split /:/, $line;
547 if ($signer eq $longkeyid) {
549 } elsif (grep { $signer eq $_ } @{$CONFIG{'keyid'}}) {
551 $signed_by_me = $signed_by_me > $created ? $signed_by_me : $created;
556 ($stdout, $stderr, $status) =
557 readwrite_gpg($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput => 1);
559 readwrite_gpg("save
\n", $inputfd, $stdoutfd, $stderrfd, $statusfd);
562 my $asciikey = export_key($tempdir, $longkeyid);
563 if ($asciikey eq '') {
564 warn ("No data from gpg
for export
$longkeyid\n");
569 if ($NOW - $signed_by_me > $CONFIG{'export-sig-age'} ) {
570 my $write = ask("Signature on
$this_uid_text is old
. Export?
", 0);
573 my $keydir = "$KEYSBASE/$DATE_STRING";
574 -d $keydir || mkpath($keydir , 0, 0700) or die ("Cannot create
$keydir $!\n");
576 my $keyfile = "$keydir/$longkeyid.key
.$uid_number.$this_uid_text.asc
";
577 open (KEY, ">$keyfile") or die ("Cannot
open $keyfile\n");
581 push @UIDS, { text => $this_uid_text, key => $asciikey, serial => $uid_number };
583 info("$longkeyid $uid_number $this_uid_text done
.");
585 info("$longkeyid $uid_number $this_uid_text is
not signed by me
, not writing
.");
589 if (scalar @UIDS == 0) {
590 info("found
no signed uids
for $keyid");
593 for my $uid (@UIDS) {
594 unless ($uid->{'text'} =~ /@/) {
595 my $attach = ask("UID
$uid->{'text'} is
no email address
, attach it to every email sent?
", 1);
596 push @attached, $uid;
600 notice("Key has
no encryption capabilities
, mail will be sent unencrypted
") unless $can_encrypt;
601 for my $uid (@UIDS) {
602 if ($uid->{'text'} =~ /@/) {
603 my $address = $uid->{'text'};
604 $address =~ s/.*<(.*)>.*/$1/;
605 my $send = ask("Send mail to
'$address' for $uid->{'text'}?
", 1);
607 my $mail = send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
609 my $keydir = "$KEYSBASE/$DATE_STRING";
610 my $mailfile = "$keydir/$longkeyid.mail
.".$uid->{'serial'}.".".$uid->{'text'};
611 open (KEY, ">$mailfile") or die ("Cannot
open $mailfile\n");
624 ###############################################################3
625 #### old fork gpg --edit
627 my ($stdin_read, $stdin_write);
628 my ($stdout_read, $stdout_write);
629 my ($stderr_read, $stderr_write);
630 my ($status_read, $status_write);
631 pipe $stdin_read, $stdin_write;
632 pipe $stdout_read, $stdout_write;
633 pipe $stderr_read, $stderr_write;
634 pipe $status_read, $status_write;
637 unless ($pid) { # child
644 push @call, $CONFIG{'gpg-delsig'};
645 push @call, "--homedir
=$tempdir";
646 push @call, '--with-colons';
647 push @call, '--fixed-list-mode';
648 push @call, '--command-fd=0';
649 push @call, "--status
-fd
=".fileno($status_write);
650 push @call, "--no-tty
";
651 push @call, "--edit
";
657 open (STDIN, "<&".fileno($stdin_read)) or die ("Cannot reopen stdin
: $!\n");
658 open (STDOUT, ">&".fileno($stdout_write)) or die ("Cannot reopen stdout
: $!\n");
659 open (STDERR, ">&".fileno($stderr_write)) or die ("Cannot reopen stderr
: $!\n");
661 fcntl $status_write, F_SETFD, 0;
671 $inputfd = $stdin_write;
672 $stdoutfd = $stdout_read;
673 $stderrfd = $stderr_read;
674 $statusfd = $status_read;