#!perl -w
use strict;
use IO::File;
use Digest::MD5 qw(md5);
use Digest::SHA qw(sha1);
use Math::BigInt lib=>'GMP';
use WildcardArgs;
use Getopt::Long;

# perl exesignature.pl -v -s /Users/itsme/cvsprj/secphone/trunk/installer/build/PhoneID.dll
# openssl asn1parse -i -inform DER -offset $[0x5a08] -in /Users/itsme/cvsprj/secphone/trunk/installer/build/PhoneID.dll 
# dump -o 0x5a08 -c /Users/itsme/cvsprj/secphone/trunk/installer/build/PhoneID.dll | asn1dump -


# certificates are described in http://tools.ietf.org/html/rfc5280  - x509
# signatures are described in   http://tools.ietf.org/html/rfc2315  - pkcs#7

# issue with 'context[0] = version' for old certificates, this field is not present
# and should be skipped. .... maybe make path selector skip 'context' fields
my $md5oid=oidpack("1.2.840.113549.2.5");
my $shaoid=oidpack("1.3.14.3.2.26");
my $recurse;
my $verbose=0;
my $g_algname= "Digest::MD5";
my @algparams= ();
GetOptions(
    "v+"=>\$verbose,
    "r"=>\$recurse,
    "s"=> sub { $g_algname= "Digest::SHA"; @algparams=(1); },
);
$|=1;
handlearg($_, \&decodefile, recurse=>$recurse) for @ARGV;

