File Coverage

blib/lib/Convert/ASN1/IO.pm
Criterion Covered Total %
statement 92 127 72.4
branch 46 94 48.9
condition 9 13 69.2
subroutine 9 9 100.0
pod 6 6 100.0
total 162 249 65.1


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