#-----------------------------------------------------------------------------
# Copyright (C) 1999-2004 Jochen C. Loewer ([email protected])
# Copyright (C) 2004-2007 Michael Schlenker ([email protected])
#-----------------------------------------------------------------------------
#
# A partial ASN decoder/encoder implementation in plain Tcl.
#
# See ASN.1 (X.680) and BER (X.690).
# See 'asn_ber_intro.txt' in this directory.
#
# This software is copyrighted by Jochen C. Loewer ([email protected]). The
# following terms apply to all files associated with the software unless
# explicitly disclaimed in individual files.
#
# The authors hereby grant permission to use, copy, modify, distribute,
# and license this software and its documentation for any purpose, provided
# that existing copyright notices are retained in all copies and that this
# notice is included verbatim in any distributions. No written agreement,
# license, or royalty fee is required for any of the authorized uses.
# Modifications to this software may be copyrighted by their authors
# and need not follow the licensing terms described here, provided that
# the new terms are clearly indicated on the first page of each file where
# they apply.
#
# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
#
# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
# MODIFICATIONS.
#
# written by Jochen Loewer
# 3 June, 1999
#
# $Id: asn.tcl,v 1.19 2008/03/09 21:00:22 mic42 Exp $
#
#-----------------------------------------------------------------------------
# needed for using wide()
package require Tcl 8.4
namespace eval asn {
# Encoder commands
namespace export \
asnSequence \
asnSequenceFromList \
asnSet \
asnSetFromList \
asnApplicationConstr \
asnApplication \
asnContext\
asnContextConstr\
asnChoice \
asnChoiceConstr \
asnInteger \
asnEnumeration \
asnBoolean \
asnOctetString \
asnNull \
asnUTCTime \
asnNumericString \
asnPrintableString \
asnIA5String\
asnBMPString\
asnUTF8String\
asnBitString \
asnObjectIdentifer
# Decoder commands
namespace export \
asnGetResponse \
asnGetInteger \
asnGetEnumeration \
asnGetOctetString \
asnGetSequence \
asnGetSet \
asnGetApplication \
asnGetNumericString \
asnGetPrintableString \
asnGetIA5String \
asnGetBMPString \
asnGetUTF8String \
asnGetObjectIdentifier \
asnGetBoolean \
asnGetUTCTime \
asnGetBitString \
asnGetContext
# general BER utility commands
namespace export \
asnPeekByte \
asnGetLength \
asnRetag \
asnPeekTag \
asnTag
}
#-----------------------------------------------------------------------------
# Implementation notes:
#
# See the 'asn_ber_intro.txt' in this directory for an introduction
# into BER/DER encoding of ASN.1 information. Bibliography information
#
# A Layman's Guide to a Subset of ASN.1, BER, and DER
#
# An RSA Laboratories Technical Note
# Burton S. Kaliski Jr.
# Revised November 1, 1993
#
# Supersedes June 3, 1991 version, which was also published as
# NIST/OSI Implementors' Workshop document SEC-SIG-91-17.
# PKCS documents are available by electronic mail to
# <[email protected]>.
#
# Copyright (C) 1991-1993 RSA Laboratories, a division of RSA
# Data Security, Inc. License to copy this document is granted
# provided that it is identified as "RSA Data Security, Inc.
# Public-Key Cryptography Standards (PKCS)" in all material
# mentioning or referencing this document.
# 003-903015-110-000-000
#
#-----------------------------------------------------------------------------
#-----------------------------------------------------------------------------
# asnLength : Encode some length data. Helper command.
#-----------------------------------------------------------------------------
proc ::asn::asnLength {len} {
if {$len < 0} {
return -code error "Negative length octet requested"
}
if {$len < 128} {
# short form: ISO X.690 8.1.3.4
return [binary format c $len]
}
# long form: ISO X.690 8.1.3.5
# try to use a minimal encoding,
# even if not required by BER, but it is required by DER
# take care for signed vs. unsigned issues
if {$len < 256 } {
return [binary format H2c 81 [expr {$len - 256}]]
}
if {$len < 32769} {
# two octet signed value
return [binary format H2S 82 $len]
}
if {$len < 65536} {
return [binary format H2S 82 [expr {$len - 65536}]]
}
if {$len < 8388608} {
# three octet signed value
return [binary format H2cS 83 [expr {$len >> 16}] [expr {($len & 0xFFFF) - 65536}]]
}
if {$len < 16777216} {
# three octet signed value
return [binary format H2cS 83 [expr {($len >> 16) -256}] [expr {($len & 0xFFFF) -65536}]]
}
if {$len < 2147483649} {
# four octet signed value
return [binary format H2I 84 $len]
}
if {$len < 4294967296} {
# four octet unsigned value
return [binary format H2I 84 [expr {$len - 4294967296}]]
}
if {$len < 1099511627776} {
# five octet unsigned value
return [binary format H2 85][string range [binary format W $len] 3 end]
}
if {$len < 281474976710656} {
# six octet unsigned value
return [binary format H2 86][string range [binary format W $len] 2 end]
}
if {$len < 72057594037927936} {
# seven octet value
return [binary format H2 87][string range [binary format W $len] 1 end]
}
# must be a 64-bit wide signed value
return [binary format H2W 88 $len]
}
#-----------------------------------------------------------------------------
# asnSequence : Assumes that the arguments are already ASN encoded.
#-----------------------------------------------------------------------------
proc ::asn::asnSequence {args} {
asnSequenceFromList $args
}
proc ::asn::asnSequenceFromList {lst} {
# The sequence tag is 0x30. The length is arbitrary and thus full
# length coding is required. The arguments have to be BER encoded
# already. Constructed value, definite-length encoding.
set out ""
foreach part $lst {
append out $part
}
set len [string length $out]
return [binary format H2a*a$len 30 [asnLength $len] $out]
}
#-----------------------------------------------------------------------------
# asnSet : Assumes that the arguments are already ASN encoded.
#-----------------------------------------------------------------------------
proc ::asn::asnSet {args} {
asnSetFromList $args
}
proc ::asn::asnSetFromList {lst} {
# The set tag is 0x31. The length is arbitrary and thus full
# length coding is required. The arguments have to be BER encoded
# already.
set out ""
foreach part $lst {
append out $part
}
set len [string length $out]
return [binary format H2a*a$len 31 [asnLength $len] $out]
}
#-----------------------------------------------------------------------------
# asnApplicationConstr
#-----------------------------------------------------------------------------
proc ::asn::asnApplicationConstr {appNumber args} {
# Packs the arguments into a constructed value with application tag.
set out ""
foreach part $args {
append out $part
}
set code [expr {0x060 + $appNumber}]
set len [string length $out]
return [binary format ca*a$len $code [asnLength $len] $out]
}
#-----------------------------------------------------------------------------
# asnApplication
#-----------------------------------------------------------------------------
proc ::asn::asnApplication {appNumber data} {
# Packs the arguments into a constructed value with application tag.
set code [expr {0x040 + $appNumber}]
set len [string length $data]
return [binary format ca*a$len $code [asnLength $len] $data]
}
#-----------------------------------------------------------------------------
# asnContextConstr
#-----------------------------------------------------------------------------
proc ::asn::asnContextConstr {contextNumber args} {
# Packs the arguments into a constructed value with application tag.
set out ""
foreach part $args {
append out $part
}
set code [expr {0x0A0 + $contextNumber}]
set len [string length $out]
return [binary format ca*a$len $code [asnLength $len] $out]
}
#-----------------------------------------------------------------------------
# asnContext
#-----------------------------------------------------------------------------
proc ::asn::asnContext {contextNumber data} {
# Packs the arguments into a constructed value with application tag.
set code [expr {0x080 + $contextNumber}]
set len [string length $data]
return [binary format ca*a$len $code [asnLength $len] $data]
}
#-----------------------------------------------------------------------------
# asnChoice
#-----------------------------------------------------------------------------
proc ::asn::asnChoice {appNumber args} {
# Packs the arguments into a choice construction.
set out ""
foreach part $args {
append out $part
}
set code [expr {0x080 + $appNumber}]
set len [string length $out]
return [binary format ca*a$len $code [asnLength $len] $out]
}
#-----------------------------------------------------------------------------
# asnChoiceConstr
#-----------------------------------------------------------------------------
proc ::asn::asnChoiceConstr {appNumber args} {
# Packs the arguments into a choice construction.
set out ""
foreach part $args {
append out $part
}
set code [expr {0x0A0 + $appNumber}]
set len [string length $out]
return [binary format ca*a$len $code [asnLength $len] $out]
}
#-----------------------------------------------------------------------------
# asnInteger : Encode integer value.
#-----------------------------------------------------------------------------
proc ::asn::asnInteger {number} {
asnIntegerOrEnum 02 $number
}
#-----------------------------------------------------------------------------
# asnEnumeration : Encode enumeration value.
#-----------------------------------------------------------------------------
proc ::asn::asnEnumeration {number} {
asnIntegerOrEnum 0a $number
}
#-----------------------------------------------------------------------------
# asnIntegerOrEnum : Common code for Integers and Enumerations
# No Bignum version, as we do not expect large Enums.
#-----------------------------------------------------------------------------
proc ::asn::asnIntegerOrEnum {tag number} {
# The integer tag is 0x02 , the Enum Tag 0x0a otherwise identical.
# The length is 1, 2, 3, or 4, coded in a
# single byte. This can be done directly, no need to go through
# asnLength. The value itself is written in big-endian.
# Known bug/issue: The command cannot handle very wide integers, i.e.
# anything above 8 bytes length. Use asnBignumInteger for those.
# check if we really have an int
set num $number
incr num
if {($number >= -128) && ($number < 128)} {
return [binary format H2H2c $tag 01 $number]
}
if {($number >= -32768) && ($number < 32768)} {
return [binary format H2H2S $tag 02 $number]
}
if {($number >= -8388608) && ($number < 8388608)} {
set numberb [expr {$number & 0xFFFF}]
set numbera [expr {($number >> 16) & 0xFF}]
return [binary format H2H2cS $tag 03 $numbera $numberb]
}
if {($number >= -2147483648) && ($number < 2147483648)} {
return [binary format H2H2I $tag 04 $number]
}
if {($number >= -549755813888) && ($number < 549755813888)} {
set numberb [expr {$number & 0xFFFFFFFF}]
set numbera [expr {($number >> 32) & 0xFF}]
return [binary format H2H2cI $tag 05 $numbera $numberb]
}
if {($number >= -140737488355328) && ($number < 140737488355328)} {
set numberb [expr {$number & 0xFFFFFFFF}]
set numbera [expr {($number >> 32) & 0xFFFF}]
return [binary format H2H2SI $tag 06 $numbera $numberb]
}
if {($number >= -36028797018963968) && ($number < 36028797018963968)} {
set numberc [expr {$number & 0xFFFFFFFF}]
set numberb [expr {($number >> 32) & 0xFFFF}]
set numbera [expr {($number >> 48) & 0xFF}]
return [binary format H2H2cSI $tag 07 $numbera $numberb $numberc]
}
if {($number >= -9223372036854775808) && ($number <= 9223372036854775807)} {
return [binary format H2H2W $tag 08 $number]
}
return -code error "Integer value to large to encode, use asnBigInteger"
}
#-----------------------------------------------------------------------------
# asnBigInteger : Encode a long integer value using math::bignum
#-----------------------------------------------------------------------------
proc ::asn::asnBigInteger {bignum} {
# require math::bignum only if it is used
package require math::bignum
# this is a hack to check for bignum...
if {[llength $bignum] < 2 || ([lindex $bignum 0] ne "bignum")} {
return -code error "expected math::bignum value got \"$bignum\""
}
if {[math::bignum::sign $bignum]} {
# generate two's complement form
set bits [math::bignum::bits $bignum]
set padding [expr {$bits % 8}]
set len [expr {int(ceil($bits / 8.0))}]
if {$padding == 0} {
# we need a complete extra byte for the sign
# unless this is a base 2 multiple
set test [math::bignum::fromstr 0]
math::bignum::setbit test [expr {$bits-1}]
if {[math::bignum::ne [math::bignum::abs $bignum] $test]} {
incr len
}
}
set exp [math::bignum::pow \
[math::bignum::fromstr 256] \
[math::bignum::fromstr $len]]
set bignum [math::bignum::add $bignum $exp]
set hex [math::bignum::tostr $bignum 16]
} else {
set bits [math::bignum::bits $bignum]
if {($bits % 8) == 0 && $bits > 0} {
set pad "00"
} else {
set pad ""
}
set hex $pad[math::bignum::tostr $bignum 16]
}
if {[string length $hex]%2} {
set hex "0$hex"
}
set octets [expr {(([string length $hex]+1)/2)}]
return [binary format H2a*H* 02 [asnLength $octets] $hex]
}
#-----------------------------------------------------------------------------
# asnBoolean : Encode a boolean value.
#-----------------------------------------------------------------------------
proc ::asn::asnBoolean {bool} {
# The boolean tag is 0x01. The length is always 1, coded in
# a single byte. This can be done directly, no need to go through
# asnLength. The value itself is written in big-endian.
return [binary format H2H2c 01 01 [expr {$bool ? 0x0FF : 0x0}]]
}
#-----------------------------------------------------------------------------
# asnOctetString : Encode a string of arbitrary bytes
#-----------------------------------------------------------------------------
proc ::asn::asnOctetString {string} {
# The octet tag is 0x04. The length is arbitrary, so we need
# 'asnLength' for full coding of the length.
set len [string length $string]
return [binary format H2a*a$len 04 [asnLength $len] $string]
}
#-----------------------------------------------------------------------------
# asnNull : Encode a null value
#-----------------------------------------------------------------------------
proc ::asn::asnNull {} {
# Null has only one valid encoding
return \x05\x00
}
#-----------------------------------------------------------------------------
# asnBitstring : Encode a Bit String value
#-----------------------------------------------------------------------------
proc ::asn::asnBitString {bitstring} {
# The bit string tag is 0x03.
# Bit strings can be either simple or constructed
# we always use simple encoding
set bitlen [string length $bitstring]
set padding [expr {(8 - ($bitlen % 8)) % 8}]
set len [expr {($bitlen / 8) + 1}]
if {$padding != 0} { incr len }
return [binary format H2a*cB* 03 [asnLength $len] $padding $bitstring]
}
#-----------------------------------------------------------------------------
# asnUTCTime : Encode an UTC time string
#-----------------------------------------------------------------------------
proc ::asn::asnUTCTime {UTCtimestring} {
# the utc time tag is 0x17.
#
# BUG: we do not check the string for well formedness
set ascii [encoding convertto ascii $UTCtimestring]
set len [string length $ascii]
return [binary format H2a*a* 17 [asnLength $len] $ascii]
}
#-----------------------------------------------------------------------------
# asnPrintableString : Encode a printable string
#-----------------------------------------------------------------------------
namespace eval asn {
variable nonPrintableChars {[^ A-Za-z0-9'()+,.:/?=-]}
}
proc ::asn::asnPrintableString {string} {
# the printable string tag is 0x13
variable nonPrintableChars
# it is basically a restricted ascii string
if {[regexp $nonPrintableChars $string ]} {
return -code error "Illegal character in PrintableString."
}
# check characters
set ascii [encoding convertto ascii $string]
return [asnEncodeString 13 $ascii]
}
#-----------------------------------------------------------------------------
# asnIA5String : Encode an Ascii String
#-----------------------------------------------------------------------------
proc ::asn::asnIA5String {string} {
# the IA5 string tag is 0x16
# check for extended charachers
if {[string length $string]!=[string bytelength $string]} {
return -code error "Illegal character in IA5String"
}
set ascii [encoding convertto ascii $string]
return [asnEncodeString 16 $ascii]
}
#-----------------------------------------------------------------------------
# asnNumericString : Encode a Numeric String type
#-----------------------------------------------------------------------------
namespace eval asn {
variable nonNumericChars {[^0-9 ]}
}
proc ::asn::asnNumericString {string} {
# the Numeric String type has tag 0x12
variable nonNumericChars
if {[regexp $nonNumericChars $string]} {
return -code error "Illegal character in Numeric String."
}
return [asnEncodeString 12 $string]
}
#----------------------------------------------------------------------
# asnBMPString: Encode a Tcl string as Basic Multinligval (UCS2) string
#-----------------------------------------------------------------------
proc asn::asnBMPString {string} {
if {$::tcl_platform(byteOrder) eq "littleEndian"} {
set bytes ""
foreach {lo hi} [split [encoding convertto unicode $string] ""] {
append bytes $hi $lo
}
} else {
set bytes [encoding convertto unicode $string]
}
return [asnEncodeString 1e $bytes]
}
#---------------------------------------------------------------------------
# asnUTF8String: encode tcl string as UTF8 String
#----------------------------------------------------------------------------
proc asn::asnUTF8String {string} {
return [asnEncodeString 0c [encoding convertto utf-8 $string]]
}
#-----------------------------------------------------------------------------
# asnEncodeString : Encode an RestrictedCharacter String
#-----------------------------------------------------------------------------
proc ::asn::asnEncodeString {tag string} {
set len [string length $string]
return [binary format H2a*a$len $tag [asnLength $len] $string]
}
#-----------------------------------------------------------------------------
# asnObjectIdentifier : Encode an Object Identifier value
#-----------------------------------------------------------------------------
proc ::asn::asnObjectIdentifier {oid} {
# the object identifier tag is 0x06
if {[llength $oid] < 2} {
return -code error "OID must have at least two subidentifiers."
}
# basic check that it is valid
foreach identifier $oid {
if {$identifier < 0} {
return -code error \
"Malformed OID. Identifiers must be positive Integers."
}
}
if {[lindex $oid 0] > 2} {
return -code error "First subidentifier must be 0,1 or 2"
}
if {[lindex $oid 1] > 39} {
return -code error \
"Second subidentifier must be between 0 and 39"
}
# handle the special cases directly
switch [llength $oid] {
2 { return [binary format H2H2c 06 01 \
[expr {[lindex $oid 0]*40+[lindex $oid 1]}]] }
default {
# This can probably be written much shorter.
# Just a first try that works...
#
set octets [binary format c \
[expr {[lindex $oid 0]*40+[lindex $oid 1]}]]
foreach identifier [lrange $oid 2 end] {
set d 128
if {$identifier < 128} {
set subidentifier [list $identifier]
} else {
set subidentifier [list]
# find the largest divisor
while {($identifier / $d) >= 128} {
set d [expr {$d * 128}]
}
# and construct the subidentifiers
set remainder $identifier
while {$d >= 128} {
set coefficient [expr {($remainder / $d) | 0x80}]
set remainder [expr {$remainder % $d}]
set d [expr {$d / 128}]
lappend subidentifier $coefficient
}
lappend subidentifier $remainder
}
append octets [binary format c* $subidentifier]
}
return [binary format H2a*a* 06 \
[asnLength [string length $octets]] $octets]
}
}
}
#-----------------------------------------------------------------------------
# asnGetResponse : Read a ASN response from a channel.
#-----------------------------------------------------------------------------
proc ::asn::asnGetResponse {sock data_var} {
upvar 1 $data_var data
# We expect a sequence here (tag 0x30). The code below is an
# inlined replica of 'asnGetSequence', modified for reading from a
# channel instead of a string.
set tag [read $sock 1]
if {$tag == "\x30"} {
# The following code is a replica of 'asnGetLength', modified
# for reading the bytes from the channel instead of a string.
set len1 [read $sock 1]
binary scan $len1 c num
set length [expr {($num + 0x100) % 0x100}]
if {$length >= 0x080} {
# The byte the read is not the length, but a prefix, and
# the lower nibble tells us how many bytes follow.
set len_length [expr {$length & 0x7f}]
# BUG: We should not perform the value extraction for an
# BUG: improper length. It wastes cycles, and here it can
# BUG: cause us trouble, reading more data than there is
# BUG: on the channel. Depending on the channel
# BUG: configuration an attacker can induce us to block,
# BUG: causing a denial of service.
set lengthBytes [read $sock $len_length]
switch $len_length {
1 {
binary scan $lengthBytes c length
set length [expr {($length + 0x100) % 0x100}]
}
2 { binary scan $lengthBytes S length }
3 { binary scan \x00$lengthBytes I length }
4 { binary scan $lengthBytes I length }
default {
return -code error \
"length information too long ($len_length)"
}
}
}
# Now that the length is known we get the remainder,
# i.e. payload, and construct proper in-memory BER encoded
# sequence.
set rest [read $sock $length]
set data [binary format aa*a$length $tag [asnLength $length] $rest]
} else {
# Generate an error message if the data is not a sequence as
# we expected.
set tag_hex ""
binary scan $tag H2 tag_hex
return -code error "unknown start tag [string length $tag] $tag_hex"
}
}
if {[package vsatisfies [package present Tcl] 8.5.0]} {
##############################################################################
# Code for 8.5
##############################################################################
#-----------------------------------------------------------------------------
# asnGetByte (8.5 version) : Retrieve a single byte from the data (unsigned)
#-----------------------------------------------------------------------------
proc ::asn::asnGetByte {data_var byte_var} {
upvar 1 $data_var data $byte_var byte
binary scan [string index $data 0] cu byte
set data [string range $data 1 end]
return
}
#-----------------------------------------------------------------------------
# asnPeekByte (8.5 version) : Retrieve a single byte from the data (unsigned)
# without removing it.
#-----------------------------------------------------------------------------
proc ::asn::asnPeekByte {data_var byte_var {offset 0}} {
upvar 1 $data_var data $byte_var byte
binary scan [string index $data $offset] cu byte
return
}
#-----------------------------------------------------------------------------
# asnGetLength (8.5 version) : Decode an ASN length value (See notes)
#-----------------------------------------------------------------------------
proc ::asn::asnGetLength {data_var length_var} {
upvar 1 $data_var data $length_var length
asnGetByte data length
if {$length == 0x080} {
return -code error "Indefinite length BER encoding not yet supported"
}
if {$length > 0x080} {
# The retrieved byte is a prefix value, and the integer in the
# lower nibble tells us how many bytes were used to encode the
# length data following immediately after this prefix.
set len_length [expr {$length & 0x7f}]
if {[string length $data] < $len_length} {
return -code error \
"length information invalid, not enough octets left"
}
asnGetBytes data $len_length lengthBytes
switch $len_length {
1 { binary scan $lengthBytes cu length }
2 { binary scan $lengthBytes Su length }
3 { binary scan \x00$lengthBytes Iu length }
4 { binary scan $lengthBytes Iu length }
default {
binary scan $lengthBytes H* hexstr
scan $hexstr %llx length
}
}
}
return
}
} else {
##############################################################################
# Code for Tcl 8.4
##############################################################################
#-----------------------------------------------------------------------------
# asnGetByte : Retrieve a single byte from the data (unsigned)
#-----------------------------------------------------------------------------
proc ::asn::asnGetByte {data_var byte_var} {
upvar 1 $data_var data $byte_var byte
binary scan [string index $data 0] c byte
set byte [expr {($byte + 0x100) % 0x100}]
set data [string range $data 1 end]
return
}
#-----------------------------------------------------------------------------
# asnPeekByte : Retrieve a single byte from the data (unsigned)
# without removing it.
#-----------------------------------------------------------------------------
proc ::asn::asnPeekByte {data_var byte_var {offset 0}} {
upvar 1 $data_var data $byte_var byte
binary scan [string index $data $offset] c byte
set byte [expr {($byte + 0x100) % 0x100}]
return
}
#-----------------------------------------------------------------------------
# asnGetLength : Decode an ASN length value (See notes)
#-----------------------------------------------------------------------------
proc ::asn::asnGetLength {data_var length_var} {
upvar 1 $data_var data $length_var length
asnGetByte data length
if {$length == 0x080} {
return -code error "Indefinite length BER encoding not yet supported"
}
if {$length > 0x080} {
# The retrieved byte is a prefix value, and the integer in the
# lower nibble tells us how many bytes were used to encode the
# length data following immediately after this prefix.
set len_length [expr {$length & 0x7f}]
if {[string length $data] < $len_length} {
return -code error \
"length information invalid, not enough octets left"
}
asnGetBytes data $len_length lengthBytes
switch $len_length {
1 {
# Efficiently coded data will not go through this
# path, as small length values can be coded directly,
# without a prefix.
binary scan $lengthBytes c length
set length [expr {($length + 0x100) % 0x100}]
}
2 { binary scan $lengthBytes S length
set length [expr {($length + 0x10000) % 0x10000}]
}
3 { binary scan \x00$lengthBytes I length
set length [expr {($length + 0x1000000) % 0x1000000}]
}
4 { binary scan $lengthBytes I length
set length [expr {(wide($length) + 0x100000000) % 0x100000000}]
}
default {
binary scan $lengthBytes H* hexstr
# skip leading zeros which are allowed by BER
set hexlen [string trimleft $hexstr 0]
# check if it fits into a 64-bit signed integer
if {[string length $hexlen] > 16} {
return -code error -errorcode {ARITH IOVERFLOW
{Length value too large for normal use, try asnGetBigLength}} \
"Length value to large"
} elseif { [string length $hexlen] == 16 \
&& ([string index $hexlen 0] & 0x8)} {
# check most significant bit, if set we need bignum
return -code error -errorcode {ARITH IOVERFLOW
{Length value too large for normal use, try asnGetBigLength}} \
"Length value to large"
} else {
scan $hexstr "%lx" length
}
}
}
}
return
}
}
#-----------------------------------------------------------------------------
# asnRetag: Remove an explicit tag with the real newTag
#
#-----------------------------------------------------------------------------
proc ::asn::asnRetag {data_var newTag} {
upvar 1 $data_var data
set tag ""
set type ""
set len [asnPeekTag data tag type dummy]
asnGetBytes data $len tagbytes
set data [binary format c* $newTag]$data
}
#-----------------------------------------------------------------------------
# asnGetBytes : Retrieve a block of 'length' bytes from the data.
#-----------------------------------------------------------------------------
proc ::asn::asnGetBytes {data_var length bytes_var} {
upvar 1 $data_var data $bytes_var bytes
incr length -1
set bytes [string range $data 0 $length]
incr length
set data [string range $data $length end]
return
}
#-----------------------------------------------------------------------------
# asnPeekTag : Decode the tag value
#-----------------------------------------------------------------------------
proc ::asn::asnPeekTag {data_var tag_var tagtype_var constr_var} {
upvar 1 $data_var data $tag_var tag $tagtype_var tagtype $constr_var constr
set type 0
set offset 0
asnPeekByte data type $offset
# check if we have a simple tag, < 31, which fits in one byte
set tval [expr {$type & 0x1f}]
if {$tval == 0x1f} {
# long tag, max 64-bit with Tcl 8.4, unlimited with 8.5 bignum
asnPeekByte data tagbyte [incr offset]
set tval [expr {wide($tagbyte & 0x7f)}]
while {($tagbyte & 0x80)} {
asnPeekByte data tagbyte [incr offset]
set tval [expr {($tval << 7) + ($tagbyte & 0x7f)}]
}
}
set tagtype [lindex {UNIVERSAL APPLICATION CONTEXT PRIVATE} \
[expr {($type & 0xc0) >>6}]]
set tag $tval
set constr [expr {($type & 0x20) > 0}]
return [incr offset]
}
#-----------------------------------------------------------------------------
# asnTag : Build a tag value
#-----------------------------------------------------------------------------
proc ::asn::asnTag {tagnumber {class UNIVERSAL} {tagstyle P}} {
set first 0
if {$tagnumber < 31} {
# encode everything in one byte
set first $tagnumber
set bytes [list]
} else {
# multi-byte tag
set first 31
set bytes [list [expr {$tagnumber & 0x7f}]]
set tagnumber [expr {$tagnumber >> 7}]
while {$tagnumber > 0} {
lappend bytes [expr {($tagnumber & 0x7f)+0x80}]
set tagnumber [expr {$tagnumber >>7}]
}
}
if {$tagstyle eq "C" || $tagstyle == 1 } {incr first 32}
switch -glob -- $class {
U* { ;# UNIVERSAL }
A* { incr first 64 ;# APPLICATION }
C* { incr first 128 ;# CONTEXT }
P* { incr first 192 ;# PRIVATE }
default {
return -code error "Unknown tag class \"$class\""
}
}
if {[llength $bytes] > 0} {
# long tag
set rbytes [list]
for {set i [expr {[llength $bytes]-1}]} {$i >= 0} {incr i -1} {
lappend rbytes [lindex $bytes $i]
}
return [binary format cc* $first $rbytes ]
}
return [binary format c $first]
}
#-----------------------------------------------------------------------------
# asnGetBigLength : Retrieve a length that can not be represented in 63-bit
#-----------------------------------------------------------------------------
proc ::asn::asnGetBigLength {data_var biglength_var} {
# Does any real world code really need this?
# If we encounter this, we are doomed to fail anyway,
# (there would be an Exabyte inside the data_var, )
#
# So i implement it just for completness.
#
package require math::bignum
upvar 1 $data_var data $biglength_var length
asnGetByte data length
if {$length == 0x080} {
return -code error "Indefinite length BER encoding not yet supported"
}
if {$length > 0x080} {
# The retrieved byte is a prefix value, and the integer in the
# lower nibble tells us how many bytes were used to encode the
# length data following immediately after this prefix.
set len_length [expr {$length & 0x7f}]
if {[string length $data] < $len_length} {
return -code error \
"length information invalid, not enough octets left"
}
asnGetBytes data $len_length lengthBytes
binary scan $lengthBytes H* hexlen
set length [math::bignum::fromstr $hexlen 16]
}
return
}
#-----------------------------------------------------------------------------
# asnGetInteger : Retrieve integer.
#-----------------------------------------------------------------------------
proc ::asn::asnGetInteger {data_var int_var} {
# Tag is 0x02.
upvar 1 $data_var data $int_var int
asnGetByte data tag
if {$tag != 0x02} {
return -code error \
[format "Expected Integer (0x02), but got %02x" $tag]
}
asnGetLength data len
asnGetBytes data $len integerBytes
set int ?
switch $len {
1 { binary scan $integerBytes c int }
2 { binary scan $integerBytes S int }
3 {
# check for negative int and pad
scan [string index $integerBytes 0] %c byte
if {$byte & 128} {
binary scan \xff$integerBytes I int
} else {
binary scan \x00$integerBytes I int
}
}
4 { binary scan $integerBytes I int }
5 -
6 -
7 -
8 {
# check for negative int and pad
scan [string index $integerBytes 0] %c byte
if {$byte & 128} {
set pad [string repeat \xff [expr {8-$len}]]
} else {
set pad [string repeat \x00 [expr {8-$len}]]
}
binary scan $pad$integerBytes W int
}
default {
# Too long, or prefix coding was used.
return -code error "length information too long"
}
}
return
}
#-----------------------------------------------------------------------------
# asnGetBigInteger : Retrieve a big integer.
#-----------------------------------------------------------------------------
proc ::asn::asnGetBigInteger {data_var bignum_var} {
# require math::bignum only if it is used
package require math::bignum
# Tag is 0x02. We expect that the length of the integer is coded with
# maximal efficiency, i.e. without a prefix 0x81 prefix. If a prefix
# is used this decoder will fail.
upvar 1 $data_var data $bignum_var bignum
asnGetByte data tag
if {$tag != 0x02} {
return -code error \
[format "Expected Integer (0x02), but got %02x" $tag]
}
asnGetLength data len
asnGetBytes data $len integerBytes
binary scan $integerBytes H* hex
set bignum [math::bignum::fromstr $hex 16]
set bits [math::bignum::bits $bignum]
set exp [math::bignum::pow \
[math::bignum::fromstr 2] \
[math::bignum::fromstr $bits]]
set big [math::bignum::sub $bignum $exp]
set bignum $big
return
}
#-----------------------------------------------------------------------------
# asnGetEnumeration : Retrieve an enumeration id
#-----------------------------------------------------------------------------
proc ::asn::asnGetEnumeration {data_var enum_var} {
# This is like 'asnGetInteger', except for a different tag.
upvar 1 $data_var data $enum_var enum
asnGetByte data tag
if {$tag != 0x0a} {
return -code error \
[format "Expected Enumeration (0x0a), but got %02x" $tag]
}
asnGetLength data len
asnGetBytes data $len integerBytes
set enum ?
switch $len {
1 { binary scan $integerBytes c enum }
2 { binary scan $integerBytes S enum }
3 { binary scan \x00$integerBytes I enum }
4 { binary scan $integerBytes I enum }
default {
return -code error "length information too long"
}
}
return
}
#-----------------------------------------------------------------------------
# asnGetOctetString : Retrieve arbitrary string.
#-----------------------------------------------------------------------------
proc ::asn::asnGetOctetString {data_var string_var} {
# Here we need the full decoder for length data.
upvar 1 $data_var data $string_var string
asnGetByte data tag
if {$tag != 0x04} {
return -code error \
[format "Expected Octet String (0x04), but got %02x" $tag]
}
asnGetLength data length
asnGetBytes data $length temp
set string $temp
return
}
#-----------------------------------------------------------------------------
# asnGetSequence : Retrieve Sequence data for further decoding.
#-----------------------------------------------------------------------------
proc ::asn::asnGetSequence {data_var sequence_var} {
# Here we need the full decoder for length data.
upvar 1 $data_var data $sequence_var sequence
asnGetByte data tag
if {$tag != 0x030} {
return -code error \
[format "Expected Sequence (0x30), but got %02x" $tag]
}
asnGetLength data length
asnGetBytes data $length temp
set sequence $temp
return
}
#-----------------------------------------------------------------------------
# asnGetSet : Retrieve Set data for further decoding.
#-----------------------------------------------------------------------------
proc ::asn::asnGetSet {data_var set_var} {
# Here we need the full decoder for length data.
upvar 1 $data_var data $set_var set
asnGetByte data tag
if {$tag != 0x031} {
return -code error \
[format "Expected Set (0x31), but got %02x" $tag]
}
asnGetLength data length
asnGetBytes data $length temp
set set $temp
return
}
#-----------------------------------------------------------------------------
# asnGetApplication
#-----------------------------------------------------------------------------
proc ::asn::asnGetApplication {data_var appNumber_var {content_var {}} {encodingType_var {}} } {
upvar 1 $data_var data $appNumber_var appNumber
asnGetByte data tag
asnGetLength data length
if {($tag & 0xC0) != 0x40} {
return -code error \
[format "Expected Application, but got %02x" $tag]
}
if {$encodingType_var != {}} {
upvar 1 $encodingType_var encodingType
set encodingType [expr {($tag & 0x20) > 0}]
}
set appNumber [expr {$tag & 0x1F}]
if {[string length $content_var]} {
upvar 1 $content_var content
asnGetBytes data $length content
}
return
}
#-----------------------------------------------------------------------------
# asnGetBoolean: decode a boolean value
#-----------------------------------------------------------------------------
proc asn::asnGetBoolean {data_var bool_var} {
upvar 1 $data_var data $bool_var bool
asnGetByte data tag
if {$tag != 0x01} {
return -code error \
[format "Expected Boolean (0x01), but got %02x" $tag]
}
asnGetLength data length
asnGetByte data byte
set bool [expr {$byte == 0 ? 0 : 1}]
return
}
#-----------------------------------------------------------------------------
# asnGetUTCTime: Extract an UTC Time string from the data. Returns a string
# representing an UTC Time.
#
#-----------------------------------------------------------------------------
proc asn::asnGetUTCTime {data_var utc_var} {
upvar 1 $data_var data $utc_var utc
asnGetByte data tag
if {$tag != 0x17} {
return -code error \
[format "Expected UTCTime (0x17), but got %02x" $tag]
}
asnGetLength data length
asnGetBytes data $length bytes
# this should be ascii, make it explicit
set bytes [encoding convertfrom ascii $bytes]
binary scan $bytes a* utc
return
}
#-----------------------------------------------------------------------------
# asnGetBitString: Extract a Bit String value (a string of 0/1s) from the
# ASN.1 data.
#
#-----------------------------------------------------------------------------
proc asn::asnGetBitString {data_var bitstring_var} {
upvar 1 $data_var data $bitstring_var bitstring
asnGetByte data tag
if {$tag != 0x03} {
return -code error \
[format "Expected Bit String (0x03), but got %02x" $tag]
}
asnGetLength data length
# get the number of padding bits used at the end
asnGetByte data padding
incr length -1
asnGetBytes data $length bytes
binary scan $bytes B* bits
# cut off the padding bits
set bits [string range $bits 0 end-$padding]
set bitstring $bits
}
#-----------------------------------------------------------------------------
# asnGetObjectIdentifier: Decode an ASN.1 Object Identifier (OID) into
# a Tcl list of integers.
#-----------------------------------------------------------------------------
proc asn::asnGetObjectIdentifier {data_var oid_var} {
upvar 1 $data_var data $oid_var oid
asnGetByte data tag
if {$tag != 0x06} {
return -code error \
[format "Expected Object Identifier (0x06), but got %02x" $tag]
}
asnGetLength data length
# the first byte encodes the OID parts in position 0 and 1
asnGetByte data val
set oid [expr {$val / 40}]
lappend oid [expr {$val % 40}]
incr length -1
# the next bytes encode the remaining parts of the OID
set bytes [list]
set incomplete 0
while {$length} {
asnGetByte data octet
incr length -1
if {$octet < 128} {
set oidval $octet
set mult 128
foreach byte $bytes {
if {$byte != {}} {
incr oidval [expr {$mult*$byte}]
set mult [expr {$mult*128}]
}
}
lappend oid $oidval
set bytes [list]
set incomplete 0
} else {
set byte [expr {$octet-128}]
set bytes [concat [list $byte] $bytes]
set incomplete 1
}
}
if {$incomplete} {
return -code error "OID Data is incomplete, not enough octets."
}
return
}
#-----------------------------------------------------------------------------
# asnGetContext: Decode an explicit context tag
#
#-----------------------------------------------------------------------------
proc ::asn::asnGetContext {data_var contextNumber_var {content_var {}} {encodingType_var {}}} {
upvar 1 $data_var data $contextNumber_var contextNumber
asnGetByte data tag
asnGetLength data length
if {($tag & 0xC0) != 0x80} {
return -code error \
[format "Expected Context, but got %02x" $tag]
}
if {$encodingType_var != {}} {
upvar 1 $encodingType_var encodingType
set encodingType [expr {($tag & 0x20) > 0}]
}
set contextNumber [expr {$tag & 0x1F}]
if {[string length $content_var]} {
upvar 1 $content_var content
asnGetBytes data $length content
}
return
}
#-----------------------------------------------------------------------------
# asnGetNumericString: Decode a Numeric String from the data
#-----------------------------------------------------------------------------
proc ::asn::asnGetNumericString {data_var print_var} {
upvar 1 $data_var data $print_var print
asnGetByte data tag
if {$tag != 0x12} {
return -code error \
[format "Expected Numeric String (0x12), but got %02x" $tag]
}
asnGetLength data length
asnGetBytes data $length string
set print [encoding convertfrom ascii $string]
return
}
#-----------------------------------------------------------------------------
# asnGetPrintableString: Decode a Printable String from the data
#-----------------------------------------------------------------------------
proc ::asn::asnGetPrintableString {data_var print_var} {
upvar 1 $data_var data $print_var print
asnGetByte data tag
if {$tag != 0x13} {
return -code error \
[format "Expected Printable String (0x13), but got %02x" $tag]
}
asnGetLength data length
asnGetBytes data $length string
set print [encoding convertfrom ascii $string]
return
}
#-----------------------------------------------------------------------------
# asnGetIA5String: Decode a IA5(ASCII) String from the data
#-----------------------------------------------------------------------------
proc ::asn::asnGetIA5String {data_var print_var} {
upvar 1 $data_var data $print_var print
asnGetByte data tag
if {$tag != 0x16} {
return -code error \
[format "Expected IA5 String (0x16), but got %02x" $tag]
}
asnGetLength data length
asnGetBytes data $length string
set print [encoding convertfrom ascii $string]
return
}
#------------------------------------------------------------------------
# asnGetBMPString: Decode Basic Multiningval (UCS2 string) from data
#------------------------------------------------------------------------
proc asn::asnGetBMPString {data_var print_var} {
upvar 1 $data_var data $print_var print
asnGetByte data tag
if {$tag != 0x1e} {
return -code error \
[format "Expected BMP String (0x1e), but got %02x" $tag]
}
asnGetLength data length
asnGetBytes data $length string
if {$::tcl_platform(byteOrder) eq "littleEndian"} {
set str2 ""
foreach {hi lo} [split $string ""] {
append str2 $lo $hi
}
} else {
set str2 $string
}
set print [encoding convertfrom unicode $str2]
return
}
#------------------------------------------------------------------------
# asnGetUTF8String: Decode UTF8 string from data
#------------------------------------------------------------------------
proc asn::asnGetUTF8String {data_var print_var} {
upvar 1 $data_var data $print_var print
asnGetByte data tag
if {$tag != 0x0c} {
return -code error \
[format "Expected UTF8 String (0x0c), but got %02x" $tag]
}
asnGetLength data length
asnGetBytes data $length string
#there should be some error checking to see if input is
#properly-formatted utf8
set print [encoding convertfrom utf-8 $string]
return
}
#-----------------------------------------------------------------------------
# asnGetNull: decode a NULL value
#-----------------------------------------------------------------------------
proc ::asn::asnGetNull {data_var} {
upvar 1 $data_var data
asnGetByte data tag
if {$tag != 0x05} {
return -code error \
[format "Expected NULL (0x05), but got %02x" $tag]
}
asnGetLength data length
asnGetBytes data $length bytes
# we do not check the null data, all bytes must be 0x00
return
}
#----------------------------------------------------------------------------
# MultiType string routines
#----------------------------------------------------------------------------
namespace eval asn {
variable stringTypes
array set stringTypes {
12 NumericString
13 PrintableString
16 IA5String
1e BMPString
0c UTF8String
14 T61String
15 VideotexString
1a VisibleString
1b GeneralString
1c UniversalString
}
variable defaultStringType UTF8
}
#---------------------------------------------------------------------------
# asnGetString - get readable string automatically detecting its type
#---------------------------------------------------------------------------
proc ::asn::asnGetString {data_var print_var {type_var {}}} {
variable stringTypes
upvar 1 $data_var data $print_var print
asnPeekByte data tag
set tag [format %02x $tag]
if {![info exists stringTypes($tag)]} {
return -code error "Expected one of string types, but got $tag"
}
asnGet$stringTypes($tag) data print
if {[string length $type_var]} {
upvar $type_var type
set type $stringTypes($tag)
}
}
#---------------------------------------------------------------------
# defaultStringType - set or query default type for unrestricted strings
#---------------------------------------------------------------------
proc ::asn::defaultStringType {{type {}}} {
variable defaultStringType
if {![string length $type]} {
return $defaultStringType
}
if {$type ne "BMP" && $type ne "UTF8"} {
return -code error "Invalid default string type. Should be one of BMP, UTF8"
}
set defaultStringType $type
return
}
#---------------------------------------------------------------------------
# asnString - encode readable string into most restricted type possible
#---------------------------------------------------------------------------
proc ::asn::asnString {string} {
variable nonPrintableChars
variable nonNumericChars
if {[string length $string]!=[string bytelength $string]} {
# There are non-ascii character
variable defaultStringType
return [asn${defaultStringType}String $string]
} elseif {![regexp $nonNumericChars $string]} {
return [asnNumericString $string]
} elseif {![regexp $nonPrintableChars $string]} {
return [asnPrintableString $string]
} else {
return [asnIA5String $string]
}
}
#-----------------------------------------------------------------------------
package provide asn 0.8.3
