[Summary view] [Print] [Text view]

   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  
   5  package Convert::ASN1;
   6  
   7  use strict;
   8  use Socket;
   9  
  10  BEGIN {
  11    local $SIG{__DIE__};
  12    eval { require bytes } and 'bytes'->import
  13  }
  14  
  15  sub asn_recv { # $socket, $buffer, $flags
  16  
  17    my $peer;
  18    my $buf;
  19    my $n = 128;
  20    my $pos = 0;
  21    my $depth = 0;
  22    my $len = 0;
  23    my($tmp,$tb,$lb);
  24  
  25    MORE:
  26    for(
  27      $peer = recv($_[0],$buf,$n,MSG_PEEK);
  28      defined $peer;
  29      $peer = recv($_[0],$buf,$n<<=1,MSG_PEEK)
  30    ) {
  31  
  32      if ($depth) { # Are we searching of "\0\0"
  33  
  34        unless (2+$pos <= length $buf) {
  35      next MORE if $n == length $buf;
  36      last MORE;
  37        }
  38  
  39        if(substr($buf,$pos,2) eq "\0\0") {
  40      unless (--$depth) {
  41        $len = $pos + 2;
  42        last MORE;
  43      }
  44        }
  45      }
  46  
  47      # If we can decode a tag and length we can detemine the length
  48      ($tb,$tmp) = asn_decode_tag(substr($buf,$pos));
  49      unless ($tb || $pos+$tb < length $buf) {
  50        next MORE if $n == length $buf;
  51        last MORE;
  52      }
  53  
  54      if (ord(substr($buf,$pos+$tb,1)) == 0x80) {
  55        # indefinite length, grrr!
  56        $depth++;
  57        $pos += $tb + 1;
  58        redo MORE;
  59      }
  60  
  61      ($lb,$len) = asn_decode_length(substr($buf,$pos+$tb));
  62  
  63      if ($lb) {
  64        if ($depth) {
  65      $pos += $tb + $lb + $len;
  66      redo MORE;
  67        }
  68        else {
  69      $len += $tb + $lb + $pos;
  70      last MORE;
  71        }
  72      }
  73    }
  74  
  75    if (defined $peer) {
  76      if ($len > length $buf) {
  77        # Check we can read the whole element
  78        goto error
  79      unless defined($peer = recv($_[0],$buf,$len,MSG_PEEK));
  80  
  81        if ($len > length $buf) {
  82      # Cannot get whole element
  83      $_[1]='';
  84      return $peer;
  85        }
  86      }
  87      elsif ($len == 0) {
  88        $_[1] = '';
  89        return $peer;
  90      }
  91  
  92      if ($_[2] & MSG_PEEK) {
  93        $_[1] =  substr($buf,0,$len);
  94      }
  95      elsif (!defined($peer = recv($_[0],$_[1],$len,0))) {
  96        goto error;
  97      }
  98  
  99      return $peer;
 100    }
 101  
 102  error:
 103      $_[1] = undef;
 104  }
 105  
 106  sub asn_read { # $fh, $buffer, $offset
 107  
 108    # We need to read one packet, and exactly only one packet.
 109    # So we have to read the first few bytes one at a time, until
 110    # we have enough to decode a tag and a length. We then know
 111    # how many more bytes to read
 112  
 113    if ($_[2]) {
 114      if ($_[2] > length $_[1]) {
 115        require Carp;
 116        Carp::carp("Offset beyond end of buffer");
 117        return;
 118      }
 119      substr($_[1],$_[2]) = '';
 120    }
 121    else {
 122      $_[1] = '';
 123    }
 124  
 125    my $pos = 0;
 126    my $need = 0;
 127    my $depth = 0;
 128    my $ch;
 129    my $n;
 130    my $e;
 131    
 132  
 133    while(1) {
 134      $need = ($pos + ($depth * 2)) || 2;
 135  
 136      while(($n = $need - length $_[1]) > 0) {
 137        $e = sysread($_[0],$_[1],$n,length $_[1]) or
 138      goto READ_ERR;
 139      }
 140  
 141      my $tch = ord(substr($_[1],$pos++,1));
 142      # Tag may be multi-byte
 143      if(($tch & 0x1f) == 0x1f) {
 144        my $ch;
 145        do {
 146          $need++;
 147      while(($n = $need - length $_[1]) > 0) {
 148        $e = sysread($_[0],$_[1],$n,length $_[1]) or
 149            goto READ_ERR;
 150      }
 151      $ch = ord(substr($_[1],$pos++,1));
 152        } while($ch & 0x80);
 153      }
 154  
 155      $need = $pos + 1;
 156  
 157      while(($n = $need - length $_[1]) > 0) {
 158        $e = sysread($_[0],$_[1],$n,length $_[1]) or
 159        goto READ_ERR;
 160      }
 161  
 162      my $len = ord(substr($_[1],$pos++,1));
 163  
 164      if($len & 0x80) {
 165        unless ($len &= 0x7f) {
 166      $depth++;
 167      next;
 168        }
 169        $need = $pos + $len;
 170  
 171        while(($n = $need - length $_[1]) > 0) {
 172      $e = sysread($_[0],$_[1],$n,length $_[1]) or
 173          goto READ_ERR;
 174        }
 175  
 176        $pos += $len + unpack("N", "\0" x (4 - $len) . substr($_[1],$pos,$len));
 177      }
 178      elsif (!$len && !$tch) {
 179        die "Bad ASN PDU" unless $depth;
 180        unless (--$depth) {
 181      last;
 182        }
 183      }
 184      else {
 185        $pos += $len;
 186      }
 187  
 188      last unless $depth;
 189    }
 190  
 191    while(($n = $pos - length $_[1]) > 0) {
 192      $e = sysread($_[0],$_[1],$n,length $_[1]) or
 193        goto READ_ERR;
 194    }
 195  
 196    return length $_[1];
 197  
 198  READ_ERR:
 199      $@ = defined($e) ? "Unexpected EOF" : "I/O Error $!"; # . CORE::unpack("H*",$_[1]);
 200      return undef;
 201  }
 202  
 203  sub asn_send { # $sock, $buffer, $flags, $to
 204  
 205    @_ == 4
 206      ? send($_[0],$_[1],$_[2],$_[3])
 207      : send($_[0],$_[1],$_[2]);
 208  }
 209  
 210  sub asn_write { # $sock, $buffer
 211  
 212    syswrite($_[0],$_[1], length $_[1]);
 213  }
 214  
 215  sub asn_get { # $fh
 216  
 217    my $fh = ref($_[0]) ? $_[0] : \($_[0]);
 218    my $href = \%{*$fh};
 219  
 220    $href->{'asn_buffer'} = '' unless exists $href->{'asn_buffer'};
 221  
 222    my $need = delete $href->{'asn_need'} || 0;
 223    while(1) {
 224      next if $need;
 225      my($tb,$tag) = asn_decode_tag($href->{'asn_buffer'}) or next;
 226      my($lb,$len) = asn_decode_length(substr($href->{'asn_buffer'},$tb,8)) or next;
 227      $need = $tb + $lb + $len;
 228    }
 229    continue {
 230      if ($need && $need <= length $href->{'asn_buffer'}) {
 231        my $ret = substr($href->{'asn_buffer'},0,$need);
 232        substr($href->{'asn_buffer'},0,$need) = '';
 233        return $ret;
 234      }
 235  
 236      my $get = $need > 1024 ? $need : 1024;
 237  
 238      sysread($_[0], $href->{'asn_buffer'}, $get, length $href->{'asn_buffer'})
 239        or return undef;
 240    }
 241  }
 242  
 243  sub asn_ready { # $fh
 244  
 245    my $fh = ref($_[0]) ? $_[0] : \($_[0]);
 246    my $href = \%{*$fh};
 247  
 248    return 0 unless exists $href->{'asn_buffer'};
 249    
 250    return $href->{'asn_need'} <= length $href->{'asn_buffer'}
 251      if exists $href->{'asn_need'};
 252  
 253    my($tb,$tag) = asn_decode_tag($href->{'asn_buffer'}) or return 0;
 254    my($lb,$len) = asn_decode_length(substr($href->{'asn_buffer'},$tb,8)) or return 0;
 255  
 256    $href->{'asn_need'} = $tb + $lb + $len;
 257  
 258    $href->{'asn_need'} <= length $href->{'asn_buffer'};
 259  }
 260  
 261  1;