+++ /dev/null
-#!/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 <peter@palfrader.org>
-#
-# 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<pgp-clean> I<keyid> [I<keyid> ...]
-
-=back
-
-=head1 DESCRIPTION
-
-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 I<keyid>
-
-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 <peter@palfrader.org>
-
-This manpage was written in POD by Christoph Berg <cb@df7cb.de>.
-
-=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 : "<nothing>"));
-
- 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 <keyid> [<keyid> ...]\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;
-}
projects / pgp-tools.git / blobdiff