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

use strict;
use Carp;

use PGP::Constants qw(/^PKALG/);
use PGP::Certificate::Subkey;
use PGP::Certificate::Userid;
use PGP::Certificate::Signature;

BEGIN {
    no strict 'refs';

    foreach my $accessor (qw(created pkalg modlength fingerprint keyid)) {
	*{$accessor} = sub {
	    my ($this) = @_;
	    $this-&gt;{"packet"}-&gt;{$accessor};
	};
    }

    foreach my $accessor (qw(packet expires revocation direct_signatures
			     primary_userid secondary_userids subkeys)) {
	*{$accessor} = sub {
	    my ($this) = @_;
	    $this-&gt;{$accessor};
	};
    }
};

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

    my $self = bless {}, $classname;

    my ($userid, $subkey, @subrevs);

    for my $packet (@$packetsref) {
	if ($packet-&gt;ctag == 6) {
	    $self-&gt;{"packet"} = $packet;
	    $self-&gt;{"expires"} = $packet-&gt;{"expires"};
	} elsif ($packet-&gt;ctag == 14) {
	    $subkey = new PGP::Certificate::Subkey($packet);
	    push(@{$self-&gt;{"subkeys"}}, $subkey);
	} elsif ($packet-&gt;ctag == 13) {
	    $userid = new PGP::Certificate::Userid($packet);
	    push(@{$self-&gt;{"secondary_userids"}}, $userid);
	} elsif ($packet-&gt;ctag == 2) {
	    my $sig = new PGP::Certificate::Signature($packet);
	    my $sigtype = $sig-&gt;sigtype;

	    if ($sigtype == 0x20) {
		# sig is computed over pubkey
		$self-&gt;set_revocation($sig);
	    } elsif ($sigtype == 0x1f) {
		$self-&gt;add_direct($sig);
	    } elsif (($sigtype &gt;= 0x10) &amp;&amp; ($sigtype &lt;= 0x13)) {
		if (! $userid) {
		    push(@{$self-&gt;{"misordered_signatures"}}, $sig);
		} else {
		    $userid-&gt;add_signature($sig, $self-&gt;{"packet"}-&gt;keyid);
		}
	    } elsif ($sigtype == 0x28) {
		if (! $subkey) {
		    push(@{$self-&gt;{"misordered_signatures"}}, $sig);
		} else {
		    push(@subrevs, $sig);
		}
	    } elsif ($sigtype == 0x18) {
		if (! $subkey) {
		    push(@{$self-&gt;{"misordered_signatures"}}, $sig);
		} else {
		    $subkey-&gt;set_binding($sig);
		}
	    } elsif (! $userid &amp;&amp; ! $subkey) {
		push(@{$self-&gt;{"misordered_signatures"}}, $sig);
	    }
	}
    }

    # now handle all the subkey revocations.  This kludge is necessary
    # because the old keyserver would treat the revocation as a
    # signature on the last userid, so I need to compute the
    # revocation hashes to see which revocations really go with which
    # subkeys.

    subrev: for my $subrev (@subrevs) {
	for $subkey (@{$self-&gt;subkeys}) {
	    my $check = $subrev-&gt;hashmsb16;
	    my $computed = substr($subrev-&gt;hash([$self, $subkey]),
				  0,2);
	    if ($check eq $computed) {
		$subkey-&gt;set_revocation($subrev);
		next subrev;
	    }
	}

	confess("No matching subkey for revocation");
    }

    # order the direct signatures

    if ($self-&gt;{"direct_signatures"}) {
	@{$self-&gt;{"direct_signatures"}} = 
	    sort { $b-&gt;created &lt;=&gt; $a-&gt;created }
	@{$self-&gt;{"direct_signatures"}};
    } else {
	$self-&gt;{"direct_signatures"} = [];
    }

    # order the userids
    # first, the userids whose self-sigs have the primary_userid
    #  flag set, in order of self-sig creation
    # next, the other userids which have self-sigs, in order of
    #  self-sig creation
    # finally, all other userids in cmp order

    @{$self-&gt;{"secondary_userids"}} = 
	sort {
	    (
	     (($b-&gt;self_signature?1:0) &lt;=&gt;
	      ($a-&gt;self_signature?1:0)) ||
	     (($b-&gt;self_signature?1:0) &amp;&amp;
	      ((($b-&gt;primary_userid?1:0) &lt;=&gt;
		($a-&gt;primary_userid?1:0)) ||
	       ($b-&gt;self_signature-&gt;created &lt;=&gt;
		$a-&gt;self_signature-&gt;created))) ||
	     ($a-&gt;name cmp
	      $b-&gt;name)
	     );
	} @{$self-&gt;{"secondary_userids"}};

    $self-&gt;{"primary_userid"} = shift(@{$self-&gt;{"secondary_userids"}});

    # order the subkeys

    if ($self-&gt;{"subkeys"}) {
	@{$self-&gt;{"subkeys"}} = 
	    sort { $b-&gt;created &lt;=&gt; $a-&gt;created } @{$self-&gt;{"subkeys"}};
    } else {
	$self-&gt;{"subkeys"} = [];
    }

    return($self);
}