# finds signatures attached to file
sub decodefile {
    my $fn= shift;
    my $fh= IO::File->new($fn, "r");
    if (!$fh) {
        warn "$fn: $!\n";
        return;
    }
    binmode $fh;

    printf("------ %s\n", $fn) if ($verbose>1);
    my $data;
    $fh->read($data, -s $fh<0x1000 ? -s $fh : 0x1000);

    eval {
        my $exe= getexeinfo($data);
        if (!$exe) {
            $fh->close();
            die "no exe\n";
        }
        if ($verbose>1 || ($exe->{checksum}==0 && $verbose) || ($exe->{checksum} && $exe->{checksum} != calc_exe_sum($exe, $fh))) {
            printf("checksum: file: %08lx, calc: %08lx - %s\n", $exe->{checksum}, calc_exe_sum($exe, $fh), $fn);
        }
        my $sigdata;
        my %hash;
        if ($exe->{secofs}==0 || $exe->{secsize}==0) {
            printf("no SEC section - %s\n", $fn);
            return;
        }
        if ($exe->{secofs}>=(-s $fh) || ($exe->{secofs}+$exe->{secsize})>(-s $fh)) {
            printf("invalid SEC section %08lx-%08lx  - %s\n", $exe->{secofs}, $exe->{secofs}+$exe->{secsize}, $fn);
            return;
        }

        $fh->seek($exe->{secofs}, SEEK_SET);
        $fh->read($sigdata, $exe->{secsize});
        my @sigs= parsesigdata($sigdata);
        if (!@sigs) {
            printf("no sigs in SEC section! - %s\n", $fn);
            return;
        }
        if (@sigs>1) {
            printf("%d:%-45s %s\n", scalar @sigs, join(", ", map { sprintf("L%04x v%04x T%d", $_->{len}, $_->{version}, $_->{type} ) } @sigs), $fn);
            warn "!!! exe has multiple signatures\n";
        }
        my $prefix= $sigs[0]{version}==0x100 ? "" : $sigs[0]{version}==0x200 ? "0.1." : undef;

        my $asn1sig= $sigs[0]{asn1};

        my $hashalg= getnode($asn1sig, "${prefix}0.2.1.0.1.0.0")->{contents};
        my $hashval= getnode($asn1sig, "${prefix}0.2.1.0.1.1")->{contents};
        my %certs;
        my $id=0;
        while (my $cert= getnode($asn1sig, "${prefix}0.3.$id")) {

            my $cakeyidnode= getnode($cert->{decoded}, "0.7.0.0.1.0.0");
            my $caserialnode= getnode($cert->{decoded}, "0.7.0.0.1.0.2");

            my $certinfo= {
                id=>$id,
                raw=>$cert->{header}.$cert->{contents},
                serial  =>getnode($cert->{decoded}, "0.1")->{contents},
                modulus =>getnode($cert->{decoded}, "0.6.1.0.0")->{contents},
                exponent=>getnode($cert->{decoded}, "0.6.1.0.1")->{contents},
                $cakeyidnode ? (cakeyid =>$cakeyidnode->{contents}) : (),
                $caserialnode ? (caserial=>$caserialnode->{contents}) : (),
            };
            if (exists $certs{$certinfo->{serial}}) {
                if ($certs{$certinfo->{serial}}{raw} ne $certinfo->{raw}) {
                    die sprintf("!!! multiple certificates with the same serial: %s\n", unpack("H*",$certinfo->{serial}));
                }
                printf("warning: certificate %s in signature with id %d and %d\n", unpack("H*",$certinfo->{serial}), $certs{$certinfo->{serial}}{id}, $certinfo->{id});
            }
            $certs{$certinfo->{serial}}= $certinfo;
            printf("cert.%d %s - sha1=%s\n", $id, unpack("H*",$certinfo->{serial}), unpack("H*", Digest::SHA::sha1($certinfo->{raw}))) if ($verbose);

            $id++;
        }
        # 0.1.0.2.1.0 = seq { ... }   : md5(...) = 
        # 0.1.0.4.0.3  = authenticated attributes: contains md5 of 0.1.0.2.1.0

        my $hash= calc_exe_hash($exe, $fh, get_hash($hashalg));
        printf("exehash: %s\n", unpack("H*", $hash)) if ($verbose);

        if ($hash ne $hashval) {
            die sprintf("ERROR: exe hash mismatch: %s != %s [ alg %s ]\n", unpack("H*", $hash), unpack("H*", $hashval), ref get_hash($hashalg));
        }
        # -> hash(exe) = hash in signeddata

        my $signeddata= getnode($asn1sig, "${prefix}0.2.1.0")->{contents};

        my $authhashalg= getnode($asn1sig, "${prefix}0.4.0.2.0")->{contents};
        my $sigdatahash= calc_hash($signeddata, get_hash($authhashalg));
        printf("sighash: %s\n", unpack("H*", $sigdatahash)) if ($verbose);

        # decode auth attr
        my %attrs;
        my $aid=0;
        while (my $anode=getnode($asn1sig, "${prefix}0.4.0.3.$aid")) {
            my $attroid= getnode($anode->{decoded}, "0")->{contents};
            my $attrval= getnode($anode->{decoded}, "1.0")->{contents};

            if (exists $attrs{$attroid}) {
                printf("WARN: duplicate auth attr: %d\n", $aid);
            }
            $attrs{$attroid}= $attrval;
            printf("attr.%d %s - %s\n", $aid, unpack("H*", $attroid), unpack("H*", $attrs{$attroid})) if ($verbose);
            $aid++;
        }
        my $messageDigestOid= pack 'H*', "2a864886f70d010904";
        if (!exists $attrs{$messageDigestOid}) {
            die sprintf("no messagedigest in authenticated attrs: %s\n", $fn);
        }
        # check if hash(signeddata:0.2.1.0 ) is at 0.4.0.3.2.1.0
        my $storedhash= $attrs{$messageDigestOid};
        if ($sigdatahash ne $storedhash) {
            die sprintf("ERROR: sdata:%s  stored:%s\n", unpack("H*", $sigdatahash), unpack("H*", $storedhash));
        }

        my $certserialfromsig= getnode($asn1sig, "${prefix}0.4.0.1.1")->{contents};

        if (!exists $certs{$certserialfromsig}) {
            die sprintf("could not find cert with serial %s\n", unpack("H*", $certserialfromsig));
        }
        # search cert list ( 0.3.0, 0.3.1, ... etc ) for $certserialfromsig
        my $cert= $certs{$certserialfromsig};

        # check if hash(authenticatedattr:0.4.0.3)  is rsacalc(sig:0.4.0.5)
        my $authattrnode= getnode($asn1sig, "${prefix}0.4.0.3");
        my $rsasig= getnode($asn1sig, "${prefix}0.4.0.5")->{contents};
        my $decryptedsig= rsacalc($rsasig, $cert->{exponent}, $cert->{modulus});
        my ($sigstoredhash, $sigalg)= extractsig($decryptedsig);

        my $authattr= "\x31".substr($authattrnode->{header},1).$authattrnode->{contents};
        my $authattrhash= calc_hash($authattr, get_hash($sigalg));
        printf("authhash: %s\n", unpack("H*", $authattrhash)) if ($verbose);

        if ($authattrhash ne $sigstoredhash) {
            die sprintf("ERROR: attr:%s  sig:%s\n", unpack("H*", $authattrhash), unpack("H*", $sigstoredhash));
        }

        printf("certserial= %s\n", unpack("H*", $certserialfromsig)) if ($verbose);
        printf("ca keyid+serial: %s %s\n", $cert->{cakeyid} ? unpack("H*", $cert->{cakeyid}):"?", $cert->{caserial} ? unpack("H*", $cert->{caserial}): "?") if ($verbose);

        printf("sig ok %s\n", $fn);
    };
    if ($@) {
        printf("ERROR processing %s\n%s\n", $fn, $@);
    }
    $fh->close();
}

