#!/usr/pkg/bin/perl -w
#
# gpg-key2ps: convert a PGP/GnuPG key into paper slips.
# Copyright (C) 2001-2005  Simon Richter
# Copyright (C) 2005-2008  Thijs Kinkhorst
# Copyright (C) 2005-2008  Christoph Berg <cb@df7cb.de>
# Licenced under the GNU General Public License,
# version 2 or later.
#

use strict;
use Encode ();
use Getopt::Long;

my $version = '';
my $showsubkeys = 0;
my $revokestyle = "hide";
my $columns = 2;
my $creationdate = scalar(localtime);

sub version($) {
	my $fd = shift;
	print $fd "gpg-key2ps $version - (c) 2001-2008 Simon Richter, Thijs Kinkhorst, Christoph Berg\n";
}

sub usage($$) {
	my ($fd, $exitcode) = @_;
	version ($fd);
	print $fd <<EOF;
Usage: $0 [-p papersize] [-r revoked-style] [-1] [-s] keyid-or-name ...
Options:
 -p --paper-size
 -s --show-subkeys
 -r --revoked-style
        hide   - Don't show revoked uids and subkeys (default)
        grey   - Print text in grey
        note   - Add "[revoked]"
        show   - List revoked uids normally
        strike - Strike through lines
 -1 Only print one column, for extra wide keys
 -h --help
 -v --version
EOF
	exit $exitcode;
}

# fetch command line parameters
my $opts;
Getopt::Long::config('bundling');
if (!GetOptions (
	'-h'                => \$opts->{help},
	'--help'            => \$opts->{help},
	'-v'                => \$opts->{version},
	'--version'         => \$opts->{version},
	'-s'                => \$opts->{showsubkeys},
	'--show-subkeys'    => \$opts->{showsubkeys},
	'-p=s'              => \$opts->{papersize},
	'--paper-size=s'    => \$opts->{papersize},
	'-r=s'              => \$opts->{revokestyle},
	'--revoked-style=s' => \$opts->{revokestyle},
	'-1'                => \$opts->{1},
)) {
	usage(\*STDERR, 1);
}

if ($opts->{help}) {
	usage (\*STDOUT, 0);
}

if ($opts->{version}) {
	version (\*STDOUT);
	exit 0;
}

if ( $opts->{papersize} ) { $ENV{'PAPERSIZE'} = $opts->{papersize}; }
if ( $opts->{showsubkeys} ) { $showsubkeys = 1; }
if ( $opts->{revokestyle} ) { $revokestyle = $opts->{revokestyle}; }

if ( $revokestyle !~ /^(grey|hide|note|show|strike)$/ ) {
	print STDERR "Unknown revoked-style \"$revokestyle\".\n";
	usage (\*STDERR, 1);
}

if ( $opts->{1} ) { $columns = 1; }

usage(\*STDERR, 1) unless scalar @ARGV >= 1;

# determine the paper size through the paperconf tool
my $w; my $h;
if ( `which paperconf` && $? == 0 ) {
	$w=`paperconf -w`;
	$h=`paperconf -h`;
	chomp  for ($w,$h);
	y/,/./ for ($w,$h);
} else {
	# Default to A4.
	print STDERR "Warning: libpaper-utils is not installed, defaulting to A4.\n";
	$w=596;
	$h=842;
}

# open a gpg process we'll be reading from below
# --list-key due to #382794
open GPG, '-|', $ENV{GNUPGBIN} // 'gpg', qw/--list-key --with-fingerprint --with-colons/, @ARGV;

