X-Git-Url: https://git.sthu.org/?a=blobdiff_plain;f=caff%2Fpgp-clean;h=a68bbb13f8e7881016410ddf1a558583183fa22a;hb=5aa8ef28a85d448e9f866a6dad021047a908c941;hp=7514e71f396f8b9555ccff511231fa57955424d0;hpb=d325e57308e0f7f88ecea9eb8855455f911d6d78;p=pgp-tools.git diff --git a/caff/pgp-clean b/caff/pgp-clean index 7514e71..a68bbb1 100755 --- a/caff/pgp-clean +++ b/caff/pgp-clean @@ -4,6 +4,7 @@ # $Id$ # # Copyright (c) 2004, 2005 Peter Palfrader +# Copyright (c) 2006 Christoph Berg # # All rights reserved. # @@ -39,7 +40,7 @@ pgp-clean -- remove all non-self signatures from key =over -=item B I [I ...] +=item B [B<-s>] I [I ...] =back @@ -54,6 +55,10 @@ signing (e.g. with B). =over +=item B<-s> B<--export-subkeys> + +Do not remove subkeys. (Pruned by default.) + =item I Use this key. @@ -87,12 +92,17 @@ use File::Path; use File::Temp qw{tempdir}; use Fcntl; use IO::Select; +use Getopt::Long; use GnuPG::Interface; my $REVISION = '$Rev$'; my ($REVISION_NUMER) = $REVISION =~ /(\d+)/; my $VERSION = "0.0.0.$REVISION_NUMER"; +########### +# functions +########### + sub notice($) { my ($line) = @_; print STDERR "[NOTICE] $line\n"; @@ -239,26 +249,60 @@ sub export_key($$) { return $stdout; }; +################## +# global variables +################## + my $KEYEDIT_PROMPT = '^\[GNUPG:\] GET_LINE keyedit.prompt'; my $KEYEDIT_DELUID_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.uid.okay'; my $KEYEDIT_DELSIG_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.delsig'; my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = '^\[GNUPG:\] (GET_BOOL keyedit.delsig|GET_LINE keyedit.prompt)'; my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey'; +my $params; +################### +# argument handling +################### -sub usage() { - print STDERR "pgp-clean $VERSION - (c) 2004, 2005 Peter Palfrader\n"; - print STDERR "Usage: $PROGRAM_NAME [ ...]\n"; - exit 1; +sub version($) { + my ($fd) = @_; + print $fd "pgp-clean $VERSION - (c) 2004, 2005, 2006 Peter Palfrader et al.\n"; +}; + +sub usage($$) { + my ($fd, $exitcode) = @_; + version($fd); + print $fd "Usage: $PROGRAM_NAME [-s] [ ...]\n"; + print $fd "-s --export-subkeys do not remove subkeys\n"; + exit $exitcode; +}; + +Getopt::Long::config('bundling'); +if (!GetOptions ( + '-h' => \$params->{'help'}, + '--help' => \$params->{'help'}, + '-V' => \$params->{'version'}, + '--version' => \$params->{'version'}, + '-s' => \$params->{'export-subkeys'}, + '--export-subkeys' => \$params->{'export-subkeys'}, + )) { + usage(\*STDERR, 1); +}; +if ($params->{'help'}) { + usage(\*STDOUT, 0); +}; +if ($params->{'version'}) { + version(\*STDOUT); + exit(0); }; +usage(\*STDERR, 1) unless scalar @ARGV >= 1; -usage() unless scalar @ARGV >= 1; my @KEYIDS; for my $keyid (@ARGV) { $keyid =~ s/^0x//i; unless ($keyid =~ /^[A-Za-z0-9]{8}([A-Za-z0-9]{8})?$/) { print STDERR "$keyid is not a keyid.\n"; - usage(); + usage(\*STDERR, 1); }; push @KEYIDS, uc($keyid); }; @@ -361,7 +405,7 @@ for my $keyid (@KEYIDS) { # delete subkeys ################ - if ($number_of_subkeys > 0) { + if (!$params->{'export-subkeys'} and $number_of_subkeys > 0) { for (my $i=1; $i<=$number_of_subkeys; $i++) { readwrite_gpg("key $i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); };