prepare for upload
[pgp-tools.git] / caff / pgp-clean
index 799a42ac6f759b5d5b42ede2b561d244ad3bebbf..a68bbb13f8e7881016410ddf1a558583183fa22a 100755 (executable)
@@ -1,9 +1,10 @@
 #!/usr/bin/perl -w
 
-# caff  --  CA - Fire and Forget
-# $Id: caff 37 2005-02-28 23:20:15Z weasel $
+# pgp-clean  --  remove all non-self signatures from key
+# $Id$
 #
 # Copyright (c) 2004, 2005 Peter Palfrader <peter@palfrader.org>
+# Copyright (c) 2006 Christoph Berg <cb@df7cb.de>
 #
 # All rights reserved.
 #
 
 =head1 NAME
 
-caff -- CA - Fire and Forget
+pgp-clean -- remove all non-self signatures from key
 
 =head1 SYNOPSIS
 
 =over
 
-=item B<caff> [-u I<yourkeyid>] I<keyid> [I<keyid> ..]
+=item B<pgp-clean> [B<-s>] I<keyid> [I<keyid> ...]
 
 =back
 
 =head1 DESCRIPTION
 
-CA Fire and Forget is a script that helps you in keysigning.  It takes a list
-of keyids on the command line, fetches them from a keyserver and calls GnuPG so
-that you can sign it.  It then mails each key to all its email addresses - only
-including the one UID that we send to in each mail, pruned from all but self
-sigs and sigs done by you.
+B<pgp-clean> takes a list of keyids on the command line and outputs an
+ascii-armored keyring on stdout for each key with all signatures except
+self-signatures stripped.  Its use is to reduce the size of keys sent out after
+signing (e.g. with B<caff>).
 
 =head1 OPTIONS
 
 =over
 
-=item B<-u> I<yourkeyid>
+=item B<-s> B<--export-subkeys>
 
-Select the key that is used for signing, in case you have more than one key.
+Do not remove subkeys. (Pruned by default.)
 
-=back
-
-=head1 FILES
+=item I<keyid>
 
-=over
-
-=item $HOME/.caffrc  -  configuration file
+Use this key.
 
 =back
 
-=head1 CONFIGURATION FILE OPTIONS
-
-The configuration file is a perl script that sets values in the hash B<%CONFIG>.
-
-Example:
-
-       $CONFIG{'owner'}       = 'Peter Palfrader';
-       $CONFIG{'email'}       = 'peter@palfrader.org';
-
-=head2 Valid keys
+=head1 FILES
 
 =over
 
-=item B<caffhome> [string]
-
-Base directory for the files caff stores.  Default: B<$HOME/.caff/>.
-
-=item B<owner> [string]
-
-Your name.  B<REQUIRED>.
-
-=item B<email> [string]
-
-Your email address, used in From: lines.  B<REQUIRED>.
-
-=item B<keyid> [list of keyids]
-
-A list of your keys.  This is used to determine which signatures to keep
-in the pruning step.  If you select a key using B<-u> it has to be in
-this list.  B<REQUIRED>.
-
-=item B<export-sig-age> [seconds]
-
-Don't export UIDs by default, on which your latest signature is older
-than this age.  Default: B<24*60*60> (i.e. one day).
-
-=item B<keyserver> [string]
-
-Keyserver to download keys from.  Default: B<subkeys.pgp.net>.
-
-=item B<gpg> [string]
-
-Path to the GnuPG binary.  Default: B<gpg>.
+=item $HOME/.gnupg/pubring.gpg  -  default GnuPG keyring
 
-=item B<gpg-sign> [string]
-
-Path to the GnuPG binary which is used to sign keys.  Default: what
-B<gpg> is set to.
-
-=item B<gpg-delsig> [string]
-
-Path to the GnuPG binary which is used to split off signatures.  This is
-needed while the upstream GnuPG is not fixed  (there are 2 bugs in the
-Debian Bug Tracking System).  Default: what B<gpg> is set to.
-
-=item B<secret-keyring> [string]
-
-Path to your secret keyring.  Default: B<$HOME/.gnupg/secring.gpg>.
-
-=item B<also-encrypt-to> [keyid]
-
-An additional keyid to encrypt messages to. Default: none.
-
-=item B<no-download> [boolean]
-
-If true, then skip the step of fetching keys from the keyserver.
-Default: B<0>.
-
-=item B<no-sign> [boolean]
+=back
 
-If true, then skip the signing step. Default: B<0>.
+=head1 SEE ALSO
 
-=back
+caff(1), gpg(1).
 
 =head1 AUTHOR
 
 Peter Palfrader <peter@palfrader.org>
 
+This manpage was written in POD by Christoph Berg <cb@df7cb.de>.
+
 =cut
 
 use strict;
@@ -156,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: 37 $';
+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";
@@ -172,7 +113,7 @@ sub info($) {
 };
 sub debug($) {
        my ($line) = @_;
-       print STDERR "[DEBUG] $line\n";
+       #print STDERR "[DEBUG] $line\n";
 };
 sub trace($) {
        my ($line) = @_;
@@ -308,25 +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 "caff $VERSION - (c) 2004, 2005 Peter Palfrader\n";
-       print STDERR "Usage: $PROGRAM_NAME <keyid> [<keyid> ...]\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] <keyid> [<keyid> ...]\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);
 };
@@ -429,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);
                };