# returns {peofs,secofs,secsize} for a valid PE file
sub getexeinfo {
    return unless substr($_[0],0,2) eq "MZ";
    my $peofs= unpack("V", substr($_[0], 0x3c,4));
    return if $peofs > length($_[0])-0x40;

    # check PE magic
    return unless substr($_[0],$peofs,4) eq "PE\x00\x00";

    # check coff magic
    return unless substr($_[0],$peofs+0x18,2) eq "\x0b\x01";

    my $opthdrsize= unpack("v", substr($_[0], $peofs+0x14, 2));

    my $checksum= unpack("V", substr($_[0], $peofs+0x58, 4));
    # get SEC info item
    my ($secofs, $secsize)=unpack("VV", substr($_[0], $peofs+0x98, 8));

    return { peofs=>$peofs, checksum=>$checksum, secofs=>$secofs, secsize=>$secsize };
}
# returns either MD5 or SHA1 hash object
sub get_hash {
    my ($hashalg)= @_;
    my $algname= $hashalg eq $md5oid ? "Digest::MD5" : $hashalg eq $shaoid ? "Digest::SHA" : undef;
    my @algparams= $hashalg eq $md5oid ? () : $hashalg eq $shaoid ? (1) : ();
    if (!$algname) {
        die sprintf("unknown hash algorithm: %s\n", oidunpack($hashalg));
    }
    return $algname->new(@algparams);
}
sub calc_hash {
    my ($data, $alg)= @_;
    $alg->add($data);
    return $alg->digest();
}
# calculate the pe hash using the given algorithm
# returns binary digest
sub calc_exe_hash {
    my ($exe, $fh, $alg)= @_;
    my $prechksumdata;
    $fh->seek(0, SEEK_SET);
    $fh->read($prechksumdata, $exe->{peofs}+0x58);
    $alg->add($prechksumdata);

    $fh->seek(4, SEEK_CUR);

    my $betweenchksum_and_secptr;
    $fh->read($betweenchksum_and_secptr, 0x98-0x5c);
    $alg->add($betweenchksum_and_secptr);

    $fh->seek(8, SEEK_CUR);

    # todo: instead of hashing raw diskimage, in reality i should
    # hash each section individually, this matters for overlapping sections.
    my $ofs= $fh->tell();
    my $end= $exe->{secofs} || -s $fh;

    while ($ofs < $end) {
        my $wanted= 0x100000;
        $wanted= $end-$ofs if ($end-$ofs< $wanted);
        my $chunk;
        $fh->read($chunk, $wanted);
        $alg->add($chunk);
        $ofs += $wanted;
    }

    # see the Microsoft Distributed System Architecture, Attribute Certificate Architecture Specification. 
    #
    # todo: optionally exclude debug section + debug entry
    # todo: optionally exclude resource section + res entry
    # optionally set these opthdr fields to 0:
    #   peofs optofs
    #      4c    34 - reserved
    #      5e    46 - dllflags
    #             ? - loaderflags
    #      70    58 - reserved
    return $alg->digest();
}

