From 181c71c7d5b0c7a722c753378352c6f5ce9f08a9 Mon Sep 17 00:00:00 2001 From: weasel Date: Mon, 27 Jun 2005 16:43:37 +0000 Subject: [PATCH] Add a ppg-cleanring git-svn-id: svn://svn.debian.org/pgp-tools/trunk@81 b513b33f-fedd-0310-b452-c3deb5f4c849 --- caff/pgp-cleanring | 346 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 346 insertions(+) create mode 100755 caff/pgp-cleanring diff --git a/caff/pgp-cleanring b/caff/pgp-cleanring new file mode 100755 index 0000000..ca00698 --- /dev/null +++ b/caff/pgp-cleanring @@ -0,0 +1,346 @@ +#!/usr/bin/perl -w + +# caff -- CA - Fire and Forget +# $Id: caff 37 2005-02-28 23:20:15Z weasel $ +# +# Copyright (c) 2004, 2005 Peter Palfrader +# +# All rights reserved. +# +# Redistribution and use in source and binary forms, with or without +# modification, are permitted provided that the following conditions +# are met: +# 1. Redistributions of source code must retain the above copyright +# notice, this list of conditions and the following disclaimer. +# 2. Redistributions in binary form must reproduce the above copyright +# notice, this list of conditions and the following disclaimer in the +# documentation and/or other materials provided with the distribution. +# 3. The name of the author may not be used to endorse or promote products +# derived from this software without specific prior written permission. +# +# THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR +# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES +# OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. +# IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, +# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT +# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF +# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +=pod + +=head1 NAME + +pgp-clean -- remove all non-self signatures from key + +=head1 SYNOPSIS + +=over + +=item B I [I ...] + +=back + +=head1 DESCRIPTION + +B 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). + +=head1 OPTIONS + +=over + +=item I + +Use this key. + +=back + +=head1 FILES + +=over + +=item $HOME/.gnupg/pubring.gpg - default GnuPG keyring + +=back + +=head1 SEE ALSO + +caff(1), gpg(1). + +=head1 AUTHOR + +Peter Palfrader + +This manpage was written in POD by Christoph Berg . + +=cut + +use strict; +use IO::Handle; +use English; +use File::Path; +use Fcntl; +use IO::Select; +use GnuPG::Interface; + +my $REVISION = '$Rev: 37 $'; +my ($REVISION_NUMER) = $REVISION =~ /(\d+)/; +my $VERSION = "0.0.0.$REVISION_NUMER"; + +sub notice($) { + my ($line) = @_; + print STDERR "[NOTICE] $line\n"; +}; +sub info($) { + my ($line) = @_; + print STDERR "[INFO] $line\n"; +}; +sub debug($) { + my ($line) = @_; + print STDERR "[DEBUG] $line\n"; +}; +sub trace($) { + my ($line) = @_; + #print STDERR "[trace] $line\n"; +}; +sub trace2($) { + my ($line) = @_; + #print STDERR "[trace2] $line\n"; +}; + +sub make_gpg_fds() { + my %fds = ( + stdin => IO::Handle->new(), + stdout => IO::Handle->new(), + stderr => IO::Handle->new(), + status => IO::Handle->new() ); + my $handles = GnuPG::Handles->new( %fds ); + return ($fds{'stdin'}, $fds{'stdout'}, $fds{'stderr'}, $fds{'status'}, $handles); +}; + +sub readwrite_gpg($$$$$%) { + my ($in, $inputfd, $stdoutfd, $stderrfd, $statusfd, %options) = @_; + + trace("Entering readwrite_gpg."); + + my ($first_line, $dummy) = split /\n/, $in; + debug("readwrite_gpg sends ".(defined $first_line ? $first_line : "")); + + local $INPUT_RECORD_SEPARATOR = undef; + my $sout = IO::Select->new(); + my $sin = IO::Select->new(); + my $offset = 0; + + trace("input is $inputfd; output is $stdoutfd; err is $stderrfd; status is ".(defined $statusfd ? $statusfd : 'undef')."."); + + $inputfd->blocking(0); + $stdoutfd->blocking(0); + $statusfd->blocking(0) if defined $statusfd; + $stderrfd->blocking(0); + $sout->add($stdoutfd); + $sout->add($stderrfd); + $sout->add($statusfd) if defined $statusfd; + $sin->add($inputfd); + + my ($stdout, $stderr, $status) = ("", "", ""); + my $exitwhenstatusmatches = $options{'exitwhenstatusmatches'}; + trace("doing stuff until we find $exitwhenstatusmatches") if defined $exitwhenstatusmatches; + + my $readwrote_stuff_this_time = 0; + my $do_not_wait_on_select = 0; + my ($readyr, $readyw, $written); + while ($sout->count() > 0 || (defined($sin) && ($sin->count() > 0))) { + if (defined $exitwhenstatusmatches) { + if ($status =~ /$exitwhenstatusmatches/m) { + trace("readwrite_gpg found match on $exitwhenstatusmatches"); + if ($readwrote_stuff_this_time) { + trace("read/write some more\n"); + $do_not_wait_on_select = 1; + } else { + trace("that's it in our while loop.\n"); + last; + } + }; + }; + + $readwrote_stuff_this_time = 0; + trace("select waiting for ".($sout->count())." fds."); + ($readyr, $readyw, undef) = IO::Select::select($sout, $sin, undef, $do_not_wait_on_select ? 0 : 1); + trace("ready: write: ".(defined $readyw ? scalar @$readyw : 0 )."; read: ".(defined $readyr ? scalar @$readyr : 0)); + for my $wfd (@$readyw) { + $readwrote_stuff_this_time = 1; + if (length($in) != $offset) { + trace("writing to $wfd."); + $written = $wfd->syswrite($in, length($in) - $offset, $offset); + $offset += $written; + }; + if ($offset == length($in)) { + trace("writing to $wfd done."); + unless ($options{'nocloseinput'}) { + close $wfd; + trace("$wfd closed."); + }; + $sin->remove($wfd); + $sin = undef; + } + } + + next unless (defined(@$readyr)); # Wait some more. + + for my $rfd (@$readyr) { + $readwrote_stuff_this_time = 1; + if ($rfd->eof) { + trace("reading from $rfd done."); + $sout->remove($rfd); + close($rfd); + next; + } + trace("reading from $rfd."); + if ($rfd == $stdoutfd) { + $stdout .= <$rfd>; + trace2("stdout is now $stdout\n================"); + next; + } + if (defined $statusfd && $rfd == $statusfd) { + $status .= <$rfd>; + trace2("status is now $status\n================"); + next; + } + if ($rfd == $stderrfd) { + $stderr .= <$rfd>; + trace2("stderr is now $stderr\n================"); + next; + } + } + } + trace("readwrite_gpg done."); + return ($stdout, $stderr, $status); +}; + +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'; + + +sub usage() { + print STDERR "pgp-clean $VERSION - (c) 2004, 2005 Peter Palfrader\n"; + print STDERR "Usage: $PROGRAM_NAME [ ...]\n"; + exit 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(); + }; + push @KEYIDS, uc($keyid); +}; + + +################## +# export and prune +################## +KEYS: +for my $keyid (@KEYIDS) { + # get key listing + ################# + my $gpg = GnuPG::Interface->new(); + $gpg->options->meta_interactive( 0 ); + my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds(); + $gpg->options->hash_init( 'extra_args' => [ '--with-colons', '--fixed-list-mode' ] ); + my $pid = $gpg->list_public_keys(handles => $handles, command_args => [ $keyid ]); + my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd); + waitpid $pid, 0; + if ($stdout eq '') { + warn ("No data from gpg for list-key $keyid\n"); + next; + }; + my $keyinfo = $stdout; + my @publine = grep { /^pub/ } (split /\n/, $stdout); + my ($dummy1, $dummy2, $dummy3, $dummy4, $longkeyid, $dummy6, $dummy7, $dummy8, $dummy9, $dummy10, $dummy11, $flags) = split /:/, pop @publine; + my $can_encrypt = $flags =~ /E/; + unless (defined $longkeyid) { + warn ("Didn't find public keyid in edit dialog of key $keyid.\n"); + next; + }; + + my @UIDS; + my $uid_number = 0; + my $this_uid_text = ''; + $uid_number++; + debug("Doing key $keyid, uid $uid_number"); + + # prune it + ########## + $gpg = GnuPG::Interface->new(); + $gpg->options->hash_init( + 'extra_args' => [ '--with-colons', '--fixed-list-mode', '--command-fd=0', '--no-tty' ] ); + ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds(); + $pid = $gpg->wrap_call( + commands => [ '--edit' ], + command_args => [ $keyid ], + handles => $handles ); + + debug("Starting edit session"); + ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); + + # mark all uids + ################### + my $number_of_subkeys = 0; + my $i = 1; + my $have_one = 0; + my $is_uat = 0; + my $delete_some = 0; + debug("Parsing stdout output."); + for my $line (split /\n/, $stdout) { + debug("Checking line $line"); + my ($type, $dummy2, $dummy3, $dummy4, $dummy5, $dummy6, $dummy7, $dummy8, $dummy9, $uidtext) = split /:/, $line; + if ($type eq 'sub') { + $number_of_subkeys++; + }; + next unless ($type eq 'uid' || $type eq 'uat'); + debug("line is interesting."); + debug("mark uid."); + readwrite_gpg("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); + $i++; + }; + debug("Parsing stdout output done."); + + # delete signatures + ################### + ($stdout, $stderr, $status) = + readwrite_gpg("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSIG_PROMPT, nocloseinput => 1); + + while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) { + # sig:?::17:EA2199412477CAF8:1058095214:::::13x: + my @sigline = grep { /^sig/ } (split /\n/, $stdout); + $stdout =~ s/\n/\\n/g; + notice("[sigremoval] why are there ".(scalar @sigline)." siglines in that part of the dialog!? got: $stdout") if scalar @sigline >= 2; # XXX + my $line = pop @sigline; + my $answer = "no"; + if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance + debug("[sigremoval] doing line $line."); + my ($dummy1, $dummy2, $dummy3, $dummy4, $signer, $created, $dummy7, $dummy8, $dummy9) = split /:/, $line; + if ($signer eq ('-1' x 16)) { + debug("[sigremoval] not interested in that sig ($signer)."); + $answer = "yes"; + }; + } else { + debug("[sigremoval] no sig line here, only got: ".$stdout); + }; + ($stdout, $stderr, $status) = + readwrite_gpg($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput => 1); + }; + readwrite_gpg("save\n", $inputfd, $stdoutfd, $stderrfd, $statusfd); + waitpid $pid, 0; +} -- 2.39.5