tcl_tests/asn.tcl

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