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