131 lines
3.7 KiB
Perl
131 lines
3.7 KiB
Perl
|
#!/usr/bin/perl
|
||
|
|
# This is PGoatP, for goatseing pgp keys
|
||
|
|
# 2011 sneak@datavibe.net
|
||
|
|
# sorry to everyone forever for pissing in the collective pool
|
||
|
|
# apologies to dfw for the name
|
||
|
|
# and thanks to MIT for using monospaced fonts on the web
|
||
|
|
|
||
|
|
use strict;
|
||
|
|
use warnings qw( all );
|
||
|
|
|
||
|
|
our $keyserver = 'pgp.mit.edu';
|
||
|
|
our $tmpdir = '/tmp/pgoat.' . $$; # run only in single user mode, dumbass.
|
||
|
|
our $gpg_opts = qq{--batch --homedir '$tmpdir'};
|
||
|
|
|
||
|
|
main();
|
||
|
|
|
||
|
|
sub main {
|
||
|
|
if (@ARGV < 1) {
|
||
|
|
die "usage: $0 <target keyid> [ascii file]\n";
|
||
|
|
}
|
||
|
|
|
||
|
|
pgoatp({
|
||
|
|
keyserver => $keyserver,
|
||
|
|
target => $ARGV[0],
|
||
|
|
ascii => [ split(/\n/,(@ARGV == 1) ? goatse() : readfile($ARGV[1])) ],
|
||
|
|
});
|
||
|
|
|
||
|
|
}
|
||
|
|
|
||
|
|
sub pgoatp {
|
||
|
|
my $opts = shift;
|
||
|
|
unlink($tmpdir); # woo temp file race
|
||
|
|
mkdir($tmpdir) unless -d $tmpdir;
|
||
|
|
chmod 0700, $tmpdir;
|
||
|
|
my $target = $opts->{'target'};
|
||
|
|
print "fetching target key...\n";
|
||
|
|
`gpg $gpg_opts -q --keyserver $keyserver --recv-key $target`;
|
||
|
|
my $x = 0;
|
||
|
|
my @trollkeys;
|
||
|
|
foreach my $line (@{$opts->{'ascii'}}) {
|
||
|
|
next if $line =~ /^\s*$/;
|
||
|
|
printf(
|
||
|
|
"%i%% done generating keys\n",
|
||
|
|
($x/@{$opts->{'ascii'}})*100
|
||
|
|
);
|
||
|
|
my $keyid = gen_key({
|
||
|
|
name => $line
|
||
|
|
});
|
||
|
|
push(@trollkeys,$keyid);
|
||
|
|
`gpg -q $gpg_opts --yes --default-key $keyid --sign-key $target 2>&1`;
|
||
|
|
$x++;
|
||
|
|
}
|
||
|
|
|
||
|
|
print "preview:\n";
|
||
|
|
print `gpg $gpg_opts --list-sigs $target`;
|
||
|
|
|
||
|
|
print "\n\n*** you have ten seconds to control-c to cancel! *** \n\n";
|
||
|
|
sleep 10;
|
||
|
|
print `gpg $gpg_opts --keyserver $keyserver --send-key $target`;
|
||
|
|
foreach my $keyid (@trollkeys) {
|
||
|
|
print `gpg $gpg_opts --keyserver $keyserver --send-key $keyid`;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
sub gen_key {
|
||
|
|
my $opts = shift;
|
||
|
|
open(FH,'>' . $tmpdir . '/input') or die;
|
||
|
|
my $format =
|
||
|
|
q{Key-Type: DSA
|
||
|
|
Key-Length: 1024
|
||
|
|
Subkey-Type: ELG-E
|
||
|
|
Subkey-Length: 1024
|
||
|
|
Name-Real: %s
|
||
|
|
Expire-Date: 0
|
||
|
|
%%pubring %s/pub
|
||
|
|
%%secring %s/sec
|
||
|
|
%%commit
|
||
|
|
};
|
||
|
|
|
||
|
|
printf FH $format,$opts->{'name'},$tmpdir,$tmpdir;
|
||
|
|
`gpg $gpg_opts --gen-key $tmpdir/input 2>&1 `;
|
||
|
|
my $out = `gpg $gpg_opts --import $tmpdir/sec $tmpdir/pub 2>&1 `;
|
||
|
|
unlink($tmpdir . '/sec');
|
||
|
|
unlink($tmpdir . '/pub');
|
||
|
|
#print $out; die;
|
||
|
|
die unless $out =~ /key (\S+?)\:/m;
|
||
|
|
return $1;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub readfile {
|
||
|
|
my $fn = shift;
|
||
|
|
open(FH,$fn) or die "can't open file $fn for reading: $!\n";
|
||
|
|
my $data;
|
||
|
|
read(FH,$data,1024*5); # 5kb ought to be enough for anyone
|
||
|
|
close(FH);
|
||
|
|
return $data;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub goatse { q{
|
||
|
|
* g o a t s e x * g o a t s e x * g o a t s e x *
|
||
|
|
g g
|
||
|
|
o / \ \ / \ o
|
||
|
|
a| | \ | | a
|
||
|
|
t| `. | | : t
|
||
|
|
s` | | \| | s
|
||
|
|
e \ | / / \\\\\ --__ \\\\ : e
|
||
|
|
x \ \/ _--~~ ~--__| \ | x
|
||
|
|
* \ \_-~ ~-_\ | *
|
||
|
|
g \_ \ _.--------.______\| | g
|
||
|
|
o \ \______// _ ___ _ (_(__> \ | o
|
||
|
|
a \ . C ___) ______ (_(____> | / a
|
||
|
|
t /\ | C ____)/ \ (_____> |_/ t
|
||
|
|
s / /\| C_____) | (___> / \ s
|
||
|
|
e | ( _C_____)\______/ // _/ / \ e
|
||
|
|
x | \ |__ \\\\_________// (__/ | x
|
||
|
|
* | \ \____) `---- --' | *
|
||
|
|
g | \_ ___\ /_ _/ | g
|
||
|
|
o | / | | \ | o
|
||
|
|
a | | / \ \ | a
|
||
|
|
t | / / | | \ |t
|
||
|
|
s | / / \__/\___/ | |s
|
||
|
|
e | / | | | |e
|
||
|
|
x | | | | | |x
|
||
|
|
* g o a t s e x * g o a t s e x * g o a t s e x *
|
||
|
|
};
|
||
|
|
}
|
||
|
|
|
||
|
|
1;
|
||
|
|
|
||
|
|
__END__
|