#!perl -w
use strict;
use Dumpvalue;
use IO::File;
use Digest::MD5 qw(md5_hex);
use Digest::SHA qw(sha1_hex);

my $d= new Dumpvalue;
my %classnames= (
    0=>'universal',
    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) {
    printf("==================== %s\n", $fn);
    my $fh= IO::File->new($fn, "r") or die "$fn: $!\n";
    binmode $fh;
    my $data;
    $fh->read($data, -s $fh);
    $fh->close();

    my $l= decodeasn1($data);
    dumpasn1($l);
}
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)= @_;
    if ($class==2 && $tag==6 && $data =~ m{://}) {
        return quotedstring($data);
    }
    return unpack("H*", $data) if $class!=0;
    if ($tag>=0x13 && $tag<=0x1d) {
        return quotedstring($data);
    }
    elsif ($tag==0x1e) {
        return 'L'.quotedstring(pack("C*", unpack("n*", $data)));
    }
    return unpack("H*", $data);
}
sub dumpasn1 {
    my $list=shift;
    return unless $list;
    my $level=shift || 0;
    for my $e (@$list) {
        printf("%s%04x:%s %s\n", " "x$level, $e->{hofs}, tagname($e->{class}, $e->{tag}), $e->{decoded}?"--":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}, $level+1) if $e->{decoded};
    }
}

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);
            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 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,
            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);
    }
}