1# Copyright (c) 2000-2005 Graham Barr <gbarr@pobox.com>. All rights reserved.
2# This program is free software; you can redistribute it and/or
3# modify it under the same terms as Perl itself.
4
5package Convert::ASN1;
6$Convert::ASN1::VERSION = '0.33';
7##
8## just for debug :-)
9##
10
11sub _hexdump {
12  my($fmt,$pos) = @_[1,2]; # Don't copy buffer
13
14  $pos ||= 0;
15
16  my $offset  = 0;
17  my $cnt     = 1 << 4;
18  my $len     = length($_[0]);
19  my $linefmt = ("%02X " x $cnt) . "%s\n";
20
21  print "\n";
22
23  while ($offset < $len) {
24    my $data = substr($_[0],$offset,$cnt);
25    my @y = unpack("C*",$data);
26
27    printf $fmt,$pos if $fmt;
28
29    # On the last time through replace '%02X ' with '__ ' for the
30    # missing values
31    substr($linefmt, 5*@y,5*($cnt-@y)) = "__ " x ($cnt - @y)
32	if @y != $cnt;
33
34    # Change non-printable chars to '.'
35    $data =~ s/[\x00-\x1f\x7f-\xff]/./sg;
36    printf $linefmt, @y,$data;
37
38    $offset += $cnt;
39    $pos += $cnt;
40  }
41}
42
43my %type = (
44  split(/[\t\n]\s*/,
45    q(10	SEQUENCE
46      01	BOOLEAN
47      0A	ENUM
48      0D	RELATIVE-OID
49      11	SET
50      02	INTEGER
51      03	BIT STRING
52      C0	[PRIVATE %d]
53      04	STRING
54      40	[APPLICATION %d]
55      05	NULL
56      06	OBJECT ID
57      80	[CONTEXT %d]
58    )
59  )
60);
61
62BEGIN { undef &asn_dump }
63sub asn_dump {
64  my $fh = @_>1 ? shift : \*STDERR;
65
66  my $ofh = select($fh);
67
68  my $pos = 0;
69  my $indent = "";
70  my @seqend = ();
71  my $length = length($_[0]);
72  my $fmt = $length > 0xffff ? "%08X" : "%04X";
73
74  while(1) {
75    while (@seqend && $pos >= $seqend[0]) {
76      $indent = substr($indent,2);
77      warn "Bad sequence length " unless $pos == shift @seqend;
78      printf "$fmt     : %s}\n",$pos,$indent;
79    }
80    last unless $pos < $length;
81
82    my $start = $pos;
83    my($tb,$tag,$tnum) = asn_decode_tag2(substr($_[0],$pos,10));
84    last unless defined $tb;
85    $pos += $tb;
86    my($lb,$len) = asn_decode_length(substr($_[0],$pos,10));
87    $pos += $lb;
88
89    if($tag == 0 && $len == 0) {
90      $seqend[0] = $pos;
91      redo;
92    }
93    printf $fmt. " %4d: %s",$start,$len,$indent;
94
95    my $label = $type{sprintf("%02X",$tag & ~0x20)}
96		|| $type{sprintf("%02X",$tag & 0xC0)}
97		|| "[UNIVERSAL %d]";
98    print "$label: $tnum";
99
100    if ($tag & ASN_CONSTRUCTOR) {
101      print " {\n";
102      if($len < 0) {
103          unshift(@seqend, length $_[0]);
104      }
105      else {
106          unshift(@seqend, $pos + $len);
107      }
108      $indent .= "  ";
109      next;
110    }
111
112    my $tmp;
113
114    for ($label) { # switch
115      /^(INTEGER|ENUM)/ && do {
116	Convert::ASN1::_dec_integer({},[],{},$tmp,$_[0],$pos,$len);
117	printf " = %d\n",$tmp;
118        last;
119      };
120
121      /^BOOLEAN/ && do {
122	Convert::ASN1::_dec_boolean({},[],{},$tmp,$_[0],$pos,$len);
123	printf " = %s\n",$tmp ? 'TRUE' : 'FALSE';
124        last;
125      };
126
127      /^(?:(OBJECT ID)|(RELATIVE-OID))/ && do {
128	my @op; $op[cTYPE] = $1 ? opOBJID : opROID;
129	Convert::ASN1::_dec_object_id({},\@op,{},$tmp,$_[0],$pos,$len);
130	printf " = %s\n",$tmp;
131        last;
132      };
133
134      /^NULL/ && do {
135	print "\n";
136        last;
137      };
138
139      /^STRING/ && do {
140	Convert::ASN1::_dec_string({},[],{},$tmp,$_[0],$pos,$len);
141	if ($tmp =~ /[\x00-\x1f\x7f-\xff]/s) {
142  	  _hexdump($tmp,$fmt . "     :   ".$indent, $pos);
143	}
144	else {
145	  printf " = '%s'\n",$tmp;
146	}
147        last;
148      };
149
150#      /^BIT STRING/ && do {
151#	Convert::BER::BIT_STRING->unpack($ber,\$tmp);
152#	print " = ",$tmp,"\n";
153#        last;
154#      };
155
156      # default -- dump hex data
157      _hexdump(substr($_[0],$pos,$len),$fmt . "     :   ".$indent, $pos);
158    }
159    $pos += $len;
160  }
161  printf "Buffer contains %d extra bytes\n", $length - $pos if $pos < $length;
162
163  select($ofh);
164}
165
166BEGIN { undef &asn_hexdump }
167sub asn_hexdump {
168    my $fh = @_>1 ? shift : \*STDERR;
169    my $ofh = select($fh);
170
171    _hexdump($_[0]);
172    print "\n";
173    select($ofh);
174}
175
176BEGIN { undef &dump }
177sub dump {
178  my $self = shift;
179
180  for (@{$self->{script}}) {
181    dump_op($_,"",{},1);
182  }
183}
184
185BEGIN { undef &dump_all }
186sub dump_all {
187  my $self = shift;
188
189  while(my($k,$v) = each %{$self->{tree}}) {
190    print STDERR "$k:\n";
191    for (@$v) {
192      dump_op($_,"",{},1);
193    }
194  }
195}
196
197
198BEGIN { undef &dump_op }
199sub dump_op {
200  my($op,$indent,$done,$line) = @_;
201  $indent ||= "";
202  printf STDERR "%3d: ",$line;
203  if ($done->{$op}) {
204    print STDERR "    $indent=",$done->{$op},"\n";
205    return ++$line;
206  }
207  $done->{$op} = $line++;
208  print STDERR $indent,"[ '",unpack("H*",$op->[cTAG]),"', ";
209  print STDERR $op->[cTYPE] =~ /\D/ ? $op->[cTYPE] : $opName[$op->[cTYPE]];
210  print STDERR ", ",defined($op->[cVAR]) ? $op->[cVAR] : "_";
211  print STDERR ", ",defined($op->[cLOOP]) ? $op->[cLOOP] : "_";
212  print STDERR ", ",defined($op->[cOPT]) ? $op->[cOPT] : "_";
213  print STDERR "]";
214  if ($op->[cCHILD]) {
215    print STDERR " ",scalar @{$op->[cCHILD]},"\n";
216    for (@{$op->[cCHILD]}) {
217      $line = dump_op($_,$indent . " ",$done,$line);
218    }
219  }
220  else {
221    print STDERR "\n";
222  }
223  print STDERR "\n" unless length $indent;
224  $line;
225}
226
2271;
228
229