suse-build-key/dumpsigs

#!/usr/bin/perl -w
# dump all keys contained in the keyring specified as argument

use strict;

my @keyring;

die "must specify keyring\n" unless @ARGV;

my $file =  shift @ARGV;
unless ($file =~ /^\//) {
	use Cwd qw/abs_path/;
	$file = abs_path($file);
}

# XXX: workaround for colons in obs project names o_O
if ($file =~ /:/) {
	use File::Temp qw/tempdir/;
	my $tmpdir = tempdir( CLEANUP => 1);
	my $nn = $file;
	$nn =~ s/.*\///;
	$nn = $tmpdir.'/'.$nn;
	symlink($file, $nn) or die "failed to symlink: $!\n";
	$file = $nn;
}

@keyring = ('--no-default-keyring', '--keyring='.$file);

my @line;
my $ver;
my $rel;
my $name;
my %names;

my @cmd = qw/--no-secmem-warning --no-options --list-sigs --list-options show-keyring --fixed-list-mode --with-colons/;
unshift @cmd, @keyring;
unshift @cmd, 'gpg';
#print join(' ', @cmd), "\n";

open(GPG, '-|', @cmd);
while (<GPG>) {
  chomp;
  next unless /^pub:/;
  @line = split(':', $_);
  my $id = $line[4];
  $_ = <GPG>;
  $_ = <GPG> if /^fpr:/;
  chomp;
  next unless /^uid:/;
  @line = split(':', $_);
  $name = $line[9];
  while (1) {
    $_ = <GPG>;
    chomp;
    next unless /^sig:/;
    @line = split(':', $_);
    next if $line[4] ne $id;
    $ver = lc($id);
    $ver =~ s/.*(........)$/$1/;
    $rel = sprintf("%08x", $line[5]);
    last;
  }
  $names{"gpg-pubkey-$ver-$rel"} = [ $id, $name ];
}
close GPG;
my $n;

for $n (sort keys %names) {
  @cmd = qw/--no-options --no-secmem-warning --export-options export-minimal --export -a/;
  push  @cmd, $names{$n}[0];
  unshift @cmd, @keyring;
  unshift @cmd, 'gpg';
  my $fn = $n.".asc";
  unless (open(O, '>', $fn)) {
	  warn "failed to open $fn: $!";
	  next;
  }
  printf O "%s %s\n\n", $names{$n}[0], $names{$n}[1];
  print "writing $fn\n";
  #print join(' ', @cmd), "\n";
  unless (open(GPG, '-|', @cmd)) {
	  warn "failed to exec gpg: $!";
	  close O;
	  unlink $fn;
	  next;
  }
  while(<GPG>) {
	  print O;
  }
  close GPG;
  close O;
}