# calculates the exe header checksum
# see ~/sources/winlike/wine-1.1.16/dlls/imagehlp/modify.c
sub calc_exe_sum {
    my ($exe, $fh)= @_;
    my $checksum=0;
    $fh->seek(0, SEEK_SET);
    my $ofs=0;

    # NOTE: need to read in 128k byte blocks, since 64k words summed <= 0xffff0000
    #  so we can do the 'adc' from the original algorithm by summing hi+lo words
    while (!$fh->eof) {
        my $block;
        $fh->read($block, 0x20000);
        my $sum= unpack("%32v*", $block);
        $checksum += ($sum&0xffff) + (($sum>>16)&0xffff);

        $ofs += length($block);
    }
    $checksum = ($checksum&0xffff) + (($checksum>>16)&0xffff);
    if (($checksum&0xffff) >= ($exe->{checksum}&0xffff)) {
        $checksum -= $exe->{checksum}&0xffff;
    }
    else {
        $checksum =( (($checksum&0xffff) - ($exe->{checksum}&0xffff))&0xffff ) - 1;
    }

    if (($checksum&0xffff) >= (($exe->{checksum}>>16)&0xffff)) {
        $checksum -= ($exe->{checksum}>>16)&0xffff;
    }
    else {
        $checksum =( (($checksum&0xffff) - (($exe->{checksum}>>16)&0xffff))&0xffff ) - 1;
    }

    $checksum += -s $fh;

    return $checksum;
}

# returns list of parsed signatures in sigdata
sub parsesigdata {
    my ($sigdata)= @_;
    my $ofs= 0;
    my @sigs;
    while ($ofs+8 <= length($sigdata)) {
        my ($len, $version, $type)= unpack("Vvv", substr($sigdata, $ofs, 8));
        last if $len==0;

        if ($len>length($sigdata)-$ofs) {
            die sprintf("invalid cert at %08lx: l=%04x, > left=%04x\n", $ofs, $len,length($sigdata)-$ofs);
            last;
        }
        else {
    # see WIN_CERTIFICATE struct in wintrust.h
    # version:
    #   0x0100
    #   0x0200
    # type:
    #
    #   0x0001: X509            
    #   0x0002: PKCS_SIGNED_DATA
    #   0x0003: RESERVED_1      
    #   0x0004: TS_STACK_SIGNED     - 128 byte raw sig data

            my $asn1data= substr($sigdata, $ofs+8, $len-8);
            push @sigs, { asn1=>decodeasn1($asn1data), version=>$version, type=>$type, len=>$len };
        }

        $ofs += $len;
    }
    if ($ofs>length($sigdata)) {
        die sprintf("ofs=%08lx > ss=%08lx\n", $ofs,length($sigdata));
    }
    return @sigs;
}

