#!perl -w
use strict;
# see x.690-0207 - asn.1 BER/CER/DER encoding rules


# note: /Users/itsme-plain/projects/bdienst/ko2007/ko2007d.cer
#    has quite a different structure

# most certs have at "0.0.5" = seq[ set{ seq[ oid, value ] }+ ]

# todo: make the decoding as asn1 of binary/hex items optional.
#
$|=1;
use Dumpvalue;
use IO::File;
use Digest::MD5 qw(md5_hex);
use Digest::SHA qw(sha1_hex);
use MIME::Base64;

my %objects= (
    pack("H*",'2a864886f70d010101') => 'rsaEncryption',
    pack("H*",'2a864886f70d010104') => 'md5WithRSAEncryption',
    pack("H*",'2a864886f70d010702') => 'pkcs7-signedData',
    pack("H*",'2a864886f70d010903') => 'contentType',
    pack("H*",'2a864886f70d010904') => 'messageDigest',
    pack("H*",'2b060104018237020104') => 'spcIndirectDataContext',
    pack("H*",'2b06010401823702010c') => 'spcSpOpusInfo',
    pack("H*",'2b06010401823702010f') => 'spcPelmageData',
    pack("H*",'2b0e03021a') => 'sha1',
    pack("H*",'550403') => 'commonName',
 oidpack('2.5.4.10') => 'organization',
 oidpack('2.5.4.11') => 'organizationalUnit',
 oidpack('2.5.4.17') => 'postalCode',
 oidpack('2.5.4.9') => 'streetAddress',
 oidpack('2.5.4.8') => 'stateOrProvinceName',
 oidpack('2.5.4.7') => 'locality',
 oidpack('2.5.4.6') => 'country',
 oidpack('1.2.840.113549.1.9.1') => 'emailAddress',
 oidpack('2.5.29.19') => 'basicConstraints',
 oidpack('2.5.29.15') => 'keyUsage',
 oidpack('2.5.29.14') => 'subjectKeyIdentifier',
 oidpack('2.5.29.17') => 'subjectAltName',
 oidpack('2.5.29.35') => 'AuthorityKeyIdentifier',
 oidpack('2.5.29.31') => 'CRLDistributionPoints',
 oidpack('2.5.29.32') => 'CertificatePolicies',
 oidpack('2.5.29.37') => 'ExtendedKeyUsage',
 oidpack('1.3.36.8') => 'ISISAttribute',
    pack("H*",'551d01') => 'authorityKeyIdentifier',  # 2.5.29.1
 oidpack('1.2.840.113549.1.1.2') => 'md2WithRSAEncryption',
 oidpack('1.2.840.113549.1.1.5') => 'sha1WithRSAEncryption',
 oidpack('1.2.840.113549.1.7.1') => 'pkcs7.data',
 oidpack('1.2.840.113549.1.9.5') => 'pkcs9.signing-time',
 oidpack('1.2.840.113549.1.9.6') => 'pkcs9.countersignature',
 oidpack('1.2.840.113549.2.5') => 'md5',
 oidpack('1.3.6.1.4.1.311.2.1.10') => 'SPC_SP_AGENCY_INFO',
 oidpack('1.3.6.1.4.1.311.2.1.11') => 'SPC_STATEMENT_TYPE',
 oidpack('1.3.6.1.4.1.311.2.1.21') => 'SPC_INDIVIDUAL_SP_KEY_PURPOSE',
 oidpack('1.3.6.1.4.1.311.2.1.22') => 'SPC_COMMERCIAL_SP_KEY_PURPOSE',
 oidpack('1.3.6.1.4.1.311.2.1.27') => 'SPC_FINANCIAL_CRITERIA',
 oidpack('2.16.840.1.113730.1.1') => 'netscape-cert-type',
 oidpack('2.16.840.1.113733.1.7.1.1') => 'policy',
# 
# 1.2.840.113533.7.65.0
# 1.2.840.113549.1.9.1        emailaddress=
# 1.2.840.113763.1.2.1.5
# 1.3.6.1.4.1.311.2.1.13
# 1.3.6.1.4.1.311.21.8.3692315854.1256661383.1690418588.4201632533.1.25
# 2.16.840.1.113730.4.1
# 2.16.840.1.113733.1.7.1.1.1
# 2.16.840.1.113733.1.7.1.1.2
# 2.16.840.1.113733.1.7.23.3
# 2.16.840.1.113733.1.8.1
# 2.5.29.1  authorityKeyIdentifier
# 2.5.29.3  Certificate Policies
# 2.5.29.4  Primary Key Usage Restriction 
# 2.5.29.10
# 2.5.29.14 Subject Key Identifier
# 2.5.29.15 Key Usage
# 2.5.29.16 Private Key Usage Period 
# 2.5.29.17 Subject Alternative Name
# 2.5.29.18 Issuer Alternative Name
# 2.5.29.19 Basic Constraints 
# 2.5.29.31 CRL Distribution Points 
# 2.5.29.32 Certificate Policies 
# 2.5.29.32.0
# 2.5.29.35 Authority Key Identifier 
# 2.5.29.37 Extended key usage 
# 2.5.4.10         O=
# 2.5.4.11         OU=
# 2.5.4.13
# 2.5.4.6          C=
# 2.5.4.7          L=
# 2.5.4.8          stateOrProvinceName

);
my $d= new Dumpvalue;
my %classnames= (
    0=>'universal',     # -> see %tagnames
    1=>'application',
    2=>'context',
    3=>'private',
);
my %tagnames=(
    0=>'EOC',
    1=>'boolean',
    2=>'integer',
    3=>'bitstring',
    4=>'octetstring',
    5=>'null',
    6=>'object',
    7=>'objdescriptor',
    8=>'externaltype',
    9=>'real',
  0x0a=>'enum',
  0x0b=>'embedded',
  0x0c=>'utf8string',
  0x0d=>'relativeoid',
#  0x0e=>'',
#  0x0f=>'',
  0x10=>'sequence',
  0x11=>'set',
  0x12=>'NumericString',
  0x13=>'PrintableString',
  0x14=>'T61String',    # teletex string
  0x15=>'VideotexString',
  0x16=>'IA5String',
  0x17=>'timestamp',
# 0x18
  0x19=>'GraphicString',
  0x1a=>'VisibleString',
  0x1b=>'GeneralString',
  0x1c=>'UniversalString',
  0x1d=>'UnrestrictedString',
  0x1e=>'BMPString',
#  0x1f=>'',
);

