|
|
|
@@ -0,0 +1,130 @@ |
|
|
|
#!/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__ |
