1#----------------------------------------------------------------------------- 2# Copyright (C) 1999-2004 Jochen C. Loewer (loewerj@web.de) 3# Copyright (C) 2004-2007 Michael Schlenker (mic42@users.sourceforge.net) 4#----------------------------------------------------------------------------- 5# 6# A partial ASN decoder/encoder implementation in plain Tcl. 7# 8# See ASN.1 (X.680) and BER (X.690). 9# See 'asn_ber_intro.txt' in this directory. 10# 11# This software is copyrighted by Jochen C. Loewer (loewerj@web.de). The 12# following terms apply to all files associated with the software unless 13# explicitly disclaimed in individual files. 14# 15# The authors hereby grant permission to use, copy, modify, distribute, 16# and license this software and its documentation for any purpose, provided 17# that existing copyright notices are retained in all copies and that this 18# notice is included verbatim in any distributions. No written agreement, 19# license, or royalty fee is required for any of the authorized uses. 20# Modifications to this software may be copyrighted by their authors 21# and need not follow the licensing terms described here, provided that 22# the new terms are clearly indicated on the first page of each file where 23# they apply. 24# 25# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY 26# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES 27# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY 28# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE 29# POSSIBILITY OF SUCH DAMAGE. 30# 31# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, 32# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, 33# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE 34# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE 35# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR 36# MODIFICATIONS. 37# 38# written by Jochen Loewer 39# 3 June, 1999 40# 41# $Id: asn.tcl,v 1.19 2008/03/09 21:00:22 mic42 Exp $ 42# 43#----------------------------------------------------------------------------- 44 45# needed for using wide() 46package require Tcl 8.4 47 48namespace eval asn { 49 # Encoder commands 50 namespace export \ 51 asnSequence \ 52 asnSequenceFromList \ 53 asnSet \ 54 asnSetFromList \ 55 asnApplicationConstr \ 56 asnApplication \ 57 asnContext\ 58 asnContextConstr\ 59 asnChoice \ 60 asnChoiceConstr \ 61 asnInteger \ 62 asnEnumeration \ 63 asnBoolean \ 64 asnOctetString \ 65 asnNull \ 66 asnUTCTime \ 67 asnNumericString \ 68 asnPrintableString \ 69 asnIA5String\ 70 asnBMPString\ 71 asnUTF8String\ 72 asnBitString \ 73 asnObjectIdentifer 74 75 # Decoder commands 76 namespace export \ 77 asnGetResponse \ 78 asnGetInteger \ 79 asnGetEnumeration \ 80 asnGetOctetString \ 81 asnGetSequence \ 82 asnGetSet \ 83 asnGetApplication \ 84 asnGetNumericString \ 85 asnGetPrintableString \ 86 asnGetIA5String \ 87 asnGetBMPString \ 88 asnGetUTF8String \ 89 asnGetObjectIdentifier \ 90 asnGetBoolean \ 91 asnGetUTCTime \ 92 asnGetBitString \ 93 asnGetContext 94 95 # general BER utility commands 96 namespace export \ 97 asnPeekByte \ 98 asnGetLength \ 99 asnRetag \ 100 asnPeekTag \ 101 asnTag 102 103} 104 105#----------------------------------------------------------------------------- 106# Implementation notes: 107# 108# See the 'asn_ber_intro.txt' in this directory for an introduction 109# into BER/DER encoding of ASN.1 information. Bibliography information 110# 111# A Layman's Guide to a Subset of ASN.1, BER, and DER 112# 113# An RSA Laboratories Technical Note 114# Burton S. Kaliski Jr. 115# Revised November 1, 1993 116# 117# Supersedes June 3, 1991 version, which was also published as 118# NIST/OSI Implementors' Workshop document SEC-SIG-91-17. 119# PKCS documents are available by electronic mail to 120# <pkcs@rsa.com>. 121# 122# Copyright (C) 1991-1993 RSA Laboratories, a division of RSA 123# Data Security, Inc. License to copy this document is granted 124# provided that it is identified as "RSA Data Security, Inc. 125# Public-Key Cryptography Standards (PKCS)" in all material 126# mentioning or referencing this document. 127# 003-903015-110-000-000 128# 129#----------------------------------------------------------------------------- 130 131#----------------------------------------------------------------------------- 132# asnLength : Encode some length data. Helper command. 133#----------------------------------------------------------------------------- 134 135proc ::asn::asnLength {len} { 136 137 if {$len < 0} { 138 return -code error "Negative length octet requested" 139 } 140 if {$len < 128} { 141 # short form: ISO X.690 8.1.3.4 142 return [binary format c $len] 143 } 144 # long form: ISO X.690 8.1.3.5 145 # try to use a minimal encoding, 146 # even if not required by BER, but it is required by DER 147 # take care for signed vs. unsigned issues 148 if {$len < 256 } { 149 return [binary format H2c 81 [expr {$len - 256}]] 150 } 151 if {$len < 32769} { 152 # two octet signed value 153 return [binary format H2S 82 $len] 154 } 155 if {$len < 65536} { 156 return [binary format H2S 82 [expr {$len - 65536}]] 157 } 158 if {$len < 8388608} { 159 # three octet signed value 160 return [binary format H2cS 83 [expr {$len >> 16}] [expr {($len & 0xFFFF) - 65536}]] 161 } 162 if {$len < 16777216} { 163 # three octet signed value 164 return [binary format H2cS 83 [expr {($len >> 16) -256}] [expr {($len & 0xFFFF) -65536}]] 165 } 166 if {$len < 2147483649} { 167 # four octet signed value 168 return [binary format H2I 84 $len] 169 } 170 if {$len < 4294967296} { 171 # four octet unsigned value 172 return [binary format H2I 84 [expr {$len - 4294967296}]] 173 } 174 if {$len < 1099511627776} { 175 # five octet unsigned value 176 return [binary format H2 85][string range [binary format W $len] 3 end] 177 } 178 if {$len < 281474976710656} { 179 # six octet unsigned value 180 return [binary format H2 86][string range [binary format W $len] 2 end] 181 } 182 if {$len < 72057594037927936} { 183 # seven octet value 184 return [binary format H2 87][string range [binary format W $len] 1 end] 185 } 186 187 # must be a 64-bit wide signed value 188 return [binary format H2W 88 $len] 189} 190 191#----------------------------------------------------------------------------- 192# asnSequence : Assumes that the arguments are already ASN encoded. 193#----------------------------------------------------------------------------- 194 195proc ::asn::asnSequence {args} { 196 asnSequenceFromList $args 197} 198 199proc ::asn::asnSequenceFromList {lst} { 200 # The sequence tag is 0x30. The length is arbitrary and thus full 201 # length coding is required. The arguments have to be BER encoded 202 # already. Constructed value, definite-length encoding. 203 204 set out "" 205 foreach part $lst { 206 append out $part 207 } 208 set len [string length $out] 209 return [binary format H2a*a$len 30 [asnLength $len] $out] 210} 211 212 213#----------------------------------------------------------------------------- 214# asnSet : Assumes that the arguments are already ASN encoded. 215#----------------------------------------------------------------------------- 216 217proc ::asn::asnSet {args} { 218 asnSetFromList $args 219} 220 221proc ::asn::asnSetFromList {lst} { 222 # The set tag is 0x31. The length is arbitrary and thus full 223 # length coding is required. The arguments have to be BER encoded 224 # already. 225 226 set out "" 227 foreach part $lst { 228 append out $part 229 } 230 set len [string length $out] 231 return [binary format H2a*a$len 31 [asnLength $len] $out] 232} 233 234 235#----------------------------------------------------------------------------- 236# asnApplicationConstr 237#----------------------------------------------------------------------------- 238 239proc ::asn::asnApplicationConstr {appNumber args} { 240 # Packs the arguments into a constructed value with application tag. 241 242 set out "" 243 foreach part $args { 244 append out $part 245 } 246 set code [expr {0x060 + $appNumber}] 247 set len [string length $out] 248 return [binary format ca*a$len $code [asnLength $len] $out] 249} 250 251#----------------------------------------------------------------------------- 252# asnApplication 253#----------------------------------------------------------------------------- 254 255proc ::asn::asnApplication {appNumber data} { 256 # Packs the arguments into a constructed value with application tag. 257 258 set code [expr {0x040 + $appNumber}] 259 set len [string length $data] 260 return [binary format ca*a$len $code [asnLength $len] $data] 261} 262 263#----------------------------------------------------------------------------- 264# asnContextConstr 265#----------------------------------------------------------------------------- 266 267proc ::asn::asnContextConstr {contextNumber args} { 268 # Packs the arguments into a constructed value with application tag. 269 270 set out "" 271 foreach part $args { 272 append out $part 273 } 274 set code [expr {0x0A0 + $contextNumber}] 275 set len [string length $out] 276 return [binary format ca*a$len $code [asnLength $len] $out] 277} 278 279#----------------------------------------------------------------------------- 280# asnContext 281#----------------------------------------------------------------------------- 282 283proc ::asn::asnContext {contextNumber data} { 284 # Packs the arguments into a constructed value with application tag. 285 set code [expr {0x080 + $contextNumber}] 286 set len [string length $data] 287 return [binary format ca*a$len $code [asnLength $len] $data] 288} 289#----------------------------------------------------------------------------- 290# asnChoice 291#----------------------------------------------------------------------------- 292 293proc ::asn::asnChoice {appNumber args} { 294 # Packs the arguments into a choice construction. 295 296 set out "" 297 foreach part $args { 298 append out $part 299 } 300 set code [expr {0x080 + $appNumber}] 301 set len [string length $out] 302 return [binary format ca*a$len $code [asnLength $len] $out] 303} 304 305#----------------------------------------------------------------------------- 306# asnChoiceConstr 307#----------------------------------------------------------------------------- 308 309proc ::asn::asnChoiceConstr {appNumber args} { 310 # Packs the arguments into a choice construction. 311 312 set out "" 313 foreach part $args { 314 append out $part 315 } 316 set code [expr {0x0A0 + $appNumber}] 317 set len [string length $out] 318 return [binary format ca*a$len $code [asnLength $len] $out] 319} 320 321#----------------------------------------------------------------------------- 322# asnInteger : Encode integer value. 323#----------------------------------------------------------------------------- 324 325proc ::asn::asnInteger {number} { 326 asnIntegerOrEnum 02 $number 327} 328 329#----------------------------------------------------------------------------- 330# asnEnumeration : Encode enumeration value. 331#----------------------------------------------------------------------------- 332 333proc ::asn::asnEnumeration {number} { 334 asnIntegerOrEnum 0a $number 335} 336 337#----------------------------------------------------------------------------- 338# asnIntegerOrEnum : Common code for Integers and Enumerations 339# No Bignum version, as we do not expect large Enums. 340#----------------------------------------------------------------------------- 341 342proc ::asn::asnIntegerOrEnum {tag number} { 343 # The integer tag is 0x02 , the Enum Tag 0x0a otherwise identical. 344 # The length is 1, 2, 3, or 4, coded in a 345 # single byte. This can be done directly, no need to go through 346 # asnLength. The value itself is written in big-endian. 347 348 # Known bug/issue: The command cannot handle very wide integers, i.e. 349 # anything above 8 bytes length. Use asnBignumInteger for those. 350 351 # check if we really have an int 352 set num $number 353 incr num 354 355 if {($number >= -128) && ($number < 128)} { 356 return [binary format H2H2c $tag 01 $number] 357 } 358 if {($number >= -32768) && ($number < 32768)} { 359 return [binary format H2H2S $tag 02 $number] 360 } 361 if {($number >= -8388608) && ($number < 8388608)} { 362 set numberb [expr {$number & 0xFFFF}] 363 set numbera [expr {($number >> 16) & 0xFF}] 364 return [binary format H2H2cS $tag 03 $numbera $numberb] 365 } 366 if {($number >= -2147483648) && ($number < 2147483648)} { 367 return [binary format H2H2I $tag 04 $number] 368 } 369 if {($number >= -549755813888) && ($number < 549755813888)} { 370 set numberb [expr {$number & 0xFFFFFFFF}] 371 set numbera [expr {($number >> 32) & 0xFF}] 372 return [binary format H2H2cI $tag 05 $numbera $numberb] 373 } 374 if {($number >= -140737488355328) && ($number < 140737488355328)} { 375 set numberb [expr {$number & 0xFFFFFFFF}] 376 set numbera [expr {($number >> 32) & 0xFFFF}] 377 return [binary format H2H2SI $tag 06 $numbera $numberb] 378 } 379 if {($number >= -36028797018963968) && ($number < 36028797018963968)} { 380 set numberc [expr {$number & 0xFFFFFFFF}] 381 set numberb [expr {($number >> 32) & 0xFFFF}] 382 set numbera [expr {($number >> 48) & 0xFF}] 383 return [binary format H2H2cSI $tag 07 $numbera $numberb $numberc] 384 } 385 if {($number >= -9223372036854775808) && ($number <= 9223372036854775807)} { 386 return [binary format H2H2W $tag 08 $number] 387 } 388 return -code error "Integer value to large to encode, use asnBigInteger" 389} 390 391#----------------------------------------------------------------------------- 392# asnBigInteger : Encode a long integer value using math::bignum 393#----------------------------------------------------------------------------- 394 395proc ::asn::asnBigInteger {bignum} { 396 # require math::bignum only if it is used 397 package require math::bignum 398 399 # this is a hack to check for bignum... 400 if {[llength $bignum] < 2 || ([lindex $bignum 0] ne "bignum")} { 401 return -code error "expected math::bignum value got \"$bignum\"" 402 } 403 if {[math::bignum::sign $bignum]} { 404 # generate two's complement form 405 set bits [math::bignum::bits $bignum] 406 set padding [expr {$bits % 8}] 407 set len [expr {int(ceil($bits / 8.0))}] 408 if {$padding == 0} { 409 # we need a complete extra byte for the sign 410 # unless this is a base 2 multiple 411 set test [math::bignum::fromstr 0] 412 math::bignum::setbit test [expr {$bits-1}] 413 if {[math::bignum::ne [math::bignum::abs $bignum] $test]} { 414 incr len 415 } 416 } 417 set exp [math::bignum::pow \ 418 [math::bignum::fromstr 256] \ 419 [math::bignum::fromstr $len]] 420 set bignum [math::bignum::add $bignum $exp] 421 set hex [math::bignum::tostr $bignum 16] 422 } else { 423 set bits [math::bignum::bits $bignum] 424 if {($bits % 8) == 0 && $bits > 0} { 425 set pad "00" 426 } else { 427 set pad "" 428 } 429 set hex $pad[math::bignum::tostr $bignum 16] 430 } 431 if {[string length $hex]%2} { 432 set hex "0$hex" 433 } 434 set octets [expr {(([string length $hex]+1)/2)}] 435 return [binary format H2a*H* 02 [asnLength $octets] $hex] 436} 437 438 439#----------------------------------------------------------------------------- 440# asnBoolean : Encode a boolean value. 441#----------------------------------------------------------------------------- 442 443proc ::asn::asnBoolean {bool} { 444 # The boolean tag is 0x01. The length is always 1, coded in 445 # a single byte. This can be done directly, no need to go through 446 # asnLength. The value itself is written in big-endian. 447 448 return [binary format H2H2c 01 01 [expr {$bool ? 0x0FF : 0x0}]] 449} 450 451#----------------------------------------------------------------------------- 452# asnOctetString : Encode a string of arbitrary bytes 453#----------------------------------------------------------------------------- 454 455proc ::asn::asnOctetString {string} { 456 # The octet tag is 0x04. The length is arbitrary, so we need 457 # 'asnLength' for full coding of the length. 458 459 set len [string length $string] 460 return [binary format H2a*a$len 04 [asnLength $len] $string] 461} 462 463#----------------------------------------------------------------------------- 464# asnNull : Encode a null value 465#----------------------------------------------------------------------------- 466 467proc ::asn::asnNull {} { 468 # Null has only one valid encoding 469 return \x05\x00 470} 471 472#----------------------------------------------------------------------------- 473# asnBitstring : Encode a Bit String value 474#----------------------------------------------------------------------------- 475 476proc ::asn::asnBitString {bitstring} { 477 # The bit string tag is 0x03. 478 # Bit strings can be either simple or constructed 479 # we always use simple encoding 480 481 set bitlen [string length $bitstring] 482 set padding [expr {(8 - ($bitlen % 8)) % 8}] 483 set len [expr {($bitlen / 8) + 1}] 484 if {$padding != 0} { incr len } 485 486 return [binary format H2a*cB* 03 [asnLength $len] $padding $bitstring] 487} 488 489#----------------------------------------------------------------------------- 490# asnUTCTime : Encode an UTC time string 491#----------------------------------------------------------------------------- 492 493proc ::asn::asnUTCTime {UTCtimestring} { 494 # the utc time tag is 0x17. 495 # 496 # BUG: we do not check the string for well formedness 497 498 set ascii [encoding convertto ascii $UTCtimestring] 499 set len [string length $ascii] 500 return [binary format H2a*a* 17 [asnLength $len] $ascii] 501} 502 503#----------------------------------------------------------------------------- 504# asnPrintableString : Encode a printable string 505#----------------------------------------------------------------------------- 506namespace eval asn { 507 variable nonPrintableChars {[^ A-Za-z0-9'()+,.:/?=-]} 508} 509proc ::asn::asnPrintableString {string} { 510 # the printable string tag is 0x13 511 variable nonPrintableChars 512 # it is basically a restricted ascii string 513 if {[regexp $nonPrintableChars $string ]} { 514 return -code error "Illegal character in PrintableString." 515 } 516 517 # check characters 518 set ascii [encoding convertto ascii $string] 519 return [asnEncodeString 13 $ascii] 520} 521 522#----------------------------------------------------------------------------- 523# asnIA5String : Encode an Ascii String 524#----------------------------------------------------------------------------- 525proc ::asn::asnIA5String {string} { 526 # the IA5 string tag is 0x16 527 # check for extended charachers 528 if {[string length $string]!=[string bytelength $string]} { 529 return -code error "Illegal character in IA5String" 530 } 531 set ascii [encoding convertto ascii $string] 532 return [asnEncodeString 16 $ascii] 533} 534 535#----------------------------------------------------------------------------- 536# asnNumericString : Encode a Numeric String type 537#----------------------------------------------------------------------------- 538namespace eval asn { 539 variable nonNumericChars {[^0-9 ]} 540} 541proc ::asn::asnNumericString {string} { 542 # the Numeric String type has tag 0x12 543 variable nonNumericChars 544 if {[regexp $nonNumericChars $string]} { 545 return -code error "Illegal character in Numeric String." 546 } 547 548 return [asnEncodeString 12 $string] 549} 550#---------------------------------------------------------------------- 551# asnBMPString: Encode a Tcl string as Basic Multinligval (UCS2) string 552#----------------------------------------------------------------------- 553proc asn::asnBMPString {string} { 554 if {$::tcl_platform(byteOrder) eq "littleEndian"} { 555 set bytes "" 556 foreach {lo hi} [split [encoding convertto unicode $string] ""] { 557 append bytes $hi $lo 558 } 559 } else { 560 set bytes [encoding convertto unicode $string] 561 } 562 return [asnEncodeString 1e $bytes] 563} 564#--------------------------------------------------------------------------- 565# asnUTF8String: encode tcl string as UTF8 String 566#---------------------------------------------------------------------------- 567proc asn::asnUTF8String {string} { 568 return [asnEncodeString 0c [encoding convertto utf-8 $string]] 569} 570#----------------------------------------------------------------------------- 571# asnEncodeString : Encode an RestrictedCharacter String 572#----------------------------------------------------------------------------- 573proc ::asn::asnEncodeString {tag string} { 574 set len [string length $string] 575 return [binary format H2a*a$len $tag [asnLength $len] $string] 576} 577 578#----------------------------------------------------------------------------- 579# asnObjectIdentifier : Encode an Object Identifier value 580#----------------------------------------------------------------------------- 581proc ::asn::asnObjectIdentifier {oid} { 582 # the object identifier tag is 0x06 583 584 if {[llength $oid] < 2} { 585 return -code error "OID must have at least two subidentifiers." 586 } 587 588 # basic check that it is valid 589 foreach identifier $oid { 590 if {$identifier < 0} { 591 return -code error \ 592 "Malformed OID. Identifiers must be positive Integers." 593 } 594 } 595 596 if {[lindex $oid 0] > 2} { 597 return -code error "First subidentifier must be 0,1 or 2" 598 } 599 if {[lindex $oid 1] > 39} { 600 return -code error \ 601 "Second subidentifier must be between 0 and 39" 602 } 603 604 # handle the special cases directly 605 switch [llength $oid] { 606 2 { return [binary format H2H2c 06 01 \ 607 [expr {[lindex $oid 0]*40+[lindex $oid 1]}]] } 608 default { 609 # This can probably be written much shorter. 610 # Just a first try that works... 611 # 612 set octets [binary format c \ 613 [expr {[lindex $oid 0]*40+[lindex $oid 1]}]] 614 foreach identifier [lrange $oid 2 end] { 615 set d 128 616 if {$identifier < 128} { 617 set subidentifier [list $identifier] 618 } else { 619 set subidentifier [list] 620 # find the largest divisor 621 622 while {($identifier / $d) >= 128} { 623 set d [expr {$d * 128}] 624 } 625 # and construct the subidentifiers 626 set remainder $identifier 627 while {$d >= 128} { 628 set coefficient [expr {($remainder / $d) | 0x80}] 629 set remainder [expr {$remainder % $d}] 630 set d [expr {$d / 128}] 631 lappend subidentifier $coefficient 632 } 633 lappend subidentifier $remainder 634 } 635 append octets [binary format c* $subidentifier] 636 } 637 return [binary format H2a*a* 06 \ 638 [asnLength [string length $octets]] $octets] 639 } 640 } 641 642} 643 644#----------------------------------------------------------------------------- 645# asnGetResponse : Read a ASN response from a channel. 646#----------------------------------------------------------------------------- 647 648proc ::asn::asnGetResponse {sock data_var} { 649 upvar 1 $data_var data 650 651 # We expect a sequence here (tag 0x30). The code below is an 652 # inlined replica of 'asnGetSequence', modified for reading from a 653 # channel instead of a string. 654 655 set tag [read $sock 1] 656 657 if {$tag == "\x30"} { 658 # The following code is a replica of 'asnGetLength', modified 659 # for reading the bytes from the channel instead of a string. 660 661 set len1 [read $sock 1] 662 binary scan $len1 c num 663 set length [expr {($num + 0x100) % 0x100}] 664 665 if {$length >= 0x080} { 666 # The byte the read is not the length, but a prefix, and 667 # the lower nibble tells us how many bytes follow. 668 669 set len_length [expr {$length & 0x7f}] 670 671 # BUG: We should not perform the value extraction for an 672 # BUG: improper length. It wastes cycles, and here it can 673 # BUG: cause us trouble, reading more data than there is 674 # BUG: on the channel. Depending on the channel 675 # BUG: configuration an attacker can induce us to block, 676 # BUG: causing a denial of service. 677 set lengthBytes [read $sock $len_length] 678 679 switch $len_length { 680 1 { 681 binary scan $lengthBytes c length 682 set length [expr {($length + 0x100) % 0x100}] 683 } 684 2 { binary scan $lengthBytes S length } 685 3 { binary scan \x00$lengthBytes I length } 686 4 { binary scan $lengthBytes I length } 687 default { 688 return -code error \ 689 "length information too long ($len_length)" 690 } 691 } 692 } 693 694 # Now that the length is known we get the remainder, 695 # i.e. payload, and construct proper in-memory BER encoded 696 # sequence. 697 698 set rest [read $sock $length] 699 set data [binary format aa*a$length $tag [asnLength $length] $rest] 700 } else { 701 # Generate an error message if the data is not a sequence as 702 # we expected. 703 704 set tag_hex "" 705 binary scan $tag H2 tag_hex 706 return -code error "unknown start tag [string length $tag] $tag_hex" 707 } 708} 709 710if {[package vsatisfies [package present Tcl] 8.5.0]} { 711############################################################################## 712# Code for 8.5 713############################################################################## 714#----------------------------------------------------------------------------- 715# asnGetByte (8.5 version) : Retrieve a single byte from the data (unsigned) 716#----------------------------------------------------------------------------- 717 718proc ::asn::asnGetByte {data_var byte_var} { 719 upvar 1 $data_var data $byte_var byte 720 721 binary scan [string index $data 0] cu byte 722 set data [string range $data 1 end] 723 724 return 725} 726 727#----------------------------------------------------------------------------- 728# asnPeekByte (8.5 version) : Retrieve a single byte from the data (unsigned) 729# without removing it. 730#----------------------------------------------------------------------------- 731 732proc ::asn::asnPeekByte {data_var byte_var {offset 0}} { 733 upvar 1 $data_var data $byte_var byte 734 735 binary scan [string index $data $offset] cu byte 736 737 return 738} 739 740#----------------------------------------------------------------------------- 741# asnGetLength (8.5 version) : Decode an ASN length value (See notes) 742#----------------------------------------------------------------------------- 743 744proc ::asn::asnGetLength {data_var length_var} { 745 upvar 1 $data_var data $length_var length 746 747 asnGetByte data length 748 if {$length == 0x080} { 749 return -code error "Indefinite length BER encoding not yet supported" 750 } 751 if {$length > 0x080} { 752 # The retrieved byte is a prefix value, and the integer in the 753 # lower nibble tells us how many bytes were used to encode the 754 # length data following immediately after this prefix. 755 756 set len_length [expr {$length & 0x7f}] 757 758 if {[string length $data] < $len_length} { 759 return -code error \ 760 "length information invalid, not enough octets left" 761 } 762 763 asnGetBytes data $len_length lengthBytes 764 765 switch $len_length { 766 1 { binary scan $lengthBytes cu length } 767 2 { binary scan $lengthBytes Su length } 768 3 { binary scan \x00$lengthBytes Iu length } 769 4 { binary scan $lengthBytes Iu length } 770 default { 771 binary scan $lengthBytes H* hexstr 772 scan $hexstr %llx length 773 } 774 } 775 } 776 return 777} 778 779} else { 780############################################################################## 781# Code for Tcl 8.4 782############################################################################## 783#----------------------------------------------------------------------------- 784# asnGetByte : Retrieve a single byte from the data (unsigned) 785#----------------------------------------------------------------------------- 786 787proc ::asn::asnGetByte {data_var byte_var} { 788 upvar 1 $data_var data $byte_var byte 789 790 binary scan [string index $data 0] c byte 791 set byte [expr {($byte + 0x100) % 0x100}] 792 set data [string range $data 1 end] 793 794 return 795} 796 797#----------------------------------------------------------------------------- 798# asnPeekByte : Retrieve a single byte from the data (unsigned) 799# without removing it. 800#----------------------------------------------------------------------------- 801 802proc ::asn::asnPeekByte {data_var byte_var {offset 0}} { 803 upvar 1 $data_var data $byte_var byte 804 805 binary scan [string index $data $offset] c byte 806 set byte [expr {($byte + 0x100) % 0x100}] 807 808 return 809} 810 811#----------------------------------------------------------------------------- 812# asnGetLength : Decode an ASN length value (See notes) 813#----------------------------------------------------------------------------- 814 815proc ::asn::asnGetLength {data_var length_var} { 816 upvar 1 $data_var data $length_var length 817 818 asnGetByte data length 819 if {$length == 0x080} { 820 return -code error "Indefinite length BER encoding not yet supported" 821 } 822 if {$length > 0x080} { 823 # The retrieved byte is a prefix value, and the integer in the 824 # lower nibble tells us how many bytes were used to encode the 825 # length data following immediately after this prefix. 826 827 set len_length [expr {$length & 0x7f}] 828 829 if {[string length $data] < $len_length} { 830 return -code error \ 831 "length information invalid, not enough octets left" 832 } 833 834 asnGetBytes data $len_length lengthBytes 835 836 switch $len_length { 837 1 { 838 # Efficiently coded data will not go through this 839 # path, as small length values can be coded directly, 840 # without a prefix. 841 842 binary scan $lengthBytes c length 843 set length [expr {($length + 0x100) % 0x100}] 844 } 845 2 { binary scan $lengthBytes S length 846 set length [expr {($length + 0x10000) % 0x10000}] 847 } 848 3 { binary scan \x00$lengthBytes I length 849 set length [expr {($length + 0x1000000) % 0x1000000}] 850 } 851 4 { binary scan $lengthBytes I length 852 set length [expr {(wide($length) + 0x100000000) % 0x100000000}] 853 } 854 default { 855 binary scan $lengthBytes H* hexstr 856 # skip leading zeros which are allowed by BER 857 set hexlen [string trimleft $hexstr 0] 858 # check if it fits into a 64-bit signed integer 859 if {[string length $hexlen] > 16} { 860 return -code error -errorcode {ARITH IOVERFLOW 861 {Length value too large for normal use, try asnGetBigLength}} \ 862 "Length value to large" 863 } elseif { [string length $hexlen] == 16 \ 864 && ([string index $hexlen 0] & 0x8)} { 865 # check most significant bit, if set we need bignum 866 return -code error -errorcode {ARITH IOVERFLOW 867 {Length value too large for normal use, try asnGetBigLength}} \ 868 "Length value to large" 869 } else { 870 scan $hexstr "%lx" length 871 } 872 } 873 } 874 } 875 return 876} 877 878} 879 880#----------------------------------------------------------------------------- 881# asnRetag: Remove an explicit tag with the real newTag 882# 883#----------------------------------------------------------------------------- 884proc ::asn::asnRetag {data_var newTag} { 885 upvar 1 $data_var data 886 set tag "" 887 set type "" 888 set len [asnPeekTag data tag type dummy] 889 asnGetBytes data $len tagbytes 890 set data [binary format c* $newTag]$data 891} 892 893#----------------------------------------------------------------------------- 894# asnGetBytes : Retrieve a block of 'length' bytes from the data. 895#----------------------------------------------------------------------------- 896 897proc ::asn::asnGetBytes {data_var length bytes_var} { 898 upvar 1 $data_var data $bytes_var bytes 899 900 incr length -1 901 set bytes [string range $data 0 $length] 902 incr length 903 set data [string range $data $length end] 904 905 return 906} 907 908#----------------------------------------------------------------------------- 909# asnPeekTag : Decode the tag value 910#----------------------------------------------------------------------------- 911 912proc ::asn::asnPeekTag {data_var tag_var tagtype_var constr_var} { 913 upvar 1 $data_var data $tag_var tag $tagtype_var tagtype $constr_var constr 914 915 set type 0 916 set offset 0 917 asnPeekByte data type $offset 918 # check if we have a simple tag, < 31, which fits in one byte 919 920 set tval [expr {$type & 0x1f}] 921 if {$tval == 0x1f} { 922 # long tag, max 64-bit with Tcl 8.4, unlimited with 8.5 bignum 923 asnPeekByte data tagbyte [incr offset] 924 set tval [expr {wide($tagbyte & 0x7f)}] 925 while {($tagbyte & 0x80)} { 926 asnPeekByte data tagbyte [incr offset] 927 set tval [expr {($tval << 7) + ($tagbyte & 0x7f)}] 928 } 929 } 930 931 set tagtype [lindex {UNIVERSAL APPLICATION CONTEXT PRIVATE} \ 932 [expr {($type & 0xc0) >>6}]] 933 set tag $tval 934 set constr [expr {($type & 0x20) > 0}] 935 936 return [incr offset] 937} 938 939#----------------------------------------------------------------------------- 940# asnTag : Build a tag value 941#----------------------------------------------------------------------------- 942 943proc ::asn::asnTag {tagnumber {class UNIVERSAL} {tagstyle P}} { 944 set first 0 945 if {$tagnumber < 31} { 946 # encode everything in one byte 947 set first $tagnumber 948 set bytes [list] 949 } else { 950 # multi-byte tag 951 set first 31 952 set bytes [list [expr {$tagnumber & 0x7f}]] 953 set tagnumber [expr {$tagnumber >> 7}] 954 while {$tagnumber > 0} { 955 lappend bytes [expr {($tagnumber & 0x7f)+0x80}] 956 set tagnumber [expr {$tagnumber >>7}] 957 } 958 959 } 960 961 if {$tagstyle eq "C" || $tagstyle == 1 } {incr first 32} 962 switch -glob -- $class { 963 U* { ;# UNIVERSAL } 964 A* { incr first 64 ;# APPLICATION } 965 C* { incr first 128 ;# CONTEXT } 966 P* { incr first 192 ;# PRIVATE } 967 default { 968 return -code error "Unknown tag class \"$class\"" 969 } 970 } 971 if {[llength $bytes] > 0} { 972 # long tag 973 set rbytes [list] 974 for {set i [expr {[llength $bytes]-1}]} {$i >= 0} {incr i -1} { 975 lappend rbytes [lindex $bytes $i] 976 } 977 return [binary format cc* $first $rbytes ] 978 } 979 return [binary format c $first] 980} 981 982 983 984#----------------------------------------------------------------------------- 985# asnGetBigLength : Retrieve a length that can not be represented in 63-bit 986#----------------------------------------------------------------------------- 987 988proc ::asn::asnGetBigLength {data_var biglength_var} { 989 990 # Does any real world code really need this? 991 # If we encounter this, we are doomed to fail anyway, 992 # (there would be an Exabyte inside the data_var, ) 993 # 994 # So i implement it just for completness. 995 # 996 package require math::bignum 997 998 upvar 1 $data_var data $biglength_var length 999 1000 asnGetByte data length 1001 if {$length == 0x080} { 1002 return -code error "Indefinite length BER encoding not yet supported" 1003 } 1004 if {$length > 0x080} { 1005 # The retrieved byte is a prefix value, and the integer in the 1006 # lower nibble tells us how many bytes were used to encode the 1007 # length data following immediately after this prefix. 1008 1009 set len_length [expr {$length & 0x7f}] 1010 1011 if {[string length $data] < $len_length} { 1012 return -code error \ 1013 "length information invalid, not enough octets left" 1014 } 1015 1016 asnGetBytes data $len_length lengthBytes 1017 binary scan $lengthBytes H* hexlen 1018 set length [math::bignum::fromstr $hexlen 16] 1019 } 1020 return 1021} 1022 1023#----------------------------------------------------------------------------- 1024# asnGetInteger : Retrieve integer. 1025#----------------------------------------------------------------------------- 1026 1027proc ::asn::asnGetInteger {data_var int_var} { 1028 # Tag is 0x02. 1029 1030 upvar 1 $data_var data $int_var int 1031 1032 asnGetByte data tag 1033 1034 if {$tag != 0x02} { 1035 return -code error \ 1036 [format "Expected Integer (0x02), but got %02x" $tag] 1037 } 1038 1039 asnGetLength data len 1040 asnGetBytes data $len integerBytes 1041 1042 set int ? 1043 1044 switch $len { 1045 1 { binary scan $integerBytes c int } 1046 2 { binary scan $integerBytes S int } 1047 3 { 1048 # check for negative int and pad 1049 scan [string index $integerBytes 0] %c byte 1050 if {$byte & 128} { 1051 binary scan \xff$integerBytes I int 1052 } else { 1053 binary scan \x00$integerBytes I int 1054 } 1055 } 1056 4 { binary scan $integerBytes I int } 1057 5 - 1058 6 - 1059 7 - 1060 8 { 1061 # check for negative int and pad 1062 scan [string index $integerBytes 0] %c byte 1063 if {$byte & 128} { 1064 set pad [string repeat \xff [expr {8-$len}]] 1065 } else { 1066 set pad [string repeat \x00 [expr {8-$len}]] 1067 } 1068 binary scan $pad$integerBytes W int 1069 } 1070 default { 1071 # Too long, or prefix coding was used. 1072 return -code error "length information too long" 1073 } 1074 } 1075 return 1076} 1077 1078#----------------------------------------------------------------------------- 1079# asnGetBigInteger : Retrieve a big integer. 1080#----------------------------------------------------------------------------- 1081 1082proc ::asn::asnGetBigInteger {data_var bignum_var} { 1083 # require math::bignum only if it is used 1084 package require math::bignum 1085 1086 # Tag is 0x02. We expect that the length of the integer is coded with 1087 # maximal efficiency, i.e. without a prefix 0x81 prefix. If a prefix 1088 # is used this decoder will fail. 1089 1090 upvar 1 $data_var data $bignum_var bignum 1091 1092 asnGetByte data tag 1093 1094 if {$tag != 0x02} { 1095 return -code error \ 1096 [format "Expected Integer (0x02), but got %02x" $tag] 1097 } 1098 1099 asnGetLength data len 1100 asnGetBytes data $len integerBytes 1101 1102 binary scan $integerBytes H* hex 1103 set bignum [math::bignum::fromstr $hex 16] 1104 set bits [math::bignum::bits $bignum] 1105 set exp [math::bignum::pow \ 1106 [math::bignum::fromstr 2] \ 1107 [math::bignum::fromstr $bits]] 1108 set big [math::bignum::sub $bignum $exp] 1109 set bignum $big 1110 1111 return 1112} 1113 1114 1115 1116#----------------------------------------------------------------------------- 1117# asnGetEnumeration : Retrieve an enumeration id 1118#----------------------------------------------------------------------------- 1119 1120proc ::asn::asnGetEnumeration {data_var enum_var} { 1121 # This is like 'asnGetInteger', except for a different tag. 1122 1123 upvar 1 $data_var data $enum_var enum 1124 1125 asnGetByte data tag 1126 1127 if {$tag != 0x0a} { 1128 return -code error \ 1129 [format "Expected Enumeration (0x0a), but got %02x" $tag] 1130 } 1131 1132 asnGetLength data len 1133 asnGetBytes data $len integerBytes 1134 set enum ? 1135 1136 switch $len { 1137 1 { binary scan $integerBytes c enum } 1138 2 { binary scan $integerBytes S enum } 1139 3 { binary scan \x00$integerBytes I enum } 1140 4 { binary scan $integerBytes I enum } 1141 default { 1142 return -code error "length information too long" 1143 } 1144 } 1145 return 1146} 1147 1148#----------------------------------------------------------------------------- 1149# asnGetOctetString : Retrieve arbitrary string. 1150#----------------------------------------------------------------------------- 1151 1152proc ::asn::asnGetOctetString {data_var string_var} { 1153 # Here we need the full decoder for length data. 1154 1155 upvar 1 $data_var data $string_var string 1156 1157 asnGetByte data tag 1158 if {$tag != 0x04} { 1159 return -code error \ 1160 [format "Expected Octet String (0x04), but got %02x" $tag] 1161 } 1162 asnGetLength data length 1163 asnGetBytes data $length temp 1164 set string $temp 1165 return 1166} 1167 1168#----------------------------------------------------------------------------- 1169# asnGetSequence : Retrieve Sequence data for further decoding. 1170#----------------------------------------------------------------------------- 1171 1172proc ::asn::asnGetSequence {data_var sequence_var} { 1173 # Here we need the full decoder for length data. 1174 1175 upvar 1 $data_var data $sequence_var sequence 1176 1177 asnGetByte data tag 1178 if {$tag != 0x030} { 1179 return -code error \ 1180 [format "Expected Sequence (0x30), but got %02x" $tag] 1181 } 1182 asnGetLength data length 1183 asnGetBytes data $length temp 1184 set sequence $temp 1185 return 1186} 1187 1188#----------------------------------------------------------------------------- 1189# asnGetSet : Retrieve Set data for further decoding. 1190#----------------------------------------------------------------------------- 1191 1192proc ::asn::asnGetSet {data_var set_var} { 1193 # Here we need the full decoder for length data. 1194 1195 upvar 1 $data_var data $set_var set 1196 1197 asnGetByte data tag 1198 if {$tag != 0x031} { 1199 return -code error \ 1200 [format "Expected Set (0x31), but got %02x" $tag] 1201 } 1202 asnGetLength data length 1203 asnGetBytes data $length temp 1204 set set $temp 1205 return 1206} 1207 1208#----------------------------------------------------------------------------- 1209# asnGetApplication 1210#----------------------------------------------------------------------------- 1211 1212proc ::asn::asnGetApplication {data_var appNumber_var {content_var {}} {encodingType_var {}} } { 1213 upvar 1 $data_var data $appNumber_var appNumber 1214 1215 asnGetByte data tag 1216 asnGetLength data length 1217 1218 if {($tag & 0xC0) != 0x40} { 1219 return -code error \ 1220 [format "Expected Application, but got %02x" $tag] 1221 } 1222 if {$encodingType_var != {}} { 1223 upvar 1 $encodingType_var encodingType 1224 set encodingType [expr {($tag & 0x20) > 0}] 1225 } 1226 set appNumber [expr {$tag & 0x1F}] 1227 if {[string length $content_var]} { 1228 upvar 1 $content_var content 1229 asnGetBytes data $length content 1230 } 1231 return 1232} 1233 1234#----------------------------------------------------------------------------- 1235# asnGetBoolean: decode a boolean value 1236#----------------------------------------------------------------------------- 1237 1238proc asn::asnGetBoolean {data_var bool_var} { 1239 upvar 1 $data_var data $bool_var bool 1240 1241 asnGetByte data tag 1242 if {$tag != 0x01} { 1243 return -code error \ 1244 [format "Expected Boolean (0x01), but got %02x" $tag] 1245 } 1246 1247 asnGetLength data length 1248 asnGetByte data byte 1249 set bool [expr {$byte == 0 ? 0 : 1}] 1250 return 1251} 1252 1253#----------------------------------------------------------------------------- 1254# asnGetUTCTime: Extract an UTC Time string from the data. Returns a string 1255# representing an UTC Time. 1256# 1257#----------------------------------------------------------------------------- 1258 1259proc asn::asnGetUTCTime {data_var utc_var} { 1260 upvar 1 $data_var data $utc_var utc 1261 1262 asnGetByte data tag 1263 if {$tag != 0x17} { 1264 return -code error \ 1265 [format "Expected UTCTime (0x17), but got %02x" $tag] 1266 } 1267 1268 asnGetLength data length 1269 asnGetBytes data $length bytes 1270 1271 # this should be ascii, make it explicit 1272 set bytes [encoding convertfrom ascii $bytes] 1273 binary scan $bytes a* utc 1274 1275 return 1276} 1277 1278 1279#----------------------------------------------------------------------------- 1280# asnGetBitString: Extract a Bit String value (a string of 0/1s) from the 1281# ASN.1 data. 1282# 1283#----------------------------------------------------------------------------- 1284 1285proc asn::asnGetBitString {data_var bitstring_var} { 1286 upvar 1 $data_var data $bitstring_var bitstring 1287 1288 asnGetByte data tag 1289 if {$tag != 0x03} { 1290 return -code error \ 1291 [format "Expected Bit String (0x03), but got %02x" $tag] 1292 } 1293 1294 asnGetLength data length 1295 # get the number of padding bits used at the end 1296 asnGetByte data padding 1297 incr length -1 1298 asnGetBytes data $length bytes 1299 binary scan $bytes B* bits 1300 1301 # cut off the padding bits 1302 set bits [string range $bits 0 end-$padding] 1303 set bitstring $bits 1304} 1305 1306#----------------------------------------------------------------------------- 1307# asnGetObjectIdentifier: Decode an ASN.1 Object Identifier (OID) into 1308# a Tcl list of integers. 1309#----------------------------------------------------------------------------- 1310 1311proc asn::asnGetObjectIdentifier {data_var oid_var} { 1312 upvar 1 $data_var data $oid_var oid 1313 1314 asnGetByte data tag 1315 if {$tag != 0x06} { 1316 return -code error \ 1317 [format "Expected Object Identifier (0x06), but got %02x" $tag] 1318 } 1319 asnGetLength data length 1320 1321 # the first byte encodes the OID parts in position 0 and 1 1322 asnGetByte data val 1323 set oid [expr {$val / 40}] 1324 lappend oid [expr {$val % 40}] 1325 incr length -1 1326 1327 # the next bytes encode the remaining parts of the OID 1328 set bytes [list] 1329 set incomplete 0 1330 while {$length} { 1331 asnGetByte data octet 1332 incr length -1 1333 if {$octet < 128} { 1334 set oidval $octet 1335 set mult 128 1336 foreach byte $bytes { 1337 if {$byte != {}} { 1338 incr oidval [expr {$mult*$byte}] 1339 set mult [expr {$mult*128}] 1340 } 1341 } 1342 lappend oid $oidval 1343 set bytes [list] 1344 set incomplete 0 1345 } else { 1346 set byte [expr {$octet-128}] 1347 set bytes [concat [list $byte] $bytes] 1348 set incomplete 1 1349 } 1350 } 1351 if {$incomplete} { 1352 return -code error "OID Data is incomplete, not enough octets." 1353 } 1354 return 1355} 1356 1357#----------------------------------------------------------------------------- 1358# asnGetContext: Decode an explicit context tag 1359# 1360#----------------------------------------------------------------------------- 1361 1362proc ::asn::asnGetContext {data_var contextNumber_var {content_var {}} {encodingType_var {}}} { 1363 upvar 1 $data_var data $contextNumber_var contextNumber 1364 1365 asnGetByte data tag 1366 asnGetLength data length 1367 1368 if {($tag & 0xC0) != 0x80} { 1369 return -code error \ 1370 [format "Expected Context, but got %02x" $tag] 1371 } 1372 if {$encodingType_var != {}} { 1373 upvar 1 $encodingType_var encodingType 1374 set encodingType [expr {($tag & 0x20) > 0}] 1375 } 1376 set contextNumber [expr {$tag & 0x1F}] 1377 if {[string length $content_var]} { 1378 upvar 1 $content_var content 1379 asnGetBytes data $length content 1380 } 1381 return 1382} 1383 1384 1385#----------------------------------------------------------------------------- 1386# asnGetNumericString: Decode a Numeric String from the data 1387#----------------------------------------------------------------------------- 1388 1389proc ::asn::asnGetNumericString {data_var print_var} { 1390 upvar 1 $data_var data $print_var print 1391 1392 asnGetByte data tag 1393 if {$tag != 0x12} { 1394 return -code error \ 1395 [format "Expected Numeric String (0x12), but got %02x" $tag] 1396 } 1397 asnGetLength data length 1398 asnGetBytes data $length string 1399 set print [encoding convertfrom ascii $string] 1400 return 1401} 1402 1403#----------------------------------------------------------------------------- 1404# asnGetPrintableString: Decode a Printable String from the data 1405#----------------------------------------------------------------------------- 1406 1407proc ::asn::asnGetPrintableString {data_var print_var} { 1408 upvar 1 $data_var data $print_var print 1409 1410 asnGetByte data tag 1411 if {$tag != 0x13} { 1412 return -code error \ 1413 [format "Expected Printable String (0x13), but got %02x" $tag] 1414 } 1415 asnGetLength data length 1416 asnGetBytes data $length string 1417 set print [encoding convertfrom ascii $string] 1418 return 1419} 1420 1421#----------------------------------------------------------------------------- 1422# asnGetIA5String: Decode a IA5(ASCII) String from the data 1423#----------------------------------------------------------------------------- 1424 1425proc ::asn::asnGetIA5String {data_var print_var} { 1426 upvar 1 $data_var data $print_var print 1427 1428 asnGetByte data tag 1429 if {$tag != 0x16} { 1430 return -code error \ 1431 [format "Expected IA5 String (0x16), but got %02x" $tag] 1432 } 1433 asnGetLength data length 1434 asnGetBytes data $length string 1435 set print [encoding convertfrom ascii $string] 1436 return 1437} 1438#------------------------------------------------------------------------ 1439# asnGetBMPString: Decode Basic Multiningval (UCS2 string) from data 1440#------------------------------------------------------------------------ 1441proc asn::asnGetBMPString {data_var print_var} { 1442 upvar 1 $data_var data $print_var print 1443 asnGetByte data tag 1444 if {$tag != 0x1e} { 1445 return -code error \ 1446 [format "Expected BMP String (0x1e), but got %02x" $tag] 1447 } 1448 asnGetLength data length 1449 asnGetBytes data $length string 1450 if {$::tcl_platform(byteOrder) eq "littleEndian"} { 1451 set str2 "" 1452 foreach {hi lo} [split $string ""] { 1453 append str2 $lo $hi 1454 } 1455 } else { 1456 set str2 $string 1457 } 1458 set print [encoding convertfrom unicode $str2] 1459 return 1460} 1461#------------------------------------------------------------------------ 1462# asnGetUTF8String: Decode UTF8 string from data 1463#------------------------------------------------------------------------ 1464proc asn::asnGetUTF8String {data_var print_var} { 1465 upvar 1 $data_var data $print_var print 1466 asnGetByte data tag 1467 if {$tag != 0x0c} { 1468 return -code error \ 1469 [format "Expected UTF8 String (0x0c), but got %02x" $tag] 1470 } 1471 asnGetLength data length 1472 asnGetBytes data $length string 1473 #there should be some error checking to see if input is 1474 #properly-formatted utf8 1475 set print [encoding convertfrom utf-8 $string] 1476 1477 return 1478} 1479#----------------------------------------------------------------------------- 1480# asnGetNull: decode a NULL value 1481#----------------------------------------------------------------------------- 1482 1483proc ::asn::asnGetNull {data_var} { 1484 upvar 1 $data_var data 1485 1486 asnGetByte data tag 1487 if {$tag != 0x05} { 1488 return -code error \ 1489 [format "Expected NULL (0x05), but got %02x" $tag] 1490 } 1491 1492 asnGetLength data length 1493 asnGetBytes data $length bytes 1494 1495 # we do not check the null data, all bytes must be 0x00 1496 1497 return 1498} 1499 1500#---------------------------------------------------------------------------- 1501# MultiType string routines 1502#---------------------------------------------------------------------------- 1503 1504namespace eval asn { 1505 variable stringTypes 1506 array set stringTypes { 1507 12 NumericString 1508 13 PrintableString 1509 16 IA5String 1510 1e BMPString 1511 0c UTF8String 1512 14 T61String 1513 15 VideotexString 1514 1a VisibleString 1515 1b GeneralString 1516 1c UniversalString 1517 } 1518 variable defaultStringType UTF8 1519} 1520#--------------------------------------------------------------------------- 1521# asnGetString - get readable string automatically detecting its type 1522#--------------------------------------------------------------------------- 1523proc ::asn::asnGetString {data_var print_var {type_var {}}} { 1524 variable stringTypes 1525 upvar 1 $data_var data $print_var print 1526 asnPeekByte data tag 1527 set tag [format %02x $tag] 1528 if {![info exists stringTypes($tag)]} { 1529 return -code error "Expected one of string types, but got $tag" 1530 } 1531 asnGet$stringTypes($tag) data print 1532 if {[string length $type_var]} { 1533 upvar $type_var type 1534 set type $stringTypes($tag) 1535 } 1536} 1537#--------------------------------------------------------------------- 1538# defaultStringType - set or query default type for unrestricted strings 1539#--------------------------------------------------------------------- 1540proc ::asn::defaultStringType {{type {}}} { 1541 variable defaultStringType 1542 if {![string length $type]} { 1543 return $defaultStringType 1544 } 1545 if {$type ne "BMP" && $type ne "UTF8"} { 1546 return -code error "Invalid default string type. Should be one of BMP, UTF8" 1547 } 1548 set defaultStringType $type 1549 return 1550} 1551 1552#--------------------------------------------------------------------------- 1553# asnString - encode readable string into most restricted type possible 1554#--------------------------------------------------------------------------- 1555 1556proc ::asn::asnString {string} { 1557 variable nonPrintableChars 1558 variable nonNumericChars 1559 if {[string length $string]!=[string bytelength $string]} { 1560 # There are non-ascii character 1561 variable defaultStringType 1562 return [asn${defaultStringType}String $string] 1563 } elseif {![regexp $nonNumericChars $string]} { 1564 return [asnNumericString $string] 1565 } elseif {![regexp $nonPrintableChars $string]} { 1566 return [asnPrintableString $string] 1567 } else { 1568 return [asnIA5String $string] 1569 } 1570} 1571 1572#----------------------------------------------------------------------------- 1573package provide asn 0.8.3 1574 1575