# returns tree describing the asn1 blob
sub decodeasn1 {
    my ($data, $indefinite)= @_;
    #my $level= shift || 0;
    my $ofs=0;

    return undef if ($data =~ /^(\x00.)*$/);
    $ofs++ if ($data =~ /^\x00/);
    my @list;
    while ($ofs<length($data)) {
        my $hofs= $ofs;
        # first process the identifier octet
        my $id= unpack("C", substr($data, $ofs++, 1));
        my ($class, $constructed, $tag)= ($id>>6, $id&0x20, $id&0x1f);
        if ($tag==0x1f) {
            $tag=0;
            # optionally process a tag value >= 31
            while ($ofs<length($data)) {
                my $val= unpack("C", substr($data, $ofs++, 1));
                $tag<<=7;
                $tag|=($val&0x7f);
                last if (($val&0x80)==0);
            }
            #printf(".. large tag %x\n", $tag);
        }
        # process the length
        last if ($ofs>=length($data));
        my $length= unpack("C", substr($data, $ofs++, 1));
        if ($length==0x80) {
            $length= -1;
        }
        elsif ($length&0x80) {
            my $n= 0;
            $length &= 0x7f;
            #printf(".. large length %x\n", $length);
            if ($length>4) {
                return undef;
            }
            while ($length-- && $ofs<length($data)) {
                $n<<=8;
                $n |= unpack("C", substr($data, $ofs++, 1));
            }
            $length= $n;
        }
        my $cofs= $ofs;
        # get the contents
        my $contents;
        if ($length==-1) {
            $contents= substr($data, $ofs);
            #printf("indefinate contents l=%x\n", length($contents));
        }
        else {
            $contents= substr($data, $ofs, $length);
            $ofs+=$length;
        }
        my $indlen=0;
        push @list, {
            hofs=>$hofs,
            cofs=>$cofs,
            class=>$class,
            tag=>$tag,
            constructed=>$constructed,
            header=>substr($data, $hofs, $cofs-$hofs),
            contents=>$contents,
            decoded=>(!$constructed && (($class==0 && ($tag==11||$tag==2))||($class!=0))) ? undef : decodeasn1($contents, $length==-1 ? \$indlen: undef),
        };
        if ($length==-1) {
            $ofs+=$indlen;
        }
        last if $indefinite && $id==0 && $length==0;
        #printf("%s%s %s\n", " "x$level, tagname($class, $tag), $constructed?"":unpack("H*", $contents));
    }
    if ($indefinite) {
        $$indefinite=$ofs;
        return \@list;
    }
    if ($ofs==length($data)) {
        return \@list ;
    }
    else {
        #warn sprintf("chunk incorrect size: processed=%d, datlen=%d\n", $ofs, length($data));
        return undef;
    }
}
sub getnode {
    my ($tree, $id)=@_;
    my @path=split /\./,$id;

    for (my $i=0 ; $i<@path-1 ; $i++) {
        $tree= $tree->[$path[$i]]{decoded};
    }
    return $tree->[$path[-1]];
}

sub oidpack {
    my @nums=split /\./, $_[0];
    my $n= shift @nums;
    my $bin= pack "C", $n*40+ (shift @nums);
    while (@nums) {
        $n= shift @nums;
        my $x= "";
        while ($n) {
            $x= pack("C", $n&127).$x;
            $n>>=7;
        }
        $x |= "\x80" x (length($x)-1);
        $x = "\x00" if length($x)==0;
        $bin .= $x;
    }
    return $bin;
}
sub oidunpack {
    my $ofs=0;
    my $c= unpack("C", substr($_[0], $ofs++, 1));
    my $top= ($c<40) ? 0 : ($c<80) ? 1 : 2;
    my $oid= sprintf("%d.%d", $top, $c-$top*40);
    my $x=0;
    while ($ofs<length($_[0])) {
        my $c= unpack("C", substr($_[0], $ofs++, 1));
        $x = ($x<<7) | ($c&0x7f);
        if (!($c&0x80)) {
            $oid .= ".$x";
            $x=0;
        }
    }
    return $oid;
}

sub rsacalc {
    my ($data, $exp, $mod)= map { Math::BigInt->new('0x'.unpack("H*", $_)) } @_;
    my $result= $data->bmodpow($exp, $mod);
    my $hexdata= $result->as_hex;
    $hexdata =~ s/0x//;
    $hexdata =~ s/^/0/ if length($hexdata)&1;

    return pack 'H*', $hexdata;
}

# returns hash + hashalg from sig
sub extractsig {
    my ($sig)= @_;

    $sig =~ s/^\x01\xff+\x00//;

    my $asn1= decodeasn1($sig);
    my $alg=  getnode($asn1, "0.0.0")->{contents};
    my $hash= getnode($asn1, "0.1")->{contents};

    return ($hash, $alg);
}