<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package PGP::Certificate::Signature;

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

use Carp;

BEGIN {
    no strict 'refs';

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

    %sppack = (2 =&gt; "N",
	       3 =&gt; "N",
	       9 =&gt; "N",
	       16 =&gt; "a8",
	       25 =&gt; "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-&gt;{"packet"}-&gt;$accessor();
	};
    }
};

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

    bless {
	"packet" =&gt; $packet,
    }, $classname;
}

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

    $self-&gt;{"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-&gt;{"packet"}-&gt;hashsubs &amp;&amp;
	$self-&gt;{"packet"}-&gt;hashsubs-&gt;{$num} &amp;&amp;
	(scalar(@{$self-&gt;{"packet"}-&gt;hashsubs-&gt;{$num}}) &gt; 0)) {
	return((unpack($sppack{$num},
		       $self-&gt;{"packet"}-&gt;hashsubs-&gt;{$num}-&gt;[0]))[0]);
    } elsif (($num == 16) &amp;&amp;
	     $self-&gt;{"packet"}-&gt;unhashsubs &amp;&amp;
	     (scalar(@{$self-&gt;{"packet"}-&gt;unhashsubs-&gt;{$num}}) &gt; 0)) {
	return((unpack($sppack{$num},
		       $self-&gt;{"packet"}-&gt;unhashsubs-&gt;{$num}-&gt;[0]))[0]);
    } else {
	return(undef);
    }
}

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

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

    my (@subpackets);

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

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

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

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

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

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

    my $expires = $self-&gt;subpacket("expires");

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

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

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

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

    $self-&gt;issuer?(uc unpack("x4H8", $self-&gt;issuer)):"&lt;&lt;x509&gt;&gt;";
}

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

    my $hash;

    if ($self-&gt;hashalg == 1) {
	$hash = new Digest::MD5;
    } elsif ($self-&gt;hashalg == 2) {
	$hash = new Digest::SHA1;
    } else {
	confess("Unimplemented hash algorithm ", $self-&gt;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-&gt;packet-&gt;bodyref}));
	    $data .= $ {$r-&gt;packet-&gt;bodyref};
	} elsif (ref($r) eq "PGP::Certificate::Userid") {
	    if ($self-&gt;packet-&gt;version == 4) {
		$data .= "\xb4";
		$data .= pack("N", length($ {$r-&gt;packet-&gt;bodyref}));
	    }

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

    $hash-&gt;add($data);

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

    $hash-&gt;digest;
}

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

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

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

	}
    }

    substr($self-&gt;hash($dataref),0,2) eq $self-&gt;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-&gt;packet-&gt;version &lt; 4) ||
	((scalar grep {$_ != 16} keys %{$self-&gt;packet-&gt;unhashsubs}) == 0)) {
	return($self-&gt;packet-&gt;packetref);
    }

    # extract the stuff before and after unhash subs

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

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

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

    my $otail = $obody-&gt;unpacka($obody-&gt;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-&gt;packet-&gt;unhashsubs-&gt;{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-&gt;{"packetref"});

    my $optag = $opacket-&gt;unpackC();

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

    my $pheader;

    if (($optag &amp; 0xc0) == 0x80) {
	if ($bodylen &lt; 256) {
	    $pheader = pack("CC", 0x80 | (2 &lt;&lt; 2) | 0x0, $bodylen);
	} elsif ($bodylen &lt; 65536) {
	    $pheader = pack("Cn", 0x80 | (2 &lt;&lt; 2) | 0x1, $bodylen);
	} else {
	    $pheader = pack("CN", 0x80 | (2 &lt;&lt; 2) | 0x2, $bodylen);
	}
    } elsif (($optag &amp; 0xc0) == 0xc0) {
	if ($bodylen &lt;= 191) {
	    $pheader = pack("CC", 0xc0 | 2, $bodylen);
	} elsif ($bodylen &lt;= 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;
</pre></body></html>