sub _pkalg_sign {
    my ($alg) = @_;

    ($alg == PKALG_RSA ||
     $alg == PKALG_RSA_SIG ||
     $alg == PKALG_DSA);
}

sub _pkalg_encrypt {
    my ($alg) = @_;

    ($alg == PKALG_RSA ||
     $alg == PKALG_RSA_ENC ||
     $alg == PKALG_ELGAMAL);
}

sub set_revocation {
    my ($self, $sig) = @_;

    if (!$self-&gt;{"revocation"} ||
	$self-&gt;{"revocation"}-&gt;created &lt; $sig-&gt;created) {
	$self-&gt;{"revocation"} = $sig;
    }
}

sub add_direct {
    my ($self, $sig) = @_;

    push(@{$self-&gt;{"direct_signatures"}}, $sig);

    my $spexpires = $sig-&gt;created + $sig-&gt;subpacket("key_expires");

    if ($spexpires &amp;&amp;
	(! $self-&gt;{"expires"} ||
	 $self-&gt;{"expires"} &gt; $spexpires)) {
	$self-&gt;{"expires"} = $spexpires;
    }
}

# ================

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

    my ($sign, $encrypt);

    # XXX The semantics here are the same as pgp5.  I'm not certain,
    # since the code is spaghetti, and I'm not excited by the
    # semantics anyway.

    $sign += _pkalg_sign($self-&gt;pkalg);
    $encrypt += _pkalg_encrypt($self-&gt;pkalg);

    if (!$self-&gt;expires ||
	$self-&gt;expires &gt;= time()) {
	for my $sub (@{$self-&gt;subkeys}) {
	    $sign += _pkalg_sign($sub-&gt;pkalg);
	    $encrypt += _pkalg_encrypt($sub-&gt;pkalg);
	}
    }

    my $ret;

    if ($sign &amp;&amp; $encrypt) {
	$ret = "Sign &amp; Encrypt";
    } elsif ($sign) {
	$ret = "Sign only";
    } elsif ($encrypt) {
	$ret = "Encrypt only";
    } else {
	$ret = "";
    }

    return($ret);
}

sub userids {
    my ($self, $sig) = @_;

    [ $self-&gt;{"primary_userid"}, @{$self-&gt;{"secondary_userids"}} ];
}

sub _verify_sig {
    my ($sig, $dataref) = @_;

    if (! $sig) {
	return(1);
    }

    $sig-&gt;verify($dataref);
}

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

    # check if there were any misordered signatures

    my $mocount = ($self-&gt;{"misordered_signatures"}?
		   @{$self-&gt;{"misordered_signatures"}}:0);

    if ($mocount &gt; 0) {
	warn("Certificate had $mocount misordered signatures\n");
    }

    # verify the revocation

    _verify_sig($self-&gt;revocation, [$self]) ||
	warn("revocation signature hash check failed\n");

    # verify the direct_signatures

    for my $dsig (@{$self-&gt;direct_signatures}) {
	_verify_sig($dsig, [$self]) ||
	    warn("direct signature hash check failed\n");
    }

    # verify the primary_userid (self_signature, other_signatures)
    
    _verify_sig($self-&gt;primary_userid-&gt;self_signature,
		[$self, $self-&gt;primary_userid]) ||
	warn("primary_userid self_signature hash check failed\n");

    for my $osig (@{$self-&gt;primary_userid-&gt;other_signatures}) {
	_verify_sig($osig, [$self, $self-&gt;primary_userid]) ||
	    warn("primary_userid other_signature (issuer = 0x".
		 $osig-&gt;issuertext.
		 ") hash check failed\n");
    }

    # verify the secondary_userids (self_signature, other_signatures)

    for my $suid (@{$self-&gt;secondary_userids}) {
	_verify_sig($suid-&gt;self_signature, [$self, $suid]) ||
	    warn("secondary_userid \"".
		 $suid-&gt;name.
		 "\" self_signature hash check failed\n");

	for my $osig (@{$suid-&gt;other_signatures}) {
	    _verify_sig($osig, [$self, $suid]) ||
		warn("secondary_userid \"".
		     $suid-&gt;name.
		     "\" other_signature (issuer = 0x".
		     $osig-&gt;issuertext.
		     ") hash check failed");
	}
    }

    # verify the subkeys (binding and revocation)

    for my $sk (@{$self-&gt;subkeys}) {
	_verify_sig($sk-&gt;binding, [$self, $sk]) ||
	    warn("subkey 0x".
		 (uc unpack("x4H8", $sk-&gt;keyid)).
		 " binding hash check failed");

	_verify_sig($sk-&gt;revocation, [$self, $sk]) ||
	    warn("subkey 0x".
		 (uc unpack("x4H8", $sk-&gt;keyid)).
		 " revocation hash check failed");
    }
}

1;
</pre></body></html>