diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Convert/ASN1/IO.pm')
-rwxr-xr-x | Master/tlpkg/tlperl/lib/Convert/ASN1/IO.pm | 261 |
1 files changed, 261 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Convert/ASN1/IO.pm b/Master/tlpkg/tlperl/lib/Convert/ASN1/IO.pm new file mode 100755 index 00000000000..e3dac3ee850 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Convert/ASN1/IO.pm @@ -0,0 +1,261 @@ +# 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; + +use strict; +use Socket; + +BEGIN { + local $SIG{__DIE__}; + eval { require bytes } and 'bytes'->import +} + +sub asn_recv { # $socket, $buffer, $flags + + my $peer; + my $buf; + my $n = 128; + my $pos = 0; + my $depth = 0; + my $len = 0; + my($tmp,$tb,$lb); + + MORE: + for( + $peer = recv($_[0],$buf,$n,MSG_PEEK); + defined $peer; + $peer = recv($_[0],$buf,$n<<=1,MSG_PEEK) + ) { + + if ($depth) { # Are we searching of "\0\0" + + unless (2+$pos <= length $buf) { + next MORE if $n == length $buf; + last MORE; + } + + if(substr($buf,$pos,2) eq "\0\0") { + unless (--$depth) { + $len = $pos + 2; + last MORE; + } + } + } + + # If we can decode a tag and length we can detemine the length + ($tb,$tmp) = asn_decode_tag(substr($buf,$pos)); + unless ($tb || $pos+$tb < length $buf) { + next MORE if $n == length $buf; + last MORE; + } + + if (ord(substr($buf,$pos+$tb,1)) == 0x80) { + # indefinite length, grrr! + $depth++; + $pos += $tb + 1; + redo MORE; + } + + ($lb,$len) = asn_decode_length(substr($buf,$pos+$tb)); + + if ($lb) { + if ($depth) { + $pos += $tb + $lb + $len; + redo MORE; + } + else { + $len += $tb + $lb + $pos; + last MORE; + } + } + } + + if (defined $peer) { + if ($len > length $buf) { + # Check we can read the whole element + goto error + unless defined($peer = recv($_[0],$buf,$len,MSG_PEEK)); + + if ($len > length $buf) { + # Cannot get whole element + $_[1]=''; + return $peer; + } + } + elsif ($len == 0) { + $_[1] = ''; + return $peer; + } + + if ($_[2] & MSG_PEEK) { + $_[1] = substr($buf,0,$len); + } + elsif (!defined($peer = recv($_[0],$_[1],$len,0))) { + goto error; + } + + return $peer; + } + +error: + $_[1] = undef; +} + +sub asn_read { # $fh, $buffer, $offset + + # We need to read one packet, and exactly only one packet. + # So we have to read the first few bytes one at a time, until + # we have enough to decode a tag and a length. We then know + # how many more bytes to read + + if ($_[2]) { + if ($_[2] > length $_[1]) { + require Carp; + Carp::carp("Offset beyond end of buffer"); + return; + } + substr($_[1],$_[2]) = ''; + } + else { + $_[1] = ''; + } + + my $pos = 0; + my $need = 0; + my $depth = 0; + my $ch; + my $n; + my $e; + + + while(1) { + $need = ($pos + ($depth * 2)) || 2; + + while(($n = $need - length $_[1]) > 0) { + $e = sysread($_[0],$_[1],$n,length $_[1]) or + goto READ_ERR; + } + + my $tch = ord(substr($_[1],$pos++,1)); + # Tag may be multi-byte + if(($tch & 0x1f) == 0x1f) { + my $ch; + do { + $need++; + while(($n = $need - length $_[1]) > 0) { + $e = sysread($_[0],$_[1],$n,length $_[1]) or + goto READ_ERR; + } + $ch = ord(substr($_[1],$pos++,1)); + } while($ch & 0x80); + } + + $need = $pos + 1; + + while(($n = $need - length $_[1]) > 0) { + $e = sysread($_[0],$_[1],$n,length $_[1]) or + goto READ_ERR; + } + + my $len = ord(substr($_[1],$pos++,1)); + + if($len & 0x80) { + unless ($len &= 0x7f) { + $depth++; + next; + } + $need = $pos + $len; + + while(($n = $need - length $_[1]) > 0) { + $e = sysread($_[0],$_[1],$n,length $_[1]) or + goto READ_ERR; + } + + $pos += $len + unpack("N", "\0" x (4 - $len) . substr($_[1],$pos,$len)); + } + elsif (!$len && !$tch) { + die "Bad ASN PDU" unless $depth; + unless (--$depth) { + last; + } + } + else { + $pos += $len; + } + + last unless $depth; + } + + while(($n = $pos - length $_[1]) > 0) { + $e = sysread($_[0],$_[1],$n,length $_[1]) or + goto READ_ERR; + } + + return length $_[1]; + +READ_ERR: + $@ = defined($e) ? "Unexpected EOF" : "I/O Error $!"; # . CORE::unpack("H*",$_[1]); + return undef; +} + +sub asn_send { # $sock, $buffer, $flags, $to + + @_ == 4 + ? send($_[0],$_[1],$_[2],$_[3]) + : send($_[0],$_[1],$_[2]); +} + +sub asn_write { # $sock, $buffer + + syswrite($_[0],$_[1], length $_[1]); +} + +sub asn_get { # $fh + + my $fh = ref($_[0]) ? $_[0] : \($_[0]); + my $href = \%{*$fh}; + + $href->{'asn_buffer'} = '' unless exists $href->{'asn_buffer'}; + + my $need = delete $href->{'asn_need'} || 0; + while(1) { + next if $need; + my($tb,$tag) = asn_decode_tag($href->{'asn_buffer'}) or next; + my($lb,$len) = asn_decode_length(substr($href->{'asn_buffer'},$tb,8)) or next; + $need = $tb + $lb + $len; + } + continue { + if ($need && $need <= length $href->{'asn_buffer'}) { + my $ret = substr($href->{'asn_buffer'},0,$need); + substr($href->{'asn_buffer'},0,$need) = ''; + return $ret; + } + + my $get = $need > 1024 ? $need : 1024; + + sysread($_[0], $href->{'asn_buffer'}, $get, length $href->{'asn_buffer'}) + or return undef; + } +} + +sub asn_ready { # $fh + + my $fh = ref($_[0]) ? $_[0] : \($_[0]); + my $href = \%{*$fh}; + + return 0 unless exists $href->{'asn_buffer'}; + + return $href->{'asn_need'} <= length $href->{'asn_buffer'} + if exists $href->{'asn_need'}; + + my($tb,$tag) = asn_decode_tag($href->{'asn_buffer'}) or return 0; + my($lb,$len) = asn_decode_length(substr($href->{'asn_buffer'},$tb,8)) or return 0; + + $href->{'asn_need'} = $tb + $lb + $len; + + $href->{'asn_need'} <= length $href->{'asn_buffer'}; +} + +1; |