#-----------------------------------------------------------------------------
#   Copyright (C) 1999-2004 Jochen C. Loewer (loewerj@web.de)
#   Copyright (C) 2004,2005 Michael Schlenker (mic42@users.sourceforge.net)
#-----------------------------------------------------------------------------
#   
#   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 (loewerj@web.de). 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.7 2005/02/15 17:50:21 mic42 Exp $
#
#-----------------------------------------------------------------------------

package require log

# needed for using wide()
package require Tcl 8.4

namespace eval asn {
    # Encoder commands
    namespace export \
        asnSequence \
        asnSet \
        asnApplicationConstr \
        asnApplication \
        asnChoice \
        asnChoiceConstr \
        asnInteger \
        asnEnumeration \
        asnBoolean \
        asnOctetString \
        asnUTCTime \
        asnPrintableString \
        asnBitString \
        asnObjectIdentifer \
        asnNumericString \
        asnIA5String
        
    # Decoder commands
    namespace export \
        asnGetResponse \
        asnGetInteger \
        asnGetEnumeration \
        asnGetOctetString \
        asnGetSequence \
        asnGetSet \
        asnGetApplication \
        asnGetPrintableString \
        asnGetIA5String \
        asnGetObjectIdentifier \
        asnGetBoolean \
        asnGetUTCTime \
        asnGetBitString \
        asnGetContext 
}

#-----------------------------------------------------------------------------
# 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
#   <pkcs@rsa.com>.
#
#   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} {
    # 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 $args {
        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} {
    # 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 $args {
        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]
}

#-----------------------------------------------------------------------------
# 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*B* 03 [asnLength $len] $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
#-----------------------------------------------------------------------------
proc ::asn::asnPrintableString {string} {
    # the printable string tag is 0x13
    # it is basically a restricted ascii string
    if {[regexp {[^A-Za-z0-9'()+,.:/?=-]} $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
    
    set ascii [encoding convertto ascii $string]
    return [asnEncodeString 16 $ascii]
}

#-----------------------------------------------------------------------------
# asnNumericString : Encode a Numeric String type
#-----------------------------------------------------------------------------

proc ::asn::asnNumericString {string} {
    # the Numeric String type has tag 0x1c
    
    if {[regexp {[^0-9 ]} $string]} {
        return -code error "Illegal character in Numeric String."
    }
    
    return [asnEncodeString 1c $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
                  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]
                  puts [string length $octets]
              }
              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 $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}]

        ::log::log debug "asnGetResponse length=$length"

        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"
    }
}

#-----------------------------------------------------------------------------
# asnGetByte : Retrieve a single byte from the data (unsigned)
#-----------------------------------------------------------------------------

proc ::asn::asnGetByte {data_var byte_var} {
    upvar $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]

    ::log::log debug "asnGetByte $byte"
    return
}

#-----------------------------------------------------------------------------
# asnPeekByte : Retrieve a single byte from the data (unsigned) 
#               without removing it.
#-----------------------------------------------------------------------------

proc ::asn::asnPeekByte {data_var byte_var} {
    upvar $data_var data $byte_var $byte
    
    binary scan [string index $data 0] c byte
    set byte [expr {($byte + 0x100) % 0x100}]  

    ::log::log debug "asnPeekByte $byte"
    return
}

#-----------------------------------------------------------------------------
# asnGetBytes : Retrieve a block of 'length' bytes from the data.
#-----------------------------------------------------------------------------

proc ::asn::asnGetBytes {data_var length bytes_var} {
    upvar $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]

    ::log::loghex debug asnGetBytes $bytes
    return
}


#-----------------------------------------------------------------------------
# asnGetLength : Decode an ASN length value (See notes)
#-----------------------------------------------------------------------------

proc ::asn::asnGetLength {data_var length_var} {
    upvar $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 {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 {ARITH IOVERFLOW 
                            {Length value too large for normal use, try asnGetBigLength}} "Length value to large"
                } else {
                    scan $hexstr "%lx" length
                }
            }
        }
    }
    ::log::log debug "asnGetLength -> length = $length"
    return
}


#-----------------------------------------------------------------------------
# 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 $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
        binary scan $lengthBytes H* hexlen
        set length [math::bignum::fromstr $hexlen 16]
    }
    ::log::log debug "asnGetBigLength -> length = [math::bignum::tostr $length]"
    return
}

#-----------------------------------------------------------------------------
# asnGetInteger : Retrieve integer.
#-----------------------------------------------------------------------------

proc ::asn::asnGetInteger {data_var int_var} {
    # Tag is 0x02. 

    upvar $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 ?

    ::log::log debug "asnGetInteger len=$len"
    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"
        }
    }
    ::log::log debug "asnGetInteger int=$int"
    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 $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 $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 ?

    ::log::log debug "asnGetEnumeration  len=$len"
    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"
        }
    }
    ::log::log debug "asnGetEnumeration enum=$enum"
    return
}

#-----------------------------------------------------------------------------
# asnGetOctetString : Retrieve arbitrary string.
#-----------------------------------------------------------------------------

proc ::asn::asnGetOctetString {data_var string_var} {
    # Here we need the full decoder for length data.

    upvar $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 $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 $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} {
    upvar $data_var data $appNumber_var appNumber

    asnGetByte   data tag
    asnGetLength data length

    if {($tag & 0xE0) != 0x060} {
        return -code error \
            [format "Expected Application (0x60), but got %02x" $tag]
    }    
    set appNumber [expr {$tag & 0x1F}]
    return
}

#-----------------------------------------------------------------------------
# asnGetBoolean: decode a boolean value
#-----------------------------------------------------------------------------

proc asn::asnGetBoolean {data_var bool_var} {
    upvar $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 $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 $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 $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} {
    upvar $data_var data $contextNumber_var contextNumber

    asnGetByte   data tag
    asnGetLength data length

    if {($tag & 0xE0) != 0x0A0} {
        return -code error \
            [format "Expected Context (0xa0), but got %02x" $tag]
    }    
    set contextNumber [expr {$tag & 0x1F}]
    return
}

#-----------------------------------------------------------------------------
# asnGetPrintableString: Decode a Printable String from the data
#-----------------------------------------------------------------------------

proc ::asn::asnGetPrintableString {data_var print_var} {
    upvar $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 string_var} {
    upvar $data_var data $string_var print

    asnGetByte data tag
    if {$tag != 0x16} {
        return -code error \
            [format "Expected IA5String (0x16), but got %02x" $tag]  
    }
    asnGetLength data length 
    asnGetBytes data $length string
    set string [encoding convertfrom ascii $string]
    return
}

#-----------------------------------------------------------------------------
# asnGetNull: decode a NULL value
#-----------------------------------------------------------------------------

proc asn::asnGetNull {data_var} {
    upvar $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
}



#-----------------------------------------------------------------------------
package provide asn 0.4