# 2004 (c) Christoph Berg <cb@df7cb.de>
# This program is free software covered by the GNU GPL.
# 2004-06-27 cb: initial version
# 2005-07-06 cb: purging subkeys

package GnuPG::Wrapper;

use strict;
use warnings;

sub new {
	my $agpg = shift;
	my $self = {
		gpg => 'gpg',
		agpg => $agpg || 'agpg',
		keyring_args => '',
		verbose => 0,
	};
	bless $self;
}

sub normalize_keyid {
	my $self = shift;
	$self->{keyid} = shift;
	open G, "$self->{gpg} -q $self->{keyring_args} --list-key --fixed-list-mode --with-colon $self->{keyid} |" or die "gpg: $!";
	local $_;
	while (<G>) {
		chomp;
		next if /^tru:/; # TODO: what's that? trust?
		next if /^sub:/;
		#pub:q:1024:17:0596CD7FCA9EADCF:1062764361:::-:::scESC:
		if(/^pub:[-qmfu]:\d{3,}:\d+:([0-9A-F]+):\d+:\d*::[-qmfu]:::[escESC]+:$/) {
			$self->{keyid} = $1;
			last;
		}
	}
	close G;
	return $self->{keyid};
}

sub set_keyid {
	my $self = shift;
	my $keyid = shift || die "set_keyid: no keyid";
	$self->{keyid} = $keyid;
	return $self;
}

sub set_mykeyid_list {
	my $self = shift;
	@{$self->{mykeyid_list}} = @_;
	return $self;
}

sub set_mykeyid {
	my $self = shift;
	my $mykeyid = shift || die "set_mykeyid: no keyid";
	$self->{mykeyid} = $mykeyid;
	#print "mykeyid = $self->{mykeyid}\n";
	return $self;
}

sub set_keyring {
	my $self = shift;
	my $keyring = shift || die "set_keyring: no keyring";
	$self->{keyring} = $keyring;
	$self->{keyring_args} = $keyring ? "--no-default-keyring --keyring $keyring" : "";
}

sub get_uid_list {
	my $self = shift;
	my $uid_count;
	# note: $self->{uid_list} starts with index 1 (!)

	print "$self->{gpg} -q $self->{keyring_args} --list-key --fixed-list-mode --with-colon $self->{keyid} |" or die "gpg: $!" if $self->{verbose};
	open G, "$self->{gpg} -q $self->{keyring_args} --list-key --fixed-list-mode --with-colon $self->{keyid} |" or die "gpg: $!";
	local $_;
	while (<G>) {
		chomp;
		next if /^tru:/; # TODO: what's that? trust?
		next if /^sub:/;
		#pub:q:1024:17:0596CD7FCA9EADCF:1062764361:::-:::scESC:
		if(/^pub:[-qmfu]:\d{3,}:\d+:([0-9A-F]+):\d+:\d*::[-qmfu]:::[escESC]+:$/) {
			$self->{keyid} = $1;
		} elsif(/^uid:[-qmfu]::::::::(.+):$/) {
			print "$1\n" if $self->{verbose};
			$self->{uid_list}[++$uid_count] = $1;
		} elsif(/^uid:[r]::::::::(.+):$/) {
			$self->{uid_list}[++$uid_count] = undef; # uid is revoked
		} elsif(/^uat:[-qmfu]::::::::(.+):$/) {
			$self->{uid_list}[++$uid_count] = undef; # subkey (to be removed)
		} else {
			die "unknown line format: $_";
		}
	}
	close G;

	return $uid_count;
}

sub set_uidnr {
	my $self = shift;
	$self->{uidnr} = shift;
	die "no such uidnr: $self->{uidnr}" if $self->{uidnr} > @{$self->{uid_list}};
	return $self->{uid} = $self->{uid_list}[$self->{uidnr}];
}

sub print_fingerprint {
	my $self = shift;
	system "gpg -q --fingerprint $self->{keyid}";
	return $self;
}

