File Coverage

blib/lib/Convert/ASN1/_decode.pm
Criterion Covered Total %
statement 185 247 74.9
branch 112 200 56.0
condition 32 86 37.2
subroutine 18 19 94.7
pod n/a
total 347 552 62.9


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             BEGIN {
8 15     15   269   local $SIG{__DIE__};
9 15 50       269   eval { require bytes and 'bytes'->import };
  15         389  
10             }
11              
12             # These are the subs that do the decode, they are called with
13             # 0 1 2 3 4
14             # $optn, $op, $stash, $var, $buf
15             # The order must be the same as the op definitions above
16              
17             my @decode = (
18               sub { die "internal error\n" },
19               \&_dec_boolean,
20               \&_dec_integer,
21               \&_dec_bitstring,
22               \&_dec_string,
23               \&_dec_null,
24               \&_dec_object_id,
25               \&_dec_real,
26               \&_dec_sequence,
27               \&_dec_set,
28               \&_dec_time,
29               \&_dec_time,
30               \&_dec_utf8,
31               undef, # ANY
32               undef, # CHOICE
33               \&_dec_object_id,
34               \&_dec_bcd,
35             );
36              
37             my @ctr;
38             @ctr[opBITSTR, opSTRING, opUTF8] = (\&_ctr_bitstring,\&_ctr_string,\&_ctr_string);
39              
40              
41             sub _decode {
42 127     127   1376   my ($optn, $ops, $stash, $pos, $end, $seqof, $larr) = @_;
43 127         1089   my $idx = 0;
44              
45             # we try not to copy the input buffer at any time
46 127         1845   foreach my $buf ($_[-1]) {
47 127         1213     OP:
48 127         1487     foreach my $op (@{$ops}) {
49 149         1663       my $var = $op->[cVAR];
50              
51 149 100       1785       if (length $op->[cTAG]) {
52              
53             TAGLOOP: {
54 142         1197 my($tag,$len,$npos,$indef) = _decode_tl($buf,$pos,$end,$larr)
55 161 100       4240 or do {
56 1 50 33     22 next OP if $pos==$end and ($seqof || defined $op->[cOPT]);
      33        
57 0         0 die "decode error";
58             };
59              
60 160 100       1928 if ($tag eq $op->[cTAG]) {
61              
62 156 50       2969 &{$decode[$op->[cTYPE]]}(
  156 100       2020  
    100          
63             $optn,
64             $op,
65             $stash,
66             # We send 1 if there is not var as if there is the decode
67             # should be getting undef. So if it does not get undef
68             # it knows it has no variable
69             ($seqof ? $seqof->[$idx++] : defined($var) ? $stash->{$var} : ref($stash) eq 'SCALAR' ? $$stash : 1),
70             $buf,$npos,$len, $larr
71             );
72              
73 156         1693 $pos = $npos+$len+$indef;
74              
75 156 100 100     1774 redo TAGLOOP if $seqof && $pos < $end;
76 137         2573 next OP;
77             }
78              
79 4 100 66     78 if ($tag eq ($op->[cTAG] | chr(ASN_CONSTRUCTOR))
80             and my $ctr = $ctr[$op->[cTYPE]])
81             {
82 1         25 _decode(
83             $optn,
84             [$op],
85             undef,
86             $npos,
87             $npos+$len,
88             (\my @ctrlist),
89             $larr,
90             $buf,
91             );
92              
93 1         10 ($seqof ? $seqof->[$idx++] : defined($var) ? $stash->{$var} : ref($stash) eq 'SCALAR' ? $$stash : undef)
94 1 0       11 = &{$ctr}(@ctrlist);
    50          
    50          
95 1         9 $pos = $npos+$len+$indef;
96              
97 1 50 33     12 redo TAGLOOP if $seqof && $pos < $end;
98 1         14 next OP;
99              
100             }
101              
102 3 50 33     83 if ($seqof || defined $op->[cOPT]) {
103 3         30 next OP;
104             }
105              
106 0         0 die "decode error " . unpack("H*",$tag) ."<=>" . unpack("H*",$op->[cTAG]), " ",$pos," ",$op->[cTYPE]," ",$op->[cVAR];
107                     }
108                   }
109                   else { # opTag length is zero, so it must be an ANY or CHOICE
110            
111 7 100       74 if ($op->[cTYPE] == opANY) {
112              
113             ANYLOOP: {
114              
115 2         16 my($tag,$len,$npos,$indef) = _decode_tl($buf,$pos,$end,$larr)
116 2 50       21 or do {
117 0 0 0     0 next OP if $pos==$end and ($seqof || defined $op->[cOPT]);
      0        
118 0         0 die "decode error";
119             };
120              
121 2         20 $len += $npos-$pos;
122              
123 2 50       21              if ($op->[cDEFINE]) {
124 2   33     31                 $handler = $optn->{oidtable} && $optn->{oidtable}{$stash->{$op->[cDEFINE]}};
125 2   33     21                 $handler ||= $optn->{handlers}{$op->[cVAR]}{$stash->{$op->[cDEFINE]}};
126                          }
127              
128 2 50       32 ($seqof ? $seqof->[$idx++] : ref($stash) eq 'SCALAR' ? $$stash : $stash->{$var})
    50          
    50          
129             = $handler ? $handler->decode(substr($buf,$pos,$len)) : substr($buf,$pos,$len);
130              
131 2         18 $pos += $len + $indef;
132              
133 2 50 33     28 redo ANYLOOP if $seqof && $pos < $end;
134             }
135             }
136             else {
137              
138             CHOICELOOP: {
139 5         41 my($tag,$len,$npos,$indef) = _decode_tl($buf,$pos,$end,$larr)
140 7 50       75 or do {
141 0 0 0     0 next OP if $pos==$end and ($seqof || defined $op->[cOPT]);
      0        
142 0         0 die "decode error";
143             };
144 7         64 foreach my $cop (@{$op->[cCHILD]}) {
  7         70  
145              
146 10 100       103 if ($tag eq $cop->[cTAG]) {
147              
148 5 50       69 my $nstash = $seqof
    100          
    100          
149             ? ($seqof->[$idx++]={})
150             : defined($var)
151             ? ($stash->{$var}={})
152             : ref($stash) eq 'SCALAR'
153             ? ($$stash={}) : $stash;
154              
155 5 50       84 &{$decode[$cop->[cTYPE]]}(
  5         57  
156             $optn,
157             $cop,
158             $nstash,
159             ($cop->[cVAR] ? $nstash->{$cop->[cVAR]} : undef),
160             $buf,$npos,$len,$larr,
161             );
162              
163 5         47 $pos = $npos+$len+$indef;
164              
165 5 100 66     63 redo CHOICELOOP if $seqof && $pos < $end;
166 4         52 next OP;
167             }
168              
169 5 100       66 unless (length $cop->[cTAG]) {
170 2 50       18 eval {
171 2         46 _decode(
172             $optn,
173             [$cop],
174             (\my %tmp_stash),
175             $pos,
176             $npos+$len+$indef,
177             undef,
178             $larr,
179             $buf,
180             );
181              
182 2 0       26 my $nstash = $seqof
    0          
    50          
183             ? ($seqof->[$idx++]={})
184             : defined($var)
185             ? ($stash->{$var}={})
186             : ref($stash) eq 'SCALAR'
187             ? ($$stash={}) : $stash;
188              
189 2         24 @{$nstash}{keys %tmp_stash} = values %tmp_stash;
  2         27  
190              
191             } or next;
192              
193 2         20 $pos = $npos+$len+$indef;
194              
195 2 100 66     29 redo CHOICELOOP if $seqof && $pos < $end;
196 1         14 next OP;
197             }
198              
199 3 50 33     42 if ($tag eq ($cop->[cTAG] | chr(ASN_CONSTRUCTOR))
200             and my $ctr = $ctr[$cop->[cTYPE]])
201             {
202 0 0       0 my $nstash = $seqof
    0          
    0          
203             ? ($seqof->[$idx++]={})
204             : defined($var)
205             ? ($stash->{$var}={})
206             : ref($stash) eq 'SCALAR'
207             ? ($$stash={}) : $stash;
208              
209 0         0 _decode(
210             $optn,
211             [$cop],
212             undef,
213             $npos,
214             $npos+$len,
215             (\my @ctrlist),
216             $larr,
217             $buf,
218             );
219              
220 0         0 $nstash->{$cop->[cVAR]} = &{$ctr}(@ctrlist);
  0         0  
221 0         0 $pos = $npos+$len+$indef;
222              
223 0 0 0     0 redo CHOICELOOP if $seqof && $pos < $end;
224 0         0 next OP;
225             }
226             }
227             }
228 0 0       0 die "decode error" unless $op->[cOPT];
229             }
230                   }
231                 }
232               }
233 127 50       2290   die "decode error $pos $end" unless $pos == $end;
234             }
235              
236              
237             sub _dec_boolean {
238             # 0 1 2 3 4 5 6
239             # $optn, $op, $stash, $var, $buf, $pos, $len
240              
241 11 100   11   147   $_[3] = ord(substr($_[4],$_[5],1)) ? 1 : 0;
242 11         97   1;
243             }
244              
245              
246             sub _dec_integer {
247             # 0 1 2 3 4 5 6
248             # $optn, $op, $stash, $var, $buf, $pos, $len
249              
250 57     57   737   my $buf = substr($_[4],$_[5],$_[6]);
251 57 100       585   my $tmp = ord($buf) & 0x80 ? chr(255) : chr(0);
252 57 100       980   if ($_[6] > 4) {
253 11   50     177       $_[3] = os2ip($tmp x (4-$_[6]) . $buf, $_[0]->{decode_bigint} || 'Math::BigInt');
254               } else {
255             # N unpacks an unsigned value
256 46         1149       $_[3] = unpack("l",pack("l",unpack("N", $tmp x (4-$_[6]) . $buf)));
257               }
258 57         5660   1;
259             }
260              
261              
262             sub _dec_bitstring {
263             # 0 1 2 3 4 5 6
264             # $optn, $op, $stash, $var, $buf, $pos, $len
265              
266 4     4   105   $_[3] = [ substr($_[4],$_[5]+1,$_[6]-1), ($_[6]-1)*8-ord(substr($_[4],$_[5],1)) ];
267 4         38   1;
268             }
269              
270              
271             sub _dec_string {
272             # 0 1 2 3 4 5 6
273             # $optn, $op, $stash, $var, $buf, $pos, $len
274              
275 37     37   504   $_[3] = substr($_[4],$_[5],$_[6]);
276 37         411   1;
277             }
278              
279              
280             sub _dec_null {
281             # 0 1 2 3 4 5 6
282             # $optn, $op, $stash, $var, $buf, $pos, $len
283              
284 2     2   24   $_[3] = 1;
285 2         19   1;
286             }
287              
288              
289             sub _dec_object_id {
290             # 0 1 2 3 4 5 6
291             # $optn, $op, $stash, $var, $buf, $pos, $len
292              
293 8     8   2607   my @data = unpack("w*",substr($_[4],$_[5],$_[6]));
294 8 100 66     129   splice(@data,0,1,int($data[0]/40),$data[0] % 40)
295                 if $_[1]->[cTYPE] == opOBJID and @data > 1;
296 8         124   $_[3] = join(".", @data);
297 8         76   1;
298             }
299              
300              
301             my @_dec_real_base = (2,8,16);
302              
303             sub _dec_real {
304             # 0 1 2 3 4 5 6
305             # $optn, $op, $stash, $var, $buf, $pos, $len
306              
307 7 100   7   74   $_[3] = 0.0, return unless $_[6];
308              
309 6         60   my $first = ord(substr($_[4],$_[5],1));
310 6 100       62   if ($first & 0x80) {
    50          
    0          
311             # A real number
312              
313 4         74     require POSIX;
314              
315 4         35     my $exp;
316 4         36     my $expLen = $first & 0x3;
317 4         36     my $estart = $_[5]+1;
318              
319 4 50       40     if($expLen == 3) {
320 0         0       $estart++;
321 0         0       $expLen = ord(substr($_[4],$_[5]+1,1));
322                 }
323                 else {
324 4         93       $expLen++;
325                 }
326 4         45     _dec_integer(undef, undef, undef, $exp, $_[4],$estart,$expLen);
327              
328 4         35     my $mant = 0.0;
329 4         49     for (reverse unpack("C*",substr($_[4],$estart+$expLen,$_[6]-1-$expLen))) {
330 5         58       $exp +=8, $mant = (($mant+$_) / 256) ;
331                 }
332              
333 4         41     $mant *= 1 << (($first >> 2) & 0x3);
334 4 100       43     $mant = - $mant if $first & 0x40;
335              
336 4         121     $_[3] = $mant * POSIX::pow($_dec_real_base[($first >> 4) & 0x3], $exp);
337 4         41     return;
338               }
339               elsif($first & 0x40) {
340 2 100       25     $_[3] = POSIX::HUGE_VAL(),return if $first == 0x40;
341 1 50       15     $_[3] = - POSIX::HUGE_VAL(),return if $first == 0x41;
342               }
343               elsif(substr($_[4],$_[5],$_[6]) =~ /^.([-+]?)0*(\d+(?:\.\d+(?:[Ee][-+]?\d+)?)?)$/s) {
344 0         0     $_[3] = eval "$1$2";
345 0         0     return;
346               }
347              
348 0         0   die "REAL decode error\n";
349             }
350              
351              
352             sub _dec_sequence {
353             # 0 1 2 3 4 5 6 7
354             # $optn, $op, $stash, $var, $buf, $pos, $len, $larr
355              
356 31 50   31   336   if (defined( my $ch = $_[1]->[cCHILD])) {
357 31 100 66     1154     _decode(
      100        
358                   $_[0], #optn
359                   $ch, #ops
360                   (defined($_[3]) || $_[1]->[cLOOP]) ? $_[2] : ($_[3]= {}), #stash
361                   $_[5], #pos
362                   $_[5]+$_[6], #end
363                   $_[1]->[cLOOP] && ($_[3]=[]), #loop
364                   $_[7],
365                   $_[4], #buf
366                 );
367               }
368               else {
369 0         0     $_[3] = substr($_[4],$_[5],$_[6]);
370               }
371 31         2025   1;
372             }
373              
374              
375             sub _dec_set {
376             # 0 1 2 3 4 5 6 7
377             # $optn, $op, $stash, $var, $buf, $pos, $len, $larr
378              
379             # decode SET OF the same as SEQUENCE OF
380 4     4   42   my $ch = $_[1]->[cCHILD];
381 4 50 33     93   goto &_dec_sequence if $_[1]->[cLOOP] or !defined($ch);
382              
383 4         41   my ($optn, $pos, $larr) = @_[0,5,7];
384 4 50       110   my $stash = defined($_[3]) ? $_[2] : ($_[3]={});
385 4         39   my $end = $pos + $_[6];
386 4         34   my @done;
387              
388 4         46   while ($pos < $end) {
389 12 50       123     my($tag,$len,$npos,$indef) = _decode_tl($_[4],$pos,$end,$larr)
390                   or die "decode error";
391              
392 12         133     my ($idx, $any, $done) = (-1);
393              
394             SET_OP:
395 12         108     foreach my $op (@$ch) {
396 24         443       $idx++;
397 24 50       232       if (length($op->[cTAG])) {
    0          
    0          
398 24 100       1448 if ($tag eq $op->[cTAG]) {
399 12         106 my $var = $op->[cVAR];
400 12 50       151 &{$decode[$op->[cTYPE]]}(
  12         136  
401             $optn,
402             $op,
403             $stash,
404             # We send 1 if there is not var as if there is the decode
405             # should be getting undef. So if it does not get undef
406             # it knows it has no variable
407             (defined($var) ? $stash->{$var} : 1),
408             $_[4],$npos,$len,$larr,
409             );
410 12         109 $done = $idx;
411 12         174 last SET_OP;
412             }
413 12 50 33     142 if ($tag eq ($op->[cTAG] | chr(ASN_CONSTRUCTOR))
414             and my $ctr = $ctr[$op->[cTYPE]])
415             {
416 0         0 _decode(
417             $optn,
418             [$op],
419             undef,
420             $npos,
421             $npos+$len,
422             (\my @ctrlist),
423             $larr,
424             $_[4],
425             );
426              
427 0 0       0 $stash->{$op->[cVAR]} = &{$ctr}(@ctrlist)
  0         0  
428             if defined $op->[cVAR];
429 0         0 $done = $idx;
430 0         0 last SET_OP;
431             }
432 12         109 next SET_OP;
433                   }
434                   elsif ($op->[cTYPE] == opANY) {
435 0         0 $any = $idx;
436                   }
437                   elsif ($op->[cTYPE] == opCHOICE) {
438 0         0 foreach my $cop (@{$op->[cCHILD]}) {
  0         0  
439 0 0       0 if ($tag eq $cop->[cTAG]) {
440 0 0       0 my $nstash = defined($var) ? ($stash->{$var}={}) : $stash;
441              
442 0         0 &{$decode[$cop->[cTYPE]]}(
  0         0  
443             $optn,
444             $cop,
445             $nstash,
446             $nstash->{$cop->[cVAR]},
447             $_[4],$npos,$len,$larr,
448             );
449 0         0 $done = $idx;
450 0         0 last SET_OP;
451             }
452 0 0 0     0 if ($tag eq ($cop->[cTAG] | chr(ASN_CONSTRUCTOR))
453             and my $ctr = $ctr[$cop->[cTYPE]])
454             {
455 0 0       0 my $nstash = defined($var) ? ($stash->{$var}={}) : $stash;
456              
457 0         0 _decode(
458             $optn,
459             [$cop],
460             undef,
461             $npos,
462             $npos+$len,
463             (\my @ctrlist),
464             $larr,
465             $_[4],
466             );
467              
468 0         0 $nstash->{$cop->[cVAR]} = &{$ctr}(@ctrlist);
  0         0  
469 0         0 $done = $idx;
470 0         0 last SET_OP;
471             }
472             }
473                   }
474                   else {
475 0         0 die "internal error";
476                   }
477                 }
478              
479 12 50 33     132     if (!defined($done) and defined($any)) {
480 0         0       my $var = $ch->[$any][cVAR];
481 0 0       0       $stash->{$var} = substr($_[4],$pos,$len+$npos-$pos) if defined $var;
482 0         0       $done = $any;
483                 }
484              
485 12 50 33     164     die "decode error" if !defined($done) or $done[$done]++;
486              
487 12         143     $pos = $npos + $len + $indef;
488               }
489              
490 4 50       42   die "decode error" unless $end == $pos;
491              
492 4         36   foreach my $idx (0..$#{$ch}) {
  4         1533  
493 12 50 33     133     die "decode error" unless $done[$idx] or $ch->[$idx][cOPT];
494               }
495              
496 4         46   1;
497             }
498              
499              
500             my %_dec_time_opt = ( unixtime => 0, withzone => 1, raw => 2);
501              
502             sub _dec_time {
503             # 0 1 2 3 4 5 6
504             # $optn, $op, $stash, $var, $buf, $pos, $len
505              
506 6   50 6   102   my $mode = $_dec_time_opt{$_[0]->{'decode_time'} || ''} || 0;
      50        
507              
508 6 50 33     78   if ($mode == 2 or $_[6] == 0) {
509 0         0     $_[3] = substr($_[4],$_[5],$_[6]);
510 0         0     return;
511               }
512              
513 6 50       174   my @bits = (substr($_[4],$_[5],$_[6])
514                  =~ /^((?:\d\d)?\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)((?:\.\d{1,3})?)(([-+])(\d\d)(\d\d)|Z)/)
515                  or die "bad time format";
516              
517 6 100       76   if ($bits[0] < 100) {
518 3 50       33     $bits[0] += 100 if $bits[0] < 50;
519               }
520               else {
521 3         29     $bits[0] -= 1900;
522               }
523 6         76   $bits[1] -= 1;
524 6         121   require Time::Local;
525 6         73   my $time = Time::Local::timegm(@bits[5,4,3,2,1,0]);
526 6 100       61   $time += $bits[6] if length $bits[6];
527 6         50   my $offset = 0;
528 6 100       59   if ($bits[7] ne 'Z') {
529 5         46     $offset = $bits[9] * 3600 + $bits[10] * 60;
530 5 100       51     $offset = -$offset if $bits[8] eq '-';
531 5         41     $time -= $offset;
532               }
533 6 50       87   $_[3] = $mode ? [$time,$offset] : $time;
534             }
535              
536              
537             sub _dec_utf8 {
538             # 0 1 2 3 4 5 6
539             # $optn, $op, $stash, $var, $buf, $pos, $len
540              
541               BEGIN {
542 15     15   286     unless (CHECK_UTF8) {
543                   local $SIG{__DIE__};
544                   eval { require bytes } and 'bytes'->unimport;
545                   eval { require utf8 } and 'utf8'->import;
546                 }
547               }
548              
549 2     2   17   if (CHECK_UTF8) {
550 2         31     $_[3] = Encode::decode('utf8', substr($_[4],$_[5],$_[6]));
551               }
552               else {
553                 $_[3] = (substr($_[4],$_[5],$_[6]) =~ /(.*)/s)[0];
554               }
555              
556 2         90   1;
557             }
558              
559              
560             sub _decode_tl {
561 182     182   2066   my($pos,$end,$larr) = @_[1,2,3];
562              
563 182         3646   my $indef = 0;
564              
565 182         1791   my $tag = substr($_[0], $pos++, 1);
566              
567 182 50       2149   if((ord($tag) & 0x1f) == 0x1f) {
568 0         0     my $b;
569 0         0     my $n=1;
570 0         0     do {
571 0         0       $tag .= substr($_[0],$pos++,1);
572 0         0       $b = ord substr($tag,-1);
573                 } while($b & 0x80);
574               }
575 182 100       4007   return if $pos >= $end;
576              
577 181         2601   my $len = ord substr($_[0],$pos++,1);
578              
579 181 100       2050   if($len & 0x80) {
580 6         50     $len &= 0x7f;
581              
582 6 50       55     if ($len) {
583 0 0       0       return if $pos+$len > $end ;
584              
585 0         0       ($len,$pos) = (unpack("N", "\0" x (4 - $len) . substr($_[0],$pos,$len)), $pos+$len);
586                 }
587                 else {
588 6 100       68       unless (exists $larr->{$pos}) {
589 2 50       23         _scan_indef($_[0],$pos,$end,$larr) or return;
590                   }
591 6         50       $indef = 2;
592 6         56       $len = $larr->{$pos};
593                 }
594               }
595              
596 181 50       1923   return if $pos+$len+$indef > $end;
597              
598             # return the tag, the length of the data, the position of the data
599             # and the number of extra bytes for indefinate encoding
600              
601 181         2682   ($tag, $len, $pos, $indef);
602             }
603              
604             sub _scan_indef {
605 2     2   23   my($pos,$end,$larr) = @_[1,2,3];
606 2         22   my @depth = ( $pos );
607              
608 2         23   while(@depth) {
609 16 50       156     return if $pos+2 > $end;
610              
611 16 100       177     if (substr($_[0],$pos,2) eq "\0\0") {
612 6         50       my $end = $pos;
613 6         63       my $stref = shift @depth;
614             # replace pos with length = end - pos
615 6         61       $larr->{$stref} = $end - $stref;
616 6         51       $pos += 2;
617 6         59       next;
618                 }
619              
620 10         141     my $tag = substr($_[0], $pos++, 1);
621              
622 10 50       94     if((ord($tag) & 0x1f) == 0x1f) {
623 0         0       my $b;
624 0         0       do {
625 0         0 $tag .= substr($_[0],$pos++,1);
626 0         0 $b = ord substr($tag,-1);
627                   } while($b & 0x80);
628                 }
629 10 50       104     return if $pos >= $end;
630              
631 10         92     my $len = ord substr($_[0],$pos++,1);
632              
633 10 100       92     if($len & 0x80) {
634 4 50       38       if ($len &= 0x7f) {
635 0 0       0 return if $pos+$len > $end ;
636              
637 0         0 $pos += $len + unpack("N", "\0" x (4 - $len) . substr($_[0],$pos,$len));
638                   }
639                   else {
640             # reserve another list element
641 4         43         unshift @depth, $pos;
642                   }
643                 }
644                 else {
645 6         74       $pos += $len;
646                 }
647               }
648              
649 2         25   1;
650             }
651              
652 1     1   16 sub _ctr_string { join '', @_ }
653              
654             sub _ctr_bitstring {
655 0     0   0   [ join('', map { $_->[0] } @_), $_[-1]->[1] ]
  0         0  
656             }
657              
658             sub _dec_bcd {
659             # 0 1 2 3 4 5 6
660             # $optn, $op, $stash, $var, $buf, $pos, $len
661              
662 8     8   147   ($_[3] = unpack("H*", substr($_[4],$_[5],$_[6]))) =~ s/[fF]$//;
663 8         75   1;
664             }
665             1;
666              
667