# class:
#   0 => universal
#   1 => application
#   2 => context-specific
#   3 => private
for my $fn (@ARGV) {

    # read file or stdin

    my $data;
    if ($fn eq '-') {
        binmode STDIN;
        local $/;
        $data=<>;
    }
    else {
        printf("==================== %s\n", $fn);
        my $fh= IO::File->new($fn, "r");
        if (!$fh) {
            warn "$fn: $!\n";
            next;
        }
        binmode $fh;
        $fh->read($data, -s $fh);
        $fh->close();
    }


    if ($data =~ /^30(\W?)8\w(?:\1\w\w){8}/) {
        # decode hex data
        for my $xdata (split /[\r\n]+/, $data) {
            $xdata =~ s/\W//g;
            my $l= decodeasn1(pack 'H*', $xdata);
            dumpasn1($l);
        }
    }
    elsif ($data =~ /^0/) {
        # read binary data
        my $l= decodeasn1($data);
        dumpasn1($l);
    }
    else {
        # read base64 data
        while ($data =~ /-----BEGIN[^\n]+\n(.*?)-----END[^\n]+\n/sg) {
            my $txt64= $1;
            $txt64 =~ s/\s+//gs;
            dumpasn1(decodeasn1(decode_base64($txt64)));
        }
    }
}
sub quotedstring {
    my ($data)= @_;
    $data =~ s/\\/\\\\/gs;
    $data =~ s/\n/\\n/gs;
    $data =~ s/"/\\"/gs;
    $data =~ s/\t/\\t/gs;
    $data =~ s/\0/\\0/gs;
    $data =~ s/./(ord($&)<32 || ord($&)>126)?sprintf("\\x%02x", ord($&)) : $&/gse;
    return '"'.$data.'"';
}
sub writeprimitive {
    my ($class, $tag, $data)= @_;

    # context[6] ... ?
    if ($class==2 && $tag==6 && $data =~ m{://}) {
        return quotedstring($data);
    }
    return unpack("H*", $data) if $class!=0;
    # printable,t61,videotex,ias,timestamp,graphic,visible,general,universal,unrestricted- string
    # or utf8string
    if ($tag>=0x13 && $tag<=0x1d || $tag==0x0c) {
        return quotedstring($data);
    }
    # bmpstring
    elsif ($tag==0x1e) {
        return 'L'.quotedstring(pack("U*", unpack("n*", $data)));
    }
    # object
    elsif ($tag==6) {
        if (exists $objects{$data}) {
            return $objects{$data};
        }
        return oidunpack($data);
    }
    return unpack("H*", $data);
}
sub pathstring {
    return join("", map { $_<0 ? '='.(-$_-1) : '.'.$_ } @_);
}
sub dumpasn1 {
    my $list=shift;
    return unless $list;
    my @path=@_;
    my $level= scalar @path;
    my $universal= 0;
    for my $e (@$list) {
        my $top = ($e->{class}==2) ? -$e->{tag}-1 : $universal;
        printf("%-*s %04x:%s %s\n",
            $level*2, pathstring(@path, $top),
            $e->{hofs}, tagname($e->{class}, $e->{tag}),
            $e->{decoded} && !($e->{tag}==4 && $e->{class}==0) ?"--":writeprimitive($e->{class}, $e->{tag}, $e->{contents}));
        #printf(" md5=%s %s sha1=%s %s\n", md5_hex($e->{header}.$e->{contents}), md5_hex($e->{contents}), sha1_hex($e->{header}.$e->{contents}), sha1_hex($e->{contents}));
        dumpasn1($e->{decoded}, @path, $top) if $e->{decoded};
        $universal++ if ($e->{class}==0);
    }
}
sub readlongtag {
    my $tag=0;
    # optionally process a tag value >= 31
    while ($_[1]<length($_[0])) {
        my $val= unpack("C", substr($_[0], $_[1]++, 1));
        $tag<<=7;
        $tag|=($val&0x7f);
        last if (($val&0x80)==0);
    }
    #printf(".. large tag %x\n", $tag);
    return $tag;
}
sub readlonglength {
    my $length= unpack("C", substr($_[0], $_[1]++, 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-- && $_[1]<length($_[0])) {
            $n<<=8;
            $n |= unpack("C", substr($_[0], $_[1]++, 1));
        }
        $length= $n;
    }
    return $length;
}

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= readlongtag($data, $ofs);
        }
        # process the length
        last if ($ofs>=length($data));
        my $length= readlonglength($data, $ofs);
        return undef if (!defined $length);
        my $cofs= $ofs;
        # get the contents
        my $contents;
        if ($length==-1) {
            $contents= substr($data, $ofs);
            #printf("indefinate contensts 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,
            #  embedded || integer -> dont recurse
            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 tagname {
    my ($class, $tag)= @_;
    if ($class==0 && exists $tagnames{$tag}) {
        return $tagnames{$tag};
    }
    else {
        sprintf("%s[%d]", $classnames{$class}, $tag);
    }
}
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;
}