sub export_key {
	my $self = shift;
	my $args = shift;
	my $return = `$self->{gpg} -q $self->{keyring_args} --export -a --yes $self->{keyid}`;
	if($? >> 8 > 0) {
		die "gpg --export failed";
	}
	return $return;
}

sub import_keys {
	my $self = shift;
	$self->{keyring} or die "no keyring set";
	my $keys = join(" ", @_);
	system "gpg -q -o $self->{keyring} --yes --export $keys";
	if($? >> 8 > 0) {
		die "gpg --export failed";
	}
	return $self;
}

sub purge_key {
	my $self = shift;
	$self->{keyring} or die "no keyring";
	$self->{keyid} or die "no keyid";
	$self->{uidnr} or die "no uidnr";
	print "Purging key $self->{keyid} / uid $self->{uidnr}\n";
	system "./purgesigs $self->{keyring} $self->{keyid} $self->{uidnr}";
	die "Something went wrong with purgesigs" if $? >> 8 > 0;
	return $self;
}

sub sign_key {
	my $self = shift;
	die "no mykeyid" unless $self->{mykeyid};
	#print "expect sign.expect $self->{agpg} $self->{keyid} $self->{keyring} $self->{mykeyid} > /dev/null 2>&1\n";
	system "expect sign.expect $self->{agpg} $self->{keyid} $self->{keyring} $self->{mykeyid} > /dev/null 2>&1";
	if($? >> 8 == 10) {
		warn "Uid is already signed, skipping...\n";
		return $self;
	}
	if($? >> 8 == 1) {
		print "Error while signing key, read work/sign.log\n";
		exit 1;
	}
	die "Something went wrong with sign.expect" if $? >> 8 > 1;
	#print "Ok.\n";
	sleep 1;

	return $self;
}

sub is_signed {
	my $self = shift;
	#print "is_signed($self->{keyid} $self->{mykeyid})\n";
	open G2, "$self->{agpg} -q $self->{keyring_args} --list-sigs --fixed-list-mode --with-colon $self->{keyid} |" or die "gpg: $!";
	my $k = $self->{mykeyid};
	$k =~ s/^0x//;
	my $is_signed = 0;
	local $_;
	while (<G2>) {
		chomp;
		#print "is_signed:$_\n";
		next if /^(pub|rev|sub|tru|uat):/;
		next if /^uid:/;
		#sig:::1:B46B923B6D8ABE71:1088461831:1111557260:::Christoph Berg <cb@df7cb.de>:13x:
		if(/^sig:::\d+:([0-9A-F]+):\d+:\d*:::.*:\d+f?x:$/) {
			my $signer = $1;
			next if $signer eq $self->{keyid};
			if($signer eq $k) {
				$is_signed = 1;
				next;
			}
			next if(grep { $signer eq $_; } @{$self->{mykeyid_list}});
			warn "Key $self->{keyid} contains a signature from $signer in $self->{keyring} that shouldn't be there ($_)";
		} else {
			die "unknown line format: $_";
		}
	}
	close G2;
	return $is_signed;
}

sub right_uid_selected {
	my $self = shift;
	open G2, "$self->{gpg} -q $self->{keyring_args} --list-key --fixed-list-mode --with-colon $self->{keyid} |" or die "gpg: $!";
	my $right = 0;
	local $_;
	while (<G2>) {
		chomp;
		next if /^tru:/;
		next if /^sub:/;
		next if /^pub:/;
		if(/^uat:/) {
			die "subkey left over";
		}
		if(/^uid:[-qmfu]::::::::(.+):$/) {
			die "wrong uid ($1) cut out, expected $self->{uid}" if $1 ne $self->{uid};
			$right = 1;
		} else {
			die "unknown line format: $_";
		}
	}
	close G2;
	return $right;
}

sub encrypt_file {
	my $self = shift;
	my $file = shift;
	my $command = "$self->{agpg} -q -se -r $self->{keyid} --always-trust -a --yes -o - $file";
	my $return = `$command`;
	if($? >> 8 > 0) {
		die "$command failed";
	}
	return $return;
}

1;