package PGP::Certificate::Signature;

use strict;
use vars qw(%sptype %sppack);

use Carp;

BEGIN {
    no strict 'refs';

    %sptype = ("created" => 2,
	       "expires" => 3,
	       "key_expires" => 9,
	       "issuer" => 16,
	       "primary_userid" => 25);

    %sppack = (2 => "N",
	       3 => "N",
	       9 => "N",
	       16 => "a8",
	       25 => "C");

#    %subpacket = (2, ["N", "created", "signature creation time"],
#		  3, ["N", "expires", "signature expiration time"],
#		  # only in direct signature:
#		  9, ["N", "key_expires", "key expiration time"],
#		  16, ["a8", "issuer", "issuer key ID"],
#		  # only in self signature:
#		  25, ["C", "primary_userid", "primary user id"]);

    foreach my $accessor (qw(sigtype pkalg hashalg expires hashmsb16)) {
	*{$accessor} = sub {
	    my ($this) = @_;
	    $this->{"packet"}->$accessor();
	};
    }
};

sub new {
    my ($classname, $packet) = @_;

    bless {
	"packet" => $packet,
    }, $classname;
}

sub packet {
    my ($self) = @_;

    $self->{"packet"};
}

# these next two methods implement a policy decision: the only
# unhashed subpacket which will be interpreted at the Certificate
# level will be subtype 16 (issuer).

sub subpacket {
    my ($self, $type) = @_;

    my $num = $sptype{$type} || $type;

    if ($self->{"packet"}->hashsubs &&
	$self->{"packet"}->hashsubs->{$num} &&
	(scalar(@{$self->{"packet"}->hashsubs->{$num}}) > 0)) {
	return((unpack($sppack{$num},
		       $self->{"packet"}->hashsubs->{$num}->[0]))[0]);
    } elsif (($num == 16) &&
	     $self->{"packet"}->unhashsubs &&
	     (scalar(@{$self->{"packet"}->unhashsubs->{$num}}) > 0)) {
	return((unpack($sppack{$num},
		       $self->{"packet"}->unhashsubs->{$num}->[0]))[0]);
    } else {
	return(undef);
    }
}

sub subpackets {
    my ($self, $type) = @_;

    my $num = $sptype{$type} || $type;

    my (@subpackets);

    if ($self->{"packet"}->hashsubs) {
	@{$self->{"packet"}->hashsubs->{$num}};
    }

    if (($num == 16) &&
	$self->{"packet"}->unhashsubs &&
	(scalar(@{$self->{"packet"}->unhashsubs->{$num}}) > 0)) {
	push(@subpackets, @{$self->{"packet"}->unhashsubs->{$num}});
    }

    map { (unpack($_, $sppack{$num}))[0] } @subpackets;
}

sub created {
    my ($self) = @_;

    $self->{"packet"}->created || $self->subpacket("created") ||
	confess("signature creation time required and not present");
}

sub expires {
    my ($self) = @_;

    my $expires = $self->subpacket("expires");

    $expires?
	($self->created + $expires):
	    undef;
}

sub issuer {
    my ($self) = @_;

    $self->packet->issuer || $self->subpacket("issuer");
}

sub issuertext {
    my ($self) = @_;

    $self->issuer?(uc unpack("x4H8", $self->issuer)):"<<x509>>";
}

sub hash {
    my ($self, $dataref) = @_;

    my $hash;

    if ($self->hashalg == 1) {
	$hash = new Digest::MD5;
    } elsif ($self->hashalg == 2) {
	$hash = new Digest::SHA1;
    } else {
	confess("Unimplemented hash algorithm ", $self->hashalg);
    }

    my $data = "";

    for my $r (@$dataref) {
	if ((ref($r) eq "PGP::Certificate") ||
	    (ref($r) eq "PGP::Certificate::Subkey")) {
	    $data .= "\x99";
	    $data .= pack("n", length($ {$r->packet->bodyref}));
	    $data .= $ {$r->packet->bodyref};
	} elsif (ref($r) eq "PGP::Certificate::Userid") {
	    if ($self->packet->version == 4) {
		$data .= "\xb4";
		$data .= pack("N", length($ {$r->packet->bodyref}));
	    }

	    $data .= $ {$r->packet->bodyref};
	} elsif (ref($r) eq "STRING") {
	    $data .= $$r;
	} elsif (! ref($r)) {
	    $data .= $r;
	} else {
	    confess("Cannot hash a ".ref($r));
	}
    }

    $hash->add($data);

    $hash->add(substr($ {$self->packet->bodyref},
		      $self->packet->hashbegin,
		      $self->packet->hashlen));
    if ($self->packet->version == 4) {
	$hash->add(pack("CCN", 0x04, 0xff, $self->packet->hashlen));
    }

    $hash->digest;
}