sub start_postscript {
# start the PostScript output
print <<EOF;
%!PS-Adobe-3.0
%%BoundingBox: 0 0 $w $h
%%Title: 
%%Creator: gpg-key2ps $version
%%CreationDate: $creationdate
%%Pages: 1
%%EndComments

%%Page: 1 1

/w $w def
/h $h def

/reencode {
	exch findfont
	dup length dict
	begin {
		1 index /FID eq
		{ pop pop }
		{ def } ifelse
	} forall
	/Encoding ISOLatin1Encoding def
	currentdict
	end
	definefont
} bind def

/Times-Roman /trlatin1 reencode 9 scalefont setfont

/newline {
	/y y 10 sub def
} def

/hline {
	30 y 3 add moveto
	w $columns div 30 sub y 3 add lineto stroke
	newline
} def

/needhline {
	/condhline { hline } def
} def

/noneedhline {
	/condhline { } def
} def

/showAlgorithm {
  << 1 (rsa) 2 (rsa) 3 (rsa) 16 (elg) 17 (dsa) 20 (xxx) 18 (ecdh) 19 (ecdsa) 22 (eddsa) >> exch get
  show
} def

/pub {
	condhline
	50 y moveto (pub) show
	70 y moveto showAlgorithm show (/) show show
	150 y moveto show
	200 y moveto show
	newline
	needhline
} def

/fpr {
	70 y moveto (Key fingerprint = ) show show
	newline
} def

/uid {
	50 y moveto (uid) show
	200 y moveto show
	newline
} def

/sbk {
	50 y moveto (sub) show
	70 y moveto showAlgorithm show (/) show show
	150 y moveto show
	newline
} def

EOF

# output the desired display for revoked uids
if ( $revokestyle eq "grey" ) {
	print <<EOF;
/revuid {
	.5 setgray
	uid
	0 setgray
} def
/revsbk {
	.5 setgray
	sbk
	0 setgray
} def
EOF
} elsif ( $revokestyle eq "note" ) {
	print <<EOF;
/revuid {
	50 y moveto (uid) show
	200 y moveto show ( [revoked]) show
	newline
} def
/revsbk {
	sbk
	( [revoked]) show
} def
EOF
} elsif ( $revokestyle eq "show" ) {
	print <<EOF;
/revuid { uid } def
/revsbk { sbk } def
EOF
} elsif ( $revokestyle eq "strike" ) {
	print <<EOF;
/revuid {
	uid
	45 y 12 add moveto h 2 div 45 sub y 12 add lineto stroke
} def
/revsbk {
	sbk
	45 y 12 add moveto h 2 div 45 sub y 12 add lineto stroke
} def
EOF
}

print <<EOF;

/key {
	noneedhline
EOF
} # sub start_postscript

# walk the output of gpg line by line
# $numlines has the total number of lines so we'll know how many to put on page
my $numlines = 0;
my $started = 0;
my $subkey = 0; # indicates whether the current key is a subkey
while(<GPG>) {
	# we don't use these
	if ( /^(tru|uat):/ ) { next; }
	# every primary uid causes an extra line because of the separator
	if ( /^pub:/ ) {
		start_postscript() unless $started;
		$started = 1;
		$subkey = 0;
		$numlines++;
	}
	# primary uid
	s/^pub:[^:]*:([^:]*):([0-9]*):.{8,8}(.{8,8}):([^:]*):[^:]*:[^:]*:[^:]*:([^:]*):[^:]*:[^:]*:.*/	($5) ($4) ($3) ($1) $2 pub/;
	# fingerprint, format it nicely with spaces
	if ( /^fpr:[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:([^:]*):.*/ ) {
		next if $subkey;
		my $fpr = $1;
		# v4 key
		$fpr =~ s/(\w{4})(\w{4})(\w{4})(\w{4})(\w{4})(\w{4})(\w{4})(\w{4})(\w{4})(\w{4})/$1 $2 $3 $4 $5  $6 $7 $8 $9 $10/;
		# v3 key
		$fpr =~ s/(\w{2})(\w{2})(\w{2})(\w{2})(\w{2})(\w{2})(\w{2})(\w{2})(\w{2})(\w{2})(\w{2})(\w{2})(\w{2})(\w{2})(\w{2})(\w{2})/$1 $2 $3 $4 $5 $6 $7 $8  $9 $10 $11 $12 $13 $14 $15 $16/g;
		$_ = "	($fpr) fpr\n";
	}
	# user ids
	s/\\x(\p{AHex}{2})/ chr(hex($1)) /ge;
	$_ = Encode::encode("latin1", Encode::decode_utf8($_));
	s/^uid:[^:r]*:[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:([^:]*):.*/	($1) uid/;
	# revoked user id
	if (s/^uid:r[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:([^:]*):.*/	($1) revuid/) {
		next if $revokestyle eq "hide";
	}
	# subkey
	$subkey = 1 if /^sub:/;
	if (s/^sub:[^r:]*:([^:]*):([0-9]*):.{8,8}(.{8,8}):([^:]*):[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:.*/	($4) ($3) ($1) $2 sbk/) {
		next if ! $showsubkeys;
	}
	if (s/^sub:r[^:]*:([^:]*):([0-9]*):.{8,8}(.{8,8}):([^:]*):[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:.*/	($4) ($3) ($1) $2 revsbk/) {
		next if (!$showsubkeys) || $revokestyle eq "hide";
	}
	$numlines++;
	# print this line
	print;
}
close(GPG);

unless ($started) {
	print STDERR "No public key found.\n";
	exit 1;
}

# output the remaining postscript
print <<EOF;
} def

/numlines $numlines def
/num w 16 sub 10 div numlines div def

/column {
	/y w 20 sub def
	1 1 num {
		gsave
		0 0 h $columns div w rectclip
		/upper y 11 add def
		key
		newline
		/lower y 11 add def
		0 upper h $columns div upper h $columns div lower 0 lower 0 upper moveto lineto lineto lineto lineto stroke
		grestore
	} for
} def

w 0 translate
90 rotate
column
EOF

if ( $columns == 2 ) {
	print <<EOF;
h $columns div 0 translate
column

EOF
}

print <<EOF;
showpage

%%Trailer
%%EOF
EOF

# done!
exit 0;


__END__

=head1 NAME

B<gpg-key2ps> - generates a PS file from a GnuPG keyring

=head1 SYNOPSIS

B<gpg-key2ps> [B<-r> I<revoked-style>] [B<-p> I<papersize>] [B<-1>] [B<-s>] I<keyid-or-name> [ I<...> ]

=head1 DESCRIPTION

gpg-key2ps generates a PostScript file with your OpenPGP key fingerprint (repeated
as often as it fits) useful for keysigning parties. The only argument is the same
as you would pass to GPG's list-keys command, either a key-id or a (partial) name.
The PS data is written to stdout.

=head1 OPTIONS

=over

=item B<-p> B<--paper-size> I<paper-size>

Select the output paper size. Default is to look into /etc/papersize or A4 if
libpaper isn't installed.

=item B<-s> B<--show-subkeys>

Enable subkey information to be printed on the slips. Subkey information is
normally not relevant to the key signing process.

=item B<-r> B<--revoked-style> I<revoked-style>

Select how to mark revoked UIDs and subkeys. Five styles are available:
 B<hide> don't show at all (default),
 B<show> show normally,
 B<grey> display in 50% grey,
 B<note> add "[revoked]", and
 B<strike> strike through.

=item B<-1>

Print only one column of paper slips instead of the default two. Useful for keys
with long UIDs that otherwise won't fit.

=item I<keyid>

Keyids to print. Multiple can be separated by spaces.

=item B<-h> B<--help>

Print usage and exit.

=item B<-v> B<--version>

Print version and exit.

=back

=head1 ENVIRONMENT

=over

=item I<HOME>

The default home directory.

=item I<GNUPGBIN>

The gpg binary.  Default: C<"gpg">.

=item I<GNUPGHOME>

The default working directory for gpg.  Default: C<$HOME/.gnupg>.

=back

=head1 SEE ALSO

=over

=item gpg(1)

GNU Privacy Guard.

=item gpg-key2latex(1)

Like B<gpg-key2ps>, but produces LaTeX output instead.

=item https://www.debian.org/events/materials/business-cards/

B<gpg-key2ps> prints plain fingerprint slips. If you are looking for something
more stylish, look at these latex templates for business cards that also
include fingerprints.

=back

=head1 AUTHORS AND COPYRIGHT

=over

=item (c) 2001-2005 Simon Richter <sjr@debian.org>

=item (c) 2005-2008 Thijs Kinkhorst <thijs@kinkhorst.com>

=item (c) 2005-2008 Christoph Berg <cb@df7cb.de>

=back
