Slackware::Slackget::GPG - A simple wrapper class to the gpg binary

    use Slackware::Slackget::GPG;

    my $slackware_slackget_gpg_object = Slackware::Slackget::GPG->new();

	- gpg_binary : where we can find a valid gpg binary (default: /usr/bin/gpg)

	my $sig = $gpg->verify("/usr/local/slack-get-1.0.0-alpha1/update/signature-cache/gcc-g++-3.3.4-i486-1.tgz","/usr/local/slack-get-1.0.0-alpha1/update/package-cache/gcc-g++-3.3.4-i486-1.tgz.asc");
	die "Signature doesn't match.\n" if(!$sig->is_good) ;

	$gpg->import_key('update/GPG-KEY') or die "unable to import official Slackware GnuPG key.\n";

    $gpg->in_keyring('Slackware Linux Project') or die "The GPG signature of the Slackware Linux project cannot be found in your keyring.\n";

	die "Cannot find gpg : $!\n" unless( -e $gpg->gpg_binary());

    perldoc Slackware::Slackget

package Slackware::Slackget::GPG;

use warnings;
use strict;
use Slackware::Slackget::GPG::Signature ;
use constant {
	SIG_GOOD => 'GOOD',
	SIG_BAD => 'BAD',
	SIG_UNKNOW => 'UNKNOW',
};

our $VERSION = '0.4';

sub new
{
	my ($class,%args) = @_ ;
	my $self={};
	$self->{DATA}->{gpg_binary} = '/usr/bin/gpg' ;
	$self->{DATA}->{gpg_binary} = $args{gpg_binary} if(exists($args{gpg_binary}) && defined($args{gpg_binary}));
	bless($self,$class);
	return $self;
}

sub verify_file
{
	my ($self,$file,$sig1) = @_;
	my @out = `2>&1 LC_ALL=C $self->{DATA}->{gpg_binary} --verify $sig1 $file`;
	
# 	gpg: CRC error; 040b69 - 24a901
# 	gpg: packet(3) with unknown version 3
# 
# 	gpg: Signature made Mon 14 Jun 2004 09:23:24 AM CEST using DSA key ID 40102233
# 	gpg: Good signature from "Slackware Linux Project <security@slackware.com>"
# 	gpg: WARNING: This key is not certified with a trusted signature!
# 	gpg:          There is no indication that the signature belongs to the owner.
	
# 	gpg: Signature made Mon 16 Feb 2004 07:53:35 AM CET using DSA key ID 40102233
# 	gpg: BAD signature from "Slackware Linux Project <security@slackware.com>"
	
	my $sig = new Slackware::Slackget::GPG::Signature;
	foreach (@out)
	{
# 		print "[DEBUG::GPG] $_\n";
		chomp;
		if($_ =~ /gpg: Signature made (.*) using DSA key ID (.*)/)
		{
			$sig->date($1);
			$sig->key_id($2);
		}
		if($_ =~ /gpg: CRC error;.*/)
		{
			$sig->status('BAD');
		}
		if($_ =~ /gpg: Good signature from "([^"]*)"/)
		{
			$sig->status('GOOD');
			$sig->emitter($1);
		}
		if($_ =~ /gpg: BAD signature/)
		{
			$sig->status('BAD');
		}
		if($_ =~ /gpg: BAD signature from "([^"]*)"/)
		{
			$sig->status('BAD');
			$sig->emitter($1);
		}
		if($_=~ /gpg: WARNING: (.*)/)
		{
			$sig->warnings([@{$sig->warnings()},$1]);
		}
		if($_=~ /Primary key fingerprint: ([0-9A-F\s]*)/)
		{
			$sig->fingerprint($1);
		}
		if($_=~ /gpg: verify signatures failed: (.*)/)
		{
			$sig->status('UNKNOW');
			$sig->warnings([@{$sig->warnings()},$1]);
		}
		if($_=~ /gpg: can't hash datafile: (.*)/)
		{
			$sig->status('UNKNOW');
			$sig->warnings([@{$sig->warnings()},"can't hash datafile",$1]);
		}
		
	}
	$sig->status('UNKNOW') unless($sig->status);
	return $sig;
}

sub import_key
{
	my ($self,$key) = @_ ;
	my @out = `2>&1 LC_ALL=C $self->{DATA}->{gpg_binary} --import $key`;
	my $sig = new Slackware::Slackget::GPG::Signature;
	$sig->status('BAD');
	foreach (@out){
	# key 40102233: public key "Slackware Linux Project <security@slackware.com>" imported
		if(/gpg: key ([^:]+): public key "([^"]+)" imported/){
			$sig->status('GOOD');
			$sig->key_id($1);
			$sig->emitter($2);
		}
	}
	
	return $sig;
}

sub in_keyring {
	my ($self, $string) = @_ ;
	my @r = ();
	foreach my $key ( $self->list_keys ){
		foreach (@{$key->{uid}}){
			push @r, $key if(/$string/);
		}
	}
	return scalar(@r);
}

# Put the next line in the pod when the *info methods are coded.
# To retrieve all information for a given key, use the key_info() method.

sub list_keys {
	my $self = shift;
	my @list = ();
	my @out = `2>&1 LC_ALL=C $self->{DATA}->{gpg_binary} --list-keys`;
	#pub   1024D/61BD09B3 2005-07-02
	foreach (@out){
		chomp;
		if(/^pub\s+[^\/]+\/([^\s]+)\s+.*$/){
			push @list, {key => $1, uid => []};
		}
		elsif(/^uid\s+(.+)$/){
			push @{ $list[$#list]->{uid} },$1;
		}
	}
	return @list;
}

# Put the next line in the pod when the *info methods are coded.
# To retrieve all information for a given key, use the sig_info() method.

sub list_sigs {
	my $self = shift;
	my @list = ();
	my @out = `2>&1 LC_ALL=C $self->{DATA}->{gpg_binary} --list-sigs`;
	foreach (@out){
		chomp;
		if(/^pub\s+[^\/]+\/([^\s]+)\s+.*$/){
			push @list, $1;
		}
		elsif(/^uid\s+(.+)$/){
			push @{ $list[$#list]->{uid} },$1;
		}
	}
	return @list;
}

# =head2 sig_info
# 
# Retrieve info on one of the user's keyring signature.
# 
# This method takes a uid (or a significant part of it) as parameter. 
# 
# If the uid is not unique enough to select one signature, this method return undef.
# 
# =cut
# # TODO: it sucks => list_* should return a list of key id and *_info return the rest of info !!
# sub sig_info {
# 	my ($self,$uid) = @_;
# 	my @out = `2>&1 LC_ALL=C $self->{DATA}->{gpg_binary} --list-sigs`;
# 	my $data = {};
# 	foreach (@out){
# 		chomp;
# 		if(/^uid\s+$uid/){
# 			$data->{uid} = $uid;
# 		}elsif(defined($data->{uid}) && $data->{uid} eq $uid ){ # you are never to cautious with test...
# 			if(//)
# 		}
# 	}
# }

sub gpg_binary
{
	return $_[1] ? $_[0]->{DATA}->{gpg_binary}=$_[1] : $_[0]->{DATA}->{gpg_binary};
}

1; # Fin de Slackware::Slackget::GPG