#   Copyright (c) 2006-8 Martin Schulze <joey@infodrom.org>
#
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; version 2 dated June, 1991.
#
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with this program;  if not, write to the Free Software
#   Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111, USA.

use strict;
use warnings;

use File::Temp;

package GAK::Backend;
use Exporter 'import';
our @EXPORT = qw/keylist fetchkey keydetails fingerprint
    do_add do_delete do_update/;

use constant SECRING => '/etc/apt/secring.gpg';
use constant KEYRING => '/etc/apt/trusted.gpg';
use constant TRUSTDB => '/etc/apt/trustdb.gpg';

use constant KEYSERVER => 'hkp://subkeys.pgp.net';

my $tmpdir;

sub keylist
{
    my @return;

    my $cmd = qq{gpg --no-options --no-default-keyring
		     --secret-keyring %s
		     --trustdb-name %s
		     --keyring %s
		     --with-colons --list-keys
		     2> /dev/null};
    $cmd =~ s/\r?\n//g;
    $cmd = sprintf ($cmd, SECRING, TRUSTDB, KEYRING);

    if (open (G, "$cmd|")) {
	while (<G>) {
	    next unless (/^pub:/);
	    chomp;
	    my @a = split (/:/);
	    push @return, [$a[4], $a[1], $a[6], $a[9]];
	}
	close (G);
    }
    return sort {$a->[3] cmp $b->[3]} @return;
}

sub keydetails
{
    my $key = shift;
    my @return;

    $key = '0x' . $key if ($key !~ /^0x/);
    my $cmd = qq{gpg --no-options --no-default-keyring
		     --secret-keyring %s
		     --trustdb-name %s
		     --keyring %s
		     --with-colons --list-key %s};
    $cmd =~ s/\r?\n//g;
    $cmd = sprintf ($cmd, SECRING, TRUSTDB, KEYRING, $key);

    if (open (G, "$cmd|")) {
	while (<G>) {
	    next unless (/^pub:/);
	    chomp;
	    my @a = split (/:/);
	    push @return, [@a];
	}
	close (G);
    }
    return sort {$a->[9] cmp $b->[9]} @return;
}

sub fingerprint
{
    my $key = shift;
    my $fingerprint;

    $key = '0x' . $key if ($key !~ /^0x/);
    my $cmd = qq{gpg --no-options --no-default-keyring
		     --secret-keyring %s
		     --trustdb-name %s
		     --keyring %s
		     --with-colons --fingerprint %s};
    $cmd =~ s/\r?\n//g;
    $cmd = sprintf ($cmd, SECRING, TRUSTDB, KEYRING, $key);

    if (open (G, "$cmd|")) {
	while (<G>) {
	    next unless (/^fpr:/);
	    chomp;
	    my @a = split (/:/);
	    $fingerprint = $a[9];
	}
	close (G);
    }

    my $return;

    my $div = length($fingerprint) == 32?2:4;
    $return .= substr ($fingerprint, $_*$div, $div) . " "
	foreach (0..int(length($fingerprint)/$div));
    chop $return;

    return $return;
}

sub fetchkey
{
    my $key = shift;

    $key = '0x' . $key unless $key =~ /^0x/;

    $tmpdir = File::Temp::tempdir (CLEANUP => 1) unless defined $tmpdir;

    system "touch $tmpdir/secring.gpg $tmpdir/trustdb.gpg";

    my $cmd = q{gpg --no-options --no-default-keyring
		    --secret-keyring %s/secring.gpg
		    --trustdb-name %s/trustdb.gpg
		    --keyring %s/pubring.gpg
		    --keyserver %s
		    --recv-keys %s
		    > /dev/null 2> /dev/null};
    $cmd =~ s/\r?\n//g;
    $cmd = sprintf ($cmd, $tmpdir, $tmpdir, $tmpdir, KEYSERVER, $key);
    system $cmd;

    if (-s $tmpdir.'/pubring.gpg') {
	$cmd = q{gpg --no-options --no-default-keyring
                    --secret-keyring %s/secring.gpg
                    --trustdb-name %s/trustdb.gpg
		    --keyring %s/pubring.gpg
		    --armour --export %s
                    > %s/key.asc
		    2> /dev/null};
	$cmd =~ s/\r?\n//g;
	$cmd = sprintf ($cmd, $tmpdir, $tmpdir, $tmpdir, $key, $tmpdir);
	system $cmd;

	if (-s $tmpdir.'/key.asc') {
	    $cmd = q{gpg --no-options --no-default-keyring
			 --secret-keyring %s/secring.gpg
			 --keyring %s/pubring.gpg
			 --no-auto-check-trustdb
			 --fingerprint %s
			 > %s/fingerprint.asc
			 2> /dev/null};
	    $cmd =~ s/\r?\n//g;
	    $cmd = sprintf ($cmd, $tmpdir, $tmpdir, $key, $tmpdir);

	    if (system($cmd) == 0) {
		if (open(FPRINT, $tmpdir.'/fingerprint.asc')) {
		    my @lines = <FPRINT>;
		    close FPRINT;
		    foreach (@lines) {
			if (/Key fingerprint = (.*)$/) {
			    return {'fname' => $tmpdir.'/key.asc',
				    'keyid' => $key,
				    'fingerprint' => $1};
			}
		    }
		}
	    }
	}
    }

    return 0;
}

sub do_update
{
    my $cmd = "/usr/bin/apt-key update > /dev/null 2> /dev/null";
    return (system ($cmd) == 0);
}

sub do_delete
{
    my $key = shift;

    my $cmd = "/usr/bin/apt-key del $key > /dev/null 2> /dev/null";
    return (system ($cmd) == 0);
}

sub do_add
{
    my $fname = shift;

    my $cmd = "/usr/bin/apt-key add $fname > /dev/null 2> /dev/null";
    return (system ($cmd) == 0);
}

#
# Make Perl happy
#
1;