sub verify {
    my ($self, $dataref) = @_;

    if ($self->packet->version == 4) {
	my @sptypes = grep {$_ != 16} keys %{$self->packet->unhashsubs};

	if (@sptypes > 0) {
	    warn("signature (issuer = 0x".$self->issuertext.
		 " contains unsafe unhashed subpackets (types = [".
		 join(",",@sptypes)."])\n");

	}
    }

    substr($self->hash($dataref),0,2) eq $self->hashmsb16;
}


# This function is weird from an abstraction perspective.  It wants to
# be in PGP::Packet because it knows stuff about packet layout, and in
# PGP::Certificate because it implements policy.  I decided putting it
# here was a lesser evil.  I could put the packet-specific knowledge
# into the lower layer, but the necessary methods would be so
# special-case that they would be only useful for implemementing this
# method.

sub filtered_packetref {
    my ($self) = @_;

    # the only thing this filters are unhashsubs with type != 16.  if there's
    # nothing to strip, just return the old packet.

    if (($self->packet->version < 4) ||
	((scalar grep {$_ != 16} keys %{$self->packet->unhashsubs}) == 0)) {
	return($self->packet->packetref);
    }

    # extract the stuff before and after unhash subs

    my $obody = new PGP::Unpackable($self->{"bodyref"});

    my $ohead = $obody->unpacka($self->{"unhashsubsbegin"});
    my $ounhashsubslen = $obody->unpack("n");

    # throw away the old unhashsubs
    $obody->unpacka($ounhashsubslen);

    my $otail = $obody->unpacka($obody->remaining);

    # the unhashsubs are already parsed.  Just rebuild a new unhashsubs
    # section with the only possible valid type (16).  The only possible
    # length for this type is 4, so only one-packet length encodings will
    # ever be used.

    my $unhashsubs = join("",
			  map { pack("CN", 4, $_) }
			  @{$self->packet->unhashsubs->{16}});

    # figure out what kind of packet tag was on the old packet, so we
    # can use the same kind of tag.

    my $opacket = new PGP::Unpackable($self->{"packetref"});

    my $optag = $opacket->unpackC();

    my $bodylen = length($ohead)+2+length($unhashsubs)+length($otail);

    my $pheader;

    if (($optag & 0xc0) == 0x80) {
	if ($bodylen < 256) {
	    $pheader = pack("CC", 0x80 | (2 << 2) | 0x0, $bodylen);
	} elsif ($bodylen < 65536) {
	    $pheader = pack("Cn", 0x80 | (2 << 2) | 0x1, $bodylen);
	} else {
	    $pheader = pack("CN", 0x80 | (2 << 2) | 0x2, $bodylen);
	}
    } elsif (($optag & 0xc0) == 0xc0) {
	if ($bodylen <= 191) {
	    $pheader = pack("CC", 0xc0 | 2, $bodylen);
	} elsif ($bodylen <= 8383) {
	    $pheader = pack("CCC", 0xc0 | 2, int(($bodylen-192)/256)+192,
			    ($bodylen-192)%256);
	} else {
	    $pheader = pack("CCN", 0xc0 | 2, 255, $bodylen);
	}
    }

    my $packet = ($pheader+$ohead+pack("n", length($unhashsubs))+
		  $unhashsubs+$otail);

    return(\$packet);
}

1;