summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Convert/ASN1/Debug.pm
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2010-05-12 16:54:37 +0000
committerNorbert Preining <preining@logic.at>2010-05-12 16:54:37 +0000
commit661c41a09e39a182865e0b51e34cc995a0dc96e8 (patch)
tree2f79bb1406e22fdcb2587be8ffda6c0c609d7932 /Master/tlpkg/tlperl/lib/Convert/ASN1/Debug.pm
parentb645030efc22e13c2498a1522083634ab91b2de1 (diff)
move tlperl.straw to tlperl
git-svn-id: svn://tug.org/texlive/trunk@18210 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Convert/ASN1/Debug.pm')
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Convert/ASN1/Debug.pm226
1 files changed, 226 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Convert/ASN1/Debug.pm b/Master/tlpkg/tlperl/lib/Convert/ASN1/Debug.pm
new file mode 100755
index 00000000000..b9af2568a71
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Convert/ASN1/Debug.pm
@@ -0,0 +1,226 @@
+# Copyright (c) 2000-2005 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package Convert::ASN1;
+
+##
+## just for debug :-)
+##
+
+sub _hexdump {
+ my($fmt,$pos) = @_[1,2]; # Don't copy buffer
+
+ $pos ||= 0;
+
+ my $offset = 0;
+ my $cnt = 1 << 4;
+ my $len = length($_[0]);
+ my $linefmt = ("%02X " x $cnt) . "%s\n";
+
+ print "\n";
+
+ while ($offset < $len) {
+ my $data = substr($_[0],$offset,$cnt);
+ my @y = unpack("C*",$data);
+
+ printf $fmt,$pos if $fmt;
+
+ # On the last time through replace '%02X ' with '__ ' for the
+ # missing values
+ substr($linefmt, 5*@y,5*($cnt-@y)) = "__ " x ($cnt - @y)
+ if @y != $cnt;
+
+ # Change non-printable chars to '.'
+ $data =~ s/[\x00-\x1f\x7f-\xff]/./sg;
+ printf $linefmt, @y,$data;
+
+ $offset += $cnt;
+ $pos += $cnt;
+ }
+}
+
+my %type = (
+ split(/[\t\n]\s*/,
+ q(10 SEQUENCE
+ 01 BOOLEAN
+ 0A ENUM
+ 0D RELATIVE-OID
+ 11 SET
+ 02 INTEGER
+ 03 BIT STRING
+ C0 [PRIVATE %d]
+ 04 STRING
+ 40 [APPLICATION %d]
+ 05 NULL
+ 06 OBJECT ID
+ 80 [CONTEXT %d]
+ )
+ )
+);
+
+BEGIN { undef &asn_dump }
+sub asn_dump {
+ my $fh = @_>1 ? shift : \*STDERR;
+
+ my $ofh = select($fh);
+
+ my $pos = 0;
+ my $indent = "";
+ my @seqend = ();
+ my $length = length($_[0]);
+ my $fmt = $length > 0xffff ? "%08X" : "%04X";
+
+ while(1) {
+ while (@seqend && $pos >= $seqend[0]) {
+ $indent = substr($indent,2);
+ warn "Bad sequence length " unless $pos == shift @seqend;
+ printf "$fmt : %s}\n",$pos,$indent;
+ }
+ last unless $pos < $length;
+
+ my $start = $pos;
+ my($tb,$tag,$tnum) = asn_decode_tag2(substr($_[0],$pos,10));
+ $pos += $tb;
+ my($lb,$len) = asn_decode_length(substr($_[0],$pos,10));
+ $pos += $lb;
+
+ if($tag == 0 && $len == 0) {
+ $seqend[0] = $pos;
+ redo;
+ }
+ printf $fmt. " %4d: %s",$start,$len,$indent;
+
+ my $label = $type{sprintf("%02X",$tag & ~0x20)}
+ || $type{sprintf("%02X",$tag & 0xC0)}
+ || "[UNIVERSAL %d]";
+ printf $label, $tnum;
+
+ if ($tag & ASN_CONSTRUCTOR) {
+ print " {\n";
+ if($len < 0) {
+ unshift(@seqend, length $_[0]);
+ }
+ else {
+ unshift(@seqend, $pos + $len);
+ }
+ $indent .= " ";
+ next;
+ }
+
+ my $tmp;
+
+ for ($label) { # switch
+ /^(INTEGER|ENUM)/ && do {
+ Convert::ASN1::_dec_integer({},[],{},$tmp,$_[0],$pos,$len);
+ printf " = %d\n",$tmp;
+ last;
+ };
+
+ /^BOOLEAN/ && do {
+ Convert::ASN1::_dec_boolean({},[],{},$tmp,$_[0],$pos,$len);
+ printf " = %s\n",$tmp ? 'TRUE' : 'FALSE';
+ last;
+ };
+
+ /^(?:(OBJECT ID)|(RELATIVE-OID))/ && do {
+ my @op; $op[cTYPE] = $1 ? opOBJID : opROID;
+ Convert::ASN1::_dec_object_id({},\@op,{},$tmp,$_[0],$pos,$len);
+ printf " = %s\n",$tmp;
+ last;
+ };
+
+ /^NULL/ && do {
+ print "\n";
+ last;
+ };
+
+ /^STRING/ && do {
+ Convert::ASN1::_dec_string({},[],{},$tmp,$_[0],$pos,$len);
+ if ($tmp =~ /[\x00-\x1f\x7f-\xff]/s) {
+ _hexdump($tmp,$fmt . " : ".$indent, $pos);
+ }
+ else {
+ printf " = '%s'\n",$tmp;
+ }
+ last;
+ };
+
+# /^BIT STRING/ && do {
+# Convert::BER::BIT_STRING->unpack($ber,\$tmp);
+# print " = ",$tmp,"\n";
+# last;
+# };
+
+ # default -- dump hex data
+ _hexdump(substr($_[0],$pos,$len),$fmt . " : ".$indent, $pos);
+ }
+ $pos += $len;
+ }
+
+ select($ofh);
+}
+
+BEGIN { undef &asn_hexdump }
+sub asn_hexdump {
+ my $fh = @_>1 ? shift : \*STDERR;
+ my $ofh = select($fh);
+
+ _hexdump($_[0]);
+ print "\n";
+ select($ofh);
+}
+
+BEGIN { undef &dump }
+sub dump {
+ my $self = shift;
+
+ for (@{$self->{script}}) {
+ dump_op($_,"",{},1);
+ }
+}
+
+BEGIN { undef &dump_all }
+sub dump_all {
+ my $self = shift;
+
+ while(my($k,$v) = each %{$self->{tree}}) {
+ print STDERR "$k:\n";
+ for (@$v) {
+ dump_op($_,"",{},1);
+ }
+ }
+}
+
+
+BEGIN { undef &dump_op }
+sub dump_op {
+ my($op,$indent,$done,$line) = @_;
+ $indent ||= "";
+ printf STDERR "%3d: ",$line;
+ if ($done->{$op}) {
+ print STDERR " $indent=",$done->{$op},"\n";
+ return ++$line;
+ }
+ $done->{$op} = $line++;
+ print STDERR $indent,"[ '",unpack("H*",$op->[cTAG]),"', ";
+ print STDERR $op->[cTYPE] =~ /\D/ ? $op->[cTYPE] : $opName[$op->[cTYPE]];
+ print STDERR ", ",defined($op->[cVAR]) ? $op->[cVAR] : "_";
+ print STDERR ", ",defined($op->[cLOOP]) ? $op->[cLOOP] : "_";
+ print STDERR ", ",defined($op->[cOPT]) ? $op->[cOPT] : "_";
+ print STDERR "]";
+ if ($op->[cCHILD]) {
+ print STDERR " ",scalar @{$op->[cCHILD]},"\n";
+ for (@{$op->[cCHILD]}) {
+ $line = dump_op($_,$indent . " ",$done,$line);
+ }
+ }
+ else {
+ print STDERR "\n";
+ }
+ print STDERR "\n" unless length $indent;
+ $line;
+}
+
+1;
+