Attachment "ldap.diff" to
ticket [1191326fff]
added by
pdav
2006-08-03 17:08:46.
diff -u -r tcllib/modules/asn/asn.tcl tcllib.new/modules/asn/asn.tcl
--- tcllib/modules/asn/asn.tcl Wed Mar 22 19:56:08 2006
+++ tcllib.new/modules/asn/asn.tcl Thu Aug 3 11:49:33 2006
@@ -2,14 +2,14 @@
# Copyright (C) 1999-2004 Jochen C. Loewer ([email protected])
# Copyright (C) 2004-2006 Michael Schlenker ([email protected])
#-----------------------------------------------------------------------------
-#
-# A partial ASN decoder/encoder implementation in plain Tcl.
+#
+# 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
+# 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,
@@ -21,7 +21,7 @@
# 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
@@ -38,7 +38,7 @@
# written by Jochen Loewer
# 3 June, 1999
#
-# $Id: asn.tcl,v 1.11 2006/03/22 18:56:08 mic42 Exp $
+# $Id: asn.tcl,v 1.3 2006/08/02 20:48:39 pda Exp $
#
#-----------------------------------------------------------------------------
@@ -49,7 +49,9 @@
# Encoder commands
namespace export \
asnSequence \
+ asnSequenceFromList \
asnSet \
+ asnSetFromList \
asnApplicationConstr \
asnApplication \
asnContext\
@@ -67,8 +69,8 @@
asnBMPString\
asnUTF8String\
asnBitString \
- asnObjectIdentifer
-
+ asnObjectIdentifer
+
# Decoder commands
namespace export \
asnGetResponse \
@@ -87,7 +89,7 @@
asnGetBoolean \
asnGetUTCTime \
asnGetBitString \
- asnGetContext
+ asnGetContext
}
#-----------------------------------------------------------------------------
@@ -121,19 +123,19 @@
#-----------------------------------------------------------------------------
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
+ # 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,
+ # 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 } {
+ if {$len < 256} {
return [binary format H2c 81 [expr {$len - 256}]]
}
if {$len < 32769} {
@@ -144,14 +146,14 @@
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}]]
- }
+ # 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}]]
+ # three octet signed value
+ return [binary format H2cS 83 [expr {($len >> 16) -256}] [expr {($len & 0xFFFF) -65536}]]
}
- if {$len < 2147483649} {
+ if {$len < 2147483649} {
# four octet signed value
return [binary format H2I 84 $len]
}
@@ -161,7 +163,7 @@
}
if {$len < 1099511627776} {
# five octet unsigned value
- return [binary format H2 85][string range [binary format W $len] 3 end]
+ return [binary format H2 85][string range [binary format W $len] 3 end]
}
if {$len < 281474976710656} {
# six octet unsigned value
@@ -171,9 +173,9 @@
# 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]
+ return [binary format H2W 88 $len]
}
#-----------------------------------------------------------------------------
@@ -181,12 +183,21 @@
#-----------------------------------------------------------------------------
proc ::asn::asnSequence {args} {
+ return [asnSequenceFromList $args]
+}
+
+
+#-----------------------------------------------------------------------------
+# asnSequenceFromList : Assumes that the arguments are already ASN encoded.
+#-----------------------------------------------------------------------------
+
+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 $args {
+ foreach part $lst {
append out $part
}
set len [string length $out]
@@ -199,12 +210,21 @@
#-----------------------------------------------------------------------------
proc ::asn::asnSet {args} {
+ return [asnSetFromList $args]
+}
+
+
+#-----------------------------------------------------------------------------
+# asnSetFromList : Assumes that the arguments are already ASN encoded.
+#-----------------------------------------------------------------------------
+
+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 $args {
+ foreach part $lst {
append out $part
}
set len [string length $out]
@@ -266,6 +286,7 @@
set len [string length $out]
return [binary format ca*a$len $code [asnLength $len] $out]
}
+
#-----------------------------------------------------------------------------
# asnChoice
#-----------------------------------------------------------------------------
@@ -320,18 +341,18 @@
#-----------------------------------------------------------------------------
proc ::asn::asnIntegerOrEnum {tag number} {
- # The integer tag is 0x02 , the Enum Tag 0x0a otherwise identical.
+ # 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]
}
@@ -354,18 +375,18 @@
if {($number >= -140737488355328) && ($number < 140737488355328)} {
set numberb [expr {$number & 0xFFFFFFFF}]
set numbera [expr {($number >> 32) & 0xFFFF}]
- return [binary format H2H2SI $tag 06 $numbera $numberb]
+ 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]
- }
+ 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"
+ return -code error "Integer value to large to encode, use asnBigInteger"
}
#-----------------------------------------------------------------------------
@@ -375,7 +396,7 @@
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\""
@@ -412,7 +433,7 @@
set hex "0$hex"
}
set octets [expr {(([string length $hex]+1)/2)}]
- return [binary format H2a*H* 02 [asnLength $octets] $hex]
+ return [binary format H2a*H* 02 [asnLength $octets] $hex]
}
@@ -457,13 +478,13 @@
# 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]
+
+ return [binary format H2a*B* 03 [asnLength $len] $bitstring]
}
#-----------------------------------------------------------------------------
@@ -472,9 +493,9 @@
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]
@@ -493,7 +514,7 @@
if {[regexp $nonPrintableChars $string ]} {
return -code error "Illegal character in PrintableString."
}
-
+
# check characters
set ascii [encoding convertto ascii $string]
return [asnEncodeString 13 $ascii]
@@ -524,7 +545,7 @@
if {[regexp $nonNumericChars $string]} {
return -code error "Illegal character in Numeric String."
}
-
+
return [asnEncodeString 12 $string]
}
#----------------------------------------------------------------------
@@ -552,7 +573,7 @@
#-----------------------------------------------------------------------------
proc ::asn::asnEncodeString {tag string} {
set len [string length $string]
- return [binary format H2a*a$len $tag [asnLength $len] $string]
+ return [binary format H2a*a$len $tag [asnLength $len] $string]
}
#-----------------------------------------------------------------------------
@@ -560,11 +581,11 @@
#-----------------------------------------------------------------------------
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} {
@@ -572,7 +593,7 @@
"Malformed OID. Identifiers must be positive Integers."
}
}
-
+
if {[lindex $oid 0] > 2} {
return -code error "First subidentifier must be 0,1 or 2"
}
@@ -580,13 +601,13 @@
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.
+ # This can probably be written much shorter.
# Just a first try that works...
#
set octets [binary format c \
@@ -595,12 +616,12 @@
set d 128
if {$identifier < 128} {
set subidentifier [list $identifier]
- } else {
+ } else {
set subidentifier [list]
# find the largest divisor
-
- while {($identifier / $d) >= 128} {
- set d [expr {$d * 128}]
+
+ while {($identifier / $d) >= 128} {
+ set d [expr {$d * 128}]
}
# and construct the subidentifiers
set remainder $identifier
@@ -643,8 +664,8 @@
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.
+ # 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}]
@@ -658,28 +679,53 @@
switch $len_length {
1 {
- binary scan $lengthBytes c length
- set length [expr {($length + 0x100) % 0x100}]
+ # 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 }
- 3 { binary scan \x00$lengthBytes I length }
- 4 { binary scan $lengthBytes I length }
+ 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 {
- return -code error \
- "length information too long ($len_length)"
+ 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
+ }
}
}
}
- # Now that the length is known we get the remainder,
- # i.e. payload, and construct proper in-memory BER encoded
- # sequence.
+ # 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.
+ # Generate an error message if the data is not a sequence as
+ # we expected.
set tag_hex ""
binary scan $tag H2 tag_hex
@@ -695,22 +741,22 @@
upvar $data_var data $byte_var byte
binary scan [string index $data 0] c byte
- set byte [expr {($byte + 0x100) % 0x100}]
+ set byte [expr {($byte + 0x100) % 0x100}]
set data [string range $data 1 end]
return
}
#-----------------------------------------------------------------------------
-# asnPeekByte : Retrieve a single byte from the data (unsigned)
+# 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}]
+ set byte [expr {($byte + 0x100) % 0x100}]
return
}
@@ -748,12 +794,12 @@
# 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"
+ "length information invalid, not enough octets left"
}
-
+
asnGetBytes data $len_length lengthBytes
switch $len_length {
@@ -762,31 +808,31 @@
# path, as small length values can be coded directly,
# without a prefix.
- binary scan $lengthBytes c length
+ binary scan $lengthBytes c length
set length [expr {($length + 0x100) % 0x100}]
}
- 2 { binary scan $lengthBytes S length
+ 2 { binary scan $lengthBytes S length
set length [expr {($length + 0x10000) % 0x10000}]
}
- 3 { binary scan \x00$lengthBytes I length
+ 3 { binary scan \x00$lengthBytes I length
set length [expr {($length + 0x1000000) % 0x1000000}]
}
- 4 { binary scan $lengthBytes I length
+ 4 { binary scan $lengthBytes I length
set length [expr {(wide($length) + 0x100000000) % 0x100000000}]
}
- default {
+ default {
binary scan $lengthBytes H* hexstr
# skip leading zeros which are allowed by BER
- set hexlen [string trimleft $hexstr 0]
+ 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
+ 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)} {
+ && ([string index $hexlen 0] & 0x8)} {
# check most significant bit, if set we need bignum
- return -code error -errorcode {ARITH IOVERFLOW
+ return -code error -errorcode {ARITH IOVERFLOW
{Length value too large for normal use, try asnGetBigLength}} \
"Length value to large"
} else {
@@ -805,14 +851,14 @@
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,
+ # 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
@@ -825,12 +871,12 @@
# 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"
+ "length information invalid, not enough octets left"
}
-
+
asnGetBytes data $len_length lengthBytes
binary scan $lengthBytes H* hexlen
set length [math::bignum::fromstr $hexlen 16]
@@ -843,7 +889,7 @@
#-----------------------------------------------------------------------------
proc ::asn::asnGetInteger {data_var int_var} {
- # Tag is 0x02.
+ # Tag is 0x02.
upvar $data_var data $int_var int
@@ -862,13 +908,13 @@
switch $len {
1 { binary scan $integerBytes c int }
2 { binary scan $integerBytes S int }
- 3 {
- # check for negative int and pad
+ 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
+ binary scan \x00$integerBytes I int
}
}
4 { binary scan $integerBytes I int }
@@ -883,7 +929,7 @@
} else {
set pad [string repeat \x00 [expr {8-$len}]]
}
- binary scan $pad$integerBytes W int
+ binary scan $pad$integerBytes W int
}
default {
# Too long, or prefix coding was used.
@@ -916,7 +962,7 @@
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]
@@ -925,8 +971,8 @@
[math::bignum::fromstr $bits]]
set big [math::bignum::sub $bignum $exp]
set bignum $big
-
- return
+
+ return
}
@@ -960,7 +1006,6 @@
return -code error "length information too long"
}
}
- return
}
#-----------------------------------------------------------------------------
@@ -971,16 +1016,15 @@
# Here we need the full decoder for length data.
upvar $data_var data $string_var string
-
+
asnGetByte data tag
- if {$tag != 0x04} {
+ 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
}
#-----------------------------------------------------------------------------
@@ -993,10 +1037,10 @@
upvar $data_var data $sequence_var sequence
asnGetByte data tag
- if {$tag != 0x030} {
+ if {$tag != 0x030} {
return -code error \
[format "Expected Sequence (0x30), but got %02x" $tag]
- }
+ }
asnGetLength data length
asnGetBytes data $length temp
set sequence $temp
@@ -1013,10 +1057,10 @@
upvar $data_var data $set_var set
asnGetByte data tag
- if {$tag != 0x031} {
+ if {$tag != 0x031} {
return -code error \
[format "Expected Set (0x31), but got %02x" $tag]
- }
+ }
asnGetLength data length
asnGetBytes data $length temp
set set $temp
@@ -1027,7 +1071,7 @@
# asnGetApplication
#-----------------------------------------------------------------------------
-proc ::asn::asnGetApplication {data_var appNumber_var {contet_var {}}} {
+proc ::asn::asnGetApplication {data_var appNumber_var {content_var {}}} {
upvar $data_var data $appNumber_var appNumber
asnGetByte data tag
@@ -1036,12 +1080,12 @@
if {($tag & 0xE0) != 0x060} {
return -code error \
[format "Expected Application (0x60), but got %02x" $tag]
- }
+ }
set appNumber [expr {$tag & 0x1F}]
- if {[string length content_var]} {
- upvar $content_var content
- asnGetBytes data $length content
- }
+ if {[string length $content_var]} {
+ upvar $content_var content
+ asnGetBytes data $length content
+ }
return
}
@@ -1060,7 +1104,7 @@
asnGetLength data length
asnGetByte data byte
- set bool [expr {$byte == 0 ? 0 : 1}]
+ set bool [expr {$byte == 0 ? 0 : 1}]
return
}
@@ -1081,11 +1125,11 @@
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
}
@@ -1104,14 +1148,14 @@
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
@@ -1128,16 +1172,16 @@
asnGetByte data tag
if {$tag != 0x06} {
return -code error \
- [format "Expected Object Identifier (0x06), but got %02x" $tag]
+ [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
@@ -1149,7 +1193,7 @@
set mult 128
foreach byte $bytes {
if {$byte != {}} {
- incr oidval [expr {$mult*$byte}]
+ incr oidval [expr {$mult*$byte}]
set mult [expr {$mult*128}]
}
}
@@ -1160,7 +1204,7 @@
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."
@@ -1169,7 +1213,7 @@
}
#-----------------------------------------------------------------------------
-# asnGetContext: Decode an explicit context tag
+# asnGetContext: Decode an explicit context tag
#
#-----------------------------------------------------------------------------
@@ -1182,7 +1226,7 @@
if {($tag & 0xE0) != 0x0A0} {
return -code error \
[format "Expected Context (0xa0), but got %02x" $tag]
- }
+ }
set contextNumber [expr {$tag & 0x1F}]
if {[string length content_var]} {
upvar $content_var content
@@ -1200,9 +1244,9 @@
asnGetByte data tag
if {$tag != 0x12} {
return -code error \
- [format "Expected Numeric String (0x12), but got %02x" $tag]
+ [format "Expected Numeric String (0x12), but got %02x" $tag]
}
- asnGetLength data length
+ asnGetLength data length
asnGetBytes data $length string
set print [encoding convertfrom ascii $string]
return
@@ -1218,9 +1262,9 @@
asnGetByte data tag
if {$tag != 0x13} {
return -code error \
- [format "Expected Printable String (0x13), but got %02x" $tag]
+ [format "Expected Printable String (0x13), but got %02x" $tag]
}
- asnGetLength data length
+ asnGetLength data length
asnGetBytes data $length string
set print [encoding convertfrom ascii $string]
return
@@ -1236,9 +1280,9 @@
asnGetByte data tag
if {$tag != 0x16} {
return -code error \
- [format "Expected IA5 String (0x16), but got %02x" $tag]
+ [format "Expected IA5 String (0x16), but got %02x" $tag]
}
- asnGetLength data length
+ asnGetLength data length
asnGetBytes data $length string
set print [encoding convertfrom ascii $string]
return
@@ -1251,9 +1295,9 @@
asnGetByte data tag
if {$tag != 0x1e} {
return -code error \
- [format "Expected BMP String (0x1e), but got %02x" $tag]
+ [format "Expected BMP String (0x1e), but got %02x" $tag]
}
- asnGetLength data length
+ asnGetLength data length
asnGetBytes data $length string
if {$::tcl_platform(byteOrder) eq "littleEndian"} {
set str2 ""
@@ -1274,9 +1318,9 @@
asnGetByte data tag
if {$tag != 0x0c} {
return -code error \
- [format "Expected UTF8 String (0x0c), but got %02x" $tag]
+ [format "Expected UTF8 String (0x0c), but got %02x" $tag]
}
- asnGetLength data length
+ asnGetLength data length
asnGetBytes data $length string
#there should be some error checking to see if input is
#properly-formatted utf8
@@ -1289,7 +1333,7 @@
#-----------------------------------------------------------------------------
proc ::asn::asnGetNull {data_var} {
- upvar $data_var data
+ upvar $data_var data
asnGetByte data tag
if {$tag != 0x05} {
@@ -1299,9 +1343,9 @@
asnGetLength data length
asnGetBytes data $length bytes
-
+
# we do not check the null data, all bytes must be 0x00
-
+
return
}
@@ -1312,11 +1356,11 @@
namespace eval asn {
variable stringTypes
array set stringTypes {
- 12 NumericString
- 13 PrintableString
- 16 IA5String
- 1e BMPString
- 0c UTF8String
+ 12 NumericString
+ 13 PrintableString
+ 16 IA5String
+ 1e BMPString
+ 0c UTF8String
14 T61String
15 VideotexString
1a VisibleString
@@ -1378,5 +1422,5 @@
}
#-----------------------------------------------------------------------------
-package provide asn 0.5.1
+package provide asn 0.5.2
diff -u -r tcllib/modules/ldap/ldap.man tcllib.new/modules/ldap/ldap.man
--- tcllib/modules/ldap/ldap.man Wed Jun 21 23:08:43 2006
+++ tcllib.new/modules/ldap/ldap.man Thu Aug 3 11:49:49 2006
@@ -25,6 +25,14 @@
[list_begin definitions]
+[call [cmd ::ldap::api_version] [opt [arg version]]]
+
+Sets the current API version (see [cmd ::ldap::add] below) to the
+specified [arg version]. Returns the old API version. Without
+argument, this command returns the current API version. Default API
+version is 1, extended version will be 2 in a near future.
+
+
[call [cmd ::ldap::connect] [arg host] [opt [arg port]]]
Opens a LDAPv3 connection to the specified [arg host], at the given
@@ -99,7 +107,7 @@
[nl]
[example {
- {dn1 {attr1 val1 attr2 val2 ...}} {dn2 {a1 v1 ...}} ...
+ {dn1 {attr1 {val11 val12 ...} attr2 {val21...} ...}} {dn2 {a1 {v11 ...} ...}} ...
}]
[nl]
@@ -150,6 +158,11 @@
attributes of the new object are set to the values in the dictionary
[arg attrValueTuples] (which is keyed by the attribute names).
+Under API version 1 (see [cmd ::ldap::api_version] before), each
+attribute in [arg attrValueTuples] can only have one value. This
+is corrected with API version 2, where each attribute tuple contains
+the list of values.
+
The command blocks until the operation has completed. Its result
is the empty string.
@@ -209,6 +222,8 @@
# Connect, bind, add a new object, modify it in various ways
+ ldap::api_version 2
+
set handle [ldap::connect localhost 9009]
set dn "cn=Manager, o=University of Michigan, c=US"
@@ -219,11 +234,12 @@
set dn "cn=Test User,ou=People,o=University of Michigan,c=US"
ldap::add $handle $dn {
- objectClass OpenLDAPperson
- cn "Test User"
- mail "[email protected]"
- uid "testuid"
- sn User
+ objectClass {OpenLDAPperson}
+ cn {{Test User}}
+ mail {[email protected]}
+ uid {testuid}
+ sn {User}
+ telephoneNumber {+31415926535 +27182818285}
}
# Replace all attributes
diff -u -r tcllib/modules/ldap/ldap.tcl tcllib.new/modules/ldap/ldap.tcl
--- tcllib/modules/ldap/ldap.tcl Wed Jun 21 11:33:05 2006
+++ tcllib.new/modules/ldap/ldap.tcl Thu Aug 3 11:49:49 2006
@@ -34,7 +34,7 @@
# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
# MODIFICATIONS.
#
-# $Id: ldap.tcl,v 1.9 2006/06/21 09:33:05 mic42 Exp $
+# $Id: ldap.tcl,v 1.3 2006/08/02 20:48:39 pda Exp $
#
# written by Jochen Loewer
# 3 June, 1999
@@ -42,6 +42,8 @@
#-----------------------------------------------------------------------------
package require Tcl 8.4
+package require asn; # tcllib
+
package provide ldap 1.4
@@ -55,12 +57,15 @@
add \
delete \
modifyDN \
- info
+ info \
+ api_version
variable SSLCertifiedAuthoritiesFile
variable doDebug
+ variable apiVersion
set doDebug 0
+ set apiVersion 1
array set resultCode2String {
0 success
@@ -192,6 +197,42 @@
#-----------------------------------------------------------------------------
+# api_version
+#
+#-----------------------------------------------------------------------------
+proc ldap::api_version {{version {}}} {
+ variable apiVersion
+
+ #
+ # Returns the old API version number
+ #
+
+ set v $apiVersion
+
+ #
+ # Validates the new version number, and provides ability
+ # to perform some actions when changing level.
+ #
+
+ switch -- $version {
+ {} {
+ # do nothing, just returns the current version
+ }
+ 1 {
+ set apiVersion $version
+ }
+ 2 {
+ set apiVersion $version
+ }
+ default {
+ return -code error "Invalid API version ($version)"
+ }
+ }
+ return $v
+}
+
+
+#-----------------------------------------------------------------------------
# connect
#
#-----------------------------------------------------------------------------
@@ -289,13 +330,13 @@
# marshal bind request packet and send it
#
#-----------------------------------------------------------------
- set request [asnSequence \
- [asnInteger $conn(messageId)] \
- [asnApplicationConstr 0 \
- [asnInteger 3] \
- [asnOctetString $name] \
- [asnChoice 0 $password] \
- ] \
+ set request [asn::asnSequence \
+ [asn::asnInteger $conn(messageId)] \
+ [asn::asnApplicationConstr 0 \
+ [asn::asnInteger 3] \
+ [asn::asnOctetString $name] \
+ [asn::asnChoice 0 $password] \
+ ] \
]
debugData bindRequest $request
puts -nonewline $conn(sock) $request
@@ -305,21 +346,21 @@
# receive (blocking) bind response packet(s) and unmarshal it
#
#-----------------------------------------------------------------
- asnGetResponse $conn(sock) response
+ asn::asnGetResponse $conn(sock) response
debugData bindResponse $response
- asnGetSequence response response
- asnGetInteger response MessageID
+ asn::asnGetSequence response response
+ asn::asnGetInteger response MessageID
if { $MessageID != $conn(messageId) } {
error "umatching response packet ($MessageID != $conn(messageId))"
}
- asnGetApplication response appNum
+ asn::asnGetApplication response appNum
if { $appNum != 1 } {
error "unexpected application number ($appNum != 1)"
}
- asnGetEnumeration response resultCode
- asnGetOctetString response matchedDN
- asnGetOctetString response errorMessage
+ asn::asnGetEnumeration response resultCode
+ asn::asnGetOctetString response matchedDN
+ asn::asnGetOctetString response errorMessage
if {$resultCode != 0} {
return -code error "LDAP error $ldap::resultCode2String($resultCode) '$matchedDN': $errorMessage"
}
@@ -340,9 +381,9 @@
#------------------------------------------------
# marshal unbind request packet and send it
#------------------------------------------------
- set request [asnSequence \
- [asnInteger $conn(messageId)] \
- [asnApplication 2 ""] ]
+ set request [asn::asnSequence \
+ [asn::asnInteger $conn(messageId)] \
+ [asn::asnApplication 2 ""] ]
debugData unbindRequest $request
puts -nonewline $conn(sock) $request
@@ -367,36 +408,39 @@
foreach term [lrange $filter 1 end] {
append data [buildUpFilter $term]
}
- return [asnChoiceConstr 0 $data]
+ return [asn::asnChoiceConstr 0 $data]
}
^\\|$ { #--- or --------------------------------------------
foreach term [lrange $filter 1 end] {
append data [buildUpFilter $term]
}
- return [asnChoiceConstr 1 $data]
+ return [asn::asnChoiceConstr 1 $data]
}
^\\!$ { #--- not -------------------------------------------
- return [asnChoiceConstr 2 [buildUpFilter [lindex $filter 1]]]
+ return [asn::asnChoiceConstr 2 [buildUpFilter [lindex $filter 1]]]
}
=\\*$ { #--- present ---------------------------------------
set endpos [expr {[string length $first] -3}]
set attributetype [string range $first 0 $endpos]
- return [asnChoice 7 $attributetype]
+ return [asn::asnChoice 7 $attributetype]
}
^[0-9A-z.]*~= { #--- approxMatch --------------------------
regexp {^([0-9A-z.]*)~=(.*)$} $first all attributetype value
- return [asnChoiceConstr 8 [asnOctetString $attributetype] \
- [asnOctetString $value] ]
+ return [asn::asnChoiceConstr 8 \ \
+ [asn::asnOctetString $attributetype] \
+ [asn::asnOctetString $value] ]
}
^[0-9A-z.]*<= { #--- lessOrEqual --------------------------
regexp {^([0-9A-z.]*)<=(.*)$} $first all attributetype value
- return [asnChoiceConstr 6 [asnOctetString $attributetype] \
- [asnOctetString $value] ]
+ return [asn::asnChoiceConstr 6 \
+ [asn::asnOctetString $attributetype] \
+ [asn::asnOctetString $value] ]
}
^[0-9A-z.]*>= { #--- greaterOrEqual -----------------------
regexp {^([0-9A-z.]*)>=(.*)$} $first all attributetype value
- return [asnChoiceConstr 5 [asnOctetString $attributetype] \
- [asnOctetString $value] ]
+ return [asn::asnChoiceConstr 5 \
+ [asn::asnOctetString $attributetype] \
+ [asn::asnOctetString $value] ]
}
^[0-9A-z.]*=.*\\*.* { #--- substrings -----------------
regexp {^([0-9A-z.]*)=(.*)$} $first all attributetype value
@@ -435,17 +479,19 @@
} else {
set substrtype 1 ;# any
}
- lappend l [asnChoice $substrtype $str]
+ lappend l [asn::asnChoice $substrtype $str]
incr i
}
- return [asnChoiceConstr 4 [asnOctetString $attributetype] \
- [asnSequenceFromList $l] ]
+ return [asn::asnChoiceConstr 4 \
+ [asn::asnOctetString $attributetype] \
+ [asn::asnSequenceFromList $l] ]
}
^[0-9A-z.]*= { #--- equal ---------------------------------
regexp {^([0-9A-z.]*)=(.*)$} $first all attributetype value
trace "equal: attributetype='$attributetype' value='$value'"
- return [asnChoiceConstr 3 [asnOctetString $attributetype] \
- [asnOctetString $value] ]
+ return [asn::asnChoiceConstr 3 \
+ [asn::asnOctetString $attributetype] \
+ [asn::asnOctetString $value] ]
}
default {
return [buildUpFilter $first]
@@ -478,8 +524,10 @@
-scope {
switch -- $value {
base { set scope 0 }
- one - onelevel { set scope 1 }
- sub - subtree { set scope 2 }
+ one -
+ onelevel { set scope 1 }
+ sub -
+ subtree { set scope 2 }
default { set scope $value }
}
}
@@ -496,25 +544,25 @@
set berAttributes ""
foreach attribute $attributes {
- append berAttributes [asnOctetString $attribute]
+ append berAttributes [asn::asnOctetString $attribute]
}
#----------------------------------------------------------
# marshal search request packet and send it
#----------------------------------------------------------
incr conn(messageId)
- set request [asnSequence \
- [asnInteger $conn(messageId)] \
- [asnApplicationConstr 3 \
- [asnOctetString $baseObject] \
- [asnEnumeration $scope] \
- [asnEnumeration $derefAliases] \
- [asnInteger $sizeLimit] \
- [asnInteger $timeLimit] \
- [asnBoolean $attrsOnly] \
- $berFilter \
- [asnSequence $berAttributes] \
- ] \
+ set request [asn::asnSequence \
+ [asn::asnInteger $conn(messageId)] \
+ [asn::asnApplicationConstr 3 \
+ [asn::asnOctetString $baseObject] \
+ [asn::asnEnumeration $scope] \
+ [asn::asnEnumeration $derefAliases] \
+ [asn::asnInteger $sizeLimit] \
+ [asn::asnInteger $timeLimit] \
+ [asn::asnBoolean $attrsOnly] \
+ $berFilter \
+ [asn::asnSequence $berAttributes] \
+ ] \
]
debugData searchRequest $request
puts -nonewline $conn(sock) $request
@@ -527,15 +575,15 @@
set lastPacket 0
while { !$lastPacket } {
- asnGetResponse $conn(sock) response
+ asn::asnGetResponse $conn(sock) response
debugData searchResponse $response
- asnGetSequence response response
- asnGetInteger response MessageID
+ asn::asnGetSequence response response
+ asn::asnGetInteger response MessageID
if { $MessageID != $conn(messageId) } {
error "umatching response packet ($MessageID != $conn(messageId))"
}
- asnGetApplication response appNum
+ asn::asnGetApplication response appNum
if { ($appNum != 4) && ($appNum != 5) } {
error "unexpected application number ($appNum != 4 or 5)"
}
@@ -543,16 +591,16 @@
#----------------------------------------------------------
# unmarshal search data packet
#----------------------------------------------------------
- asnGetOctetString response objectName
- asnGetSequence response attributes
+ asn::asnGetOctetString response objectName
+ asn::asnGetSequence response attributes
set result_attributes {}
while { [string length $attributes] != 0 } {
- asnGetSequence attributes attribute
- asnGetOctetString attribute attrType
- asnGetSet attribute attrValues
+ asn::asnGetSequence attributes attribute
+ asn::asnGetOctetString attribute attrType
+ asn::asnGetSet attribute attrValues
set result_attrValues {}
while { [string length $attrValues] != 0 } {
- asnGetOctetString attrValues attrValue
+ asn::asnGetOctetString attrValues attrValue
lappend result_attrValues $attrValue
}
lappend result_attributes $attrType $result_attrValues
@@ -563,9 +611,9 @@
#----------------------------------------------------------
# unmarshal search final response packet
#----------------------------------------------------------
- asnGetEnumeration response resultCode
- asnGetOctetString response matchedDN
- asnGetOctetString response errorMessage
+ asn::asnGetEnumeration response resultCode
+ asn::asnGetOctetString response matchedDN
+ asn::asnGetOctetString response errorMessage
if {$resultCode != 0} {
return -code error "LDAP error $ldap::resultCode2String($resultCode): $errorMessage"
}
@@ -605,12 +653,12 @@
#------------------------------------------------------------------
set modifications {}
foreach { attrName attrValue } $attrValToReplace {
- append modifications [asnSequence \
- [asnEnumeration $operationReplace ] \
- [asnSequence \
- [asnOctetString $attrName ] \
- [asnSet \
- [asnOctetString $attrValue ] \
+ append modifications [asn::asnSequence \
+ [asn::asnEnumeration $operationReplace ] \
+ [asn::asnSequence \
+ [asn::asnOctetString $attrName ] \
+ [asn::asnSet \
+ [asn::asnOctetString $attrValue ] \
] \
] \
]
@@ -621,14 +669,14 @@
#
#------------------------------------------------------------------
foreach { attrName attrValue } $attrValToAdd {
- append modifications [asnSequence \
- [asnEnumeration $operationAdd ] \
- [asnSequence \
- [asnOctetString $attrName ] \
- [asnSet \
- [asnOctetString $attrValue ] \
- ] \
- ] \
+ append modifications [asn::asnSequence \
+ [asn::asnEnumeration $operationAdd ] \
+ [asn::asnSequence \
+ [asn::asnOctetString $attrName ] \
+ [asn::asnSet \
+ [asn::asnOctetString $attrValue ] \
+ ] \
+ ] \
]
}
@@ -644,16 +692,16 @@
#------------------------------------------------------------------
foreach { attrName attrValue } $attrToDelete {
if {$attrValue == ""} {
- set val [asnSet ""]
+ set val [asn::asnSet ""]
} else {
- set val [asnSet [asnOctetString $attrValue]]
+ set val [asn::asnSet [asn::asnOctetString $attrValue]]
}
- append modifications [asnSequence \
- [asnEnumeration $operationDelete ] \
- [asnSequence \
- [asnOctetString $attrName ] \
- $val \
- ] \
+ append modifications [asn::asnSequence \
+ [asn::asnEnumeration $operationDelete ] \
+ [asn::asnSequence \
+ [asn::asnOctetString $attrName ] \
+ $val \
+ ] \
]
}
@@ -661,12 +709,12 @@
# marshal 'modify' request packet and send it
#----------------------------------------------------------
incr conn(messageId)
- set request [asnSequence \
- [asnInteger $conn(messageId)] \
- [asnApplicationConstr 6 \
- [asnOctetString $dn ] \
- [asnSequence $modifications ] \
- ] \
+ set request [asn::asnSequence \
+ [asn::asnInteger $conn(messageId)] \
+ [asn::asnApplicationConstr 6 \
+ [asn::asnOctetString $dn ] \
+ [asn::asnSequence $modifications ] \
+ ] \
]
debugData modifyRequest $request
puts -nonewline $conn(sock) $request
@@ -675,22 +723,22 @@
#-----------------------------------------------------------------------
# receive (blocking) 'modify' response packet(s) and unmarshal it
#-----------------------------------------------------------------------
- asnGetResponse $conn(sock) response
+ asn::asnGetResponse $conn(sock) response
debugData bindResponse $response
- asnGetSequence response response
- asnGetInteger response MessageID
+ asn::asnGetSequence response response
+ asn::asnGetInteger response MessageID
if { $MessageID != $conn(messageId) } {
error "umatching response packet ($MessageID != $conn(messageId))"
}
- asnGetApplication response appNum
+ asn::asnGetApplication response appNum
if { $appNum != 7 } {
error "unexpected application number ($appNum != 7)"
}
- asnGetEnumeration response resultCode
- asnGetOctetString response matchedDN
- asnGetOctetString response errorMessage
+ asn::asnGetEnumeration response resultCode
+ asn::asnGetOctetString response matchedDN
+ asn::asnGetOctetString response errorMessage
if {$resultCode != 0} {
return -code error "LDAP error $ldap::resultCode2String($resultCode) $matchedDN: $errorMessage"
}
@@ -710,26 +758,51 @@
# marshal attribute list
#
#------------------------------------------------------------------
+
set attrList ""
- foreach { attrName attrValue } $attrValueTuples {
- append attrList [asnSequence \
- [asnOctetString $attrName ] \
- [asnSet \
- [asnOctetString $attrValue ] \
- ] \
- ]
+ if {[api_version] == 1} then {
+ #
+ # First API version cannot handle multi-valuated attributes
+ # Cf bug 1191326 on sourceforge:
+ # http://sourceforge.net/tracker/index.php?func=detail&atid=112883&group_id=12883&aid=1191326
+ #
+
+ foreach { attrName attrValue } $attrValueTuples {
+ append attrList [asn::asnSequence \
+ [asn::asnOctetString $attrName ] \
+ [asn::asnSet \
+ [asn::asnOctetString $attrValue ] \
+ ] \
+ ]
+ }
+ } else {
+ #
+ # Second API version and later: each tuple contains the
+ # attribute name, and one or more attribute values
+ #
+
+ foreach { attrName attrValues } $attrValueTuples {
+ set valList {}
+ foreach val $attrValues {
+ lappend valList [asn::asnOctetString $val]
+ }
+ append attrList [asn::asnSequence \
+ [asn::asnOctetString $attrName ] \
+ [asn::asnSetFromList $valList] \
+ ]
+ }
}
#----------------------------------------------------------
# marshal search 'add' request packet and send it
#----------------------------------------------------------
incr conn(messageId)
- set request [asnSequence \
- [asnInteger $conn(messageId)] \
- [asnApplicationConstr 8 \
- [asnOctetString $dn ] \
- [asnSequence $attrList ] \
- ] \
+ set request [asn::asnSequence \
+ [asn::asnInteger $conn(messageId)] \
+ [asn::asnApplicationConstr 8 \
+ [asn::asnOctetString $dn ] \
+ [asn::asnSequence $attrList ] \
+ ] \
]
debugData addRequest $request
@@ -740,22 +813,22 @@
# receive (blocking) 'add' response packet(s) and unmarshal it
#
#-----------------------------------------------------------------------
- asnGetResponse $conn(sock) response
+ asn::asnGetResponse $conn(sock) response
debugData bindResponse $response
- asnGetSequence response response
- asnGetInteger response MessageID
+ asn::asnGetSequence response response
+ asn::asnGetInteger response MessageID
if { $MessageID != $conn(messageId) } {
error "umatching response packet ($MessageID != $conn(messageId))"
}
- asnGetApplication response appNum
+ asn::asnGetApplication response appNum
if { $appNum != 9 } {
error "unexpected application number ($appNum != 9)"
}
- asnGetEnumeration response resultCode
- asnGetOctetString response matchedDN
- asnGetOctetString response errorMessage
+ asn::asnGetEnumeration response resultCode
+ asn::asnGetOctetString response matchedDN
+ asn::asnGetOctetString response errorMessage
if {$resultCode != 0} {
return -code error "LDAP error $ldap::resultCode2String($resultCode) $matchedDN: $errorMessage"
}
@@ -773,9 +846,9 @@
# marshal 'delete' request packet and send it
#----------------------------------------------------------
incr conn(messageId)
- set request [asnSequence \
- [asnInteger $conn(messageId)] \
- [asnApplication 10 $dn ] \
+ set request [asn::asnSequence \
+ [asn::asnInteger $conn(messageId)] \
+ [asn::asnApplication 10 $dn ] \
]
debugData deleteRequest $request
@@ -786,22 +859,22 @@
# receive (blocking) 'delete' response packet(s) and unmarshal it
#
#-----------------------------------------------------------------------
- asnGetResponse $conn(sock) response
+ asn::asnGetResponse $conn(sock) response
debugData bindResponse $response
- asnGetSequence response response
- asnGetInteger response MessageID
+ asn::asnGetSequence response response
+ asn::asnGetInteger response MessageID
if { $MessageID != $conn(messageId) } {
error "umatching response packet ($MessageID != $conn(messageId))"
}
- asnGetApplication response appNum
+ asn::asnGetApplication response appNum
if { $appNum != 11 } {
error "unexpected application number ($appNum != 11)"
}
- asnGetEnumeration response resultCode
- asnGetOctetString response matchedDN
- asnGetOctetString response errorMessage
+ asn::asnGetEnumeration response resultCode
+ asn::asnGetOctetString response matchedDN
+ asn::asnGetOctetString response errorMessage
if {$resultCode != 0} {
return -code error "LDAP error $ldap::resultCode2String($resultCode) $matchedDN: $errorMessage"
}
@@ -820,13 +893,13 @@
# marshal 'modifyDN' request packet and send it
#----------------------------------------------------------
incr conn(messageId)
- set request [asnSequence \
- [asnInteger $conn(messageId)] \
- [asnApplicationConstr 12 \
- [asnOctetString $dn ] \
- [asnOctetString $newrdn ] \
- [asnBoolean $deleteOld ] \
- ] \
+ set request [asn::asnSequence \
+ [asn::asnInteger $conn(messageId)] \
+ [asn::asnApplicationConstr 12 \
+ [asn::asnOctetString $dn ] \
+ [asn::asnOctetString $newrdn ] \
+ [asn::asnBoolean $deleteOld ] \
+ ] \
]
debugData modifyRequest $request
puts -nonewline $conn(sock) $request
@@ -835,22 +908,22 @@
#-----------------------------------------------------------------------
# receive (blocking) 'modifyDN' response packet(s) and unmarshal it
#-----------------------------------------------------------------------
- asnGetResponse $conn(sock) response
+ asn::asnGetResponse $conn(sock) response
debugData bindResponse $response
- asnGetSequence response response
- asnGetInteger response MessageID
+ asn::asnGetSequence response response
+ asn::asnGetInteger response MessageID
if { $MessageID != $conn(messageId) } {
error "umatching response packet ($MessageID != $conn(messageId))"
}
- asnGetApplication response appNum
+ asn::asnGetApplication response appNum
if { $appNum != 13 } {
error "unexpected application number ($appNum != 13)"
}
- asnGetEnumeration response resultCode
- asnGetOctetString response matchedDN
- asnGetOctetString response errorMessage
+ asn::asnGetEnumeration response resultCode
+ asn::asnGetOctetString response matchedDN
+ asn::asnGetOctetString response errorMessage
if {$resultCode != 0} {
return -code error "LDAP error $ldap::resultCode2String($resultCode) $matchedDN: $errorMessage"
}
@@ -928,583 +1001,4 @@
trace [format "%4s %-48s |%s|" $address $hexnums $ascii ]
}
trace ""
-}
-
-
-#-----------------------------------------------------------------------------
-# asnLength
-#
-#-----------------------------------------------------------------------------
-proc ldap::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
-#
-#-----------------------------------------------------------------------------
-proc ldap::asnSequence { args } {
-
- return [asnSequenceFromList $args]
-}
-
-
-#-----------------------------------------------------------------------------
-# asnSequenceFromList
-#
-#-----------------------------------------------------------------------------
-proc ldap::asnSequenceFromList { lst } {
-
- set out ""
- foreach part $lst {
- append out $part
- }
- set len [string length $out]
- return [binary format H2a*a$len 30 [asnLength $len] $out]
-}
-
-
-#-----------------------------------------------------------------------------
-# asnSet
-#
-#-----------------------------------------------------------------------------
-proc ldap::asnSet { args } {
-
- 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 ldap::asnApplicationConstr { appNumber args } {
-
- 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 ldap::asnApplication { appNumber data } {
-
- set code [expr {0x040 + $appNumber}]
- set len [string length $data]
- return [binary format ca*a$len $code [asnLength $len] $data]
-}
-
-
-#-----------------------------------------------------------------------------
-# asnChoice
-#
-#-----------------------------------------------------------------------------
-proc ldap::asnChoice { appNumber args } {
-
- 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 ldap::asnChoiceConstr { appNumber args } {
-
- 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 ::ldap::asnInteger {number} {
- asnIntegerOrEnum 02 $number
-}
-
-#-----------------------------------------------------------------------------
-# asnEnumeration : Encode enumeration value.
-#-----------------------------------------------------------------------------
-
-proc ::ldap::asnEnumeration {number} {
- asnIntegerOrEnum 0a $number
-}
-
-#-----------------------------------------------------------------------------
-# asnIntegerOrEnum : Common code for Integers and Enumerations
-# No Bignum version, as we do not expect large Enums.
-#-----------------------------------------------------------------------------
-
-proc ::ldap::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"
-}
-
-
-#-----------------------------------------------------------------------------
-# asnBoolean
-#
-#-----------------------------------------------------------------------------
-proc ldap::asnBoolean { bool } {
-
- return [binary format H2H2c 01 01 [expr {$bool ? 0x0FF : 0}]]
-}
-
-
-#-----------------------------------------------------------------------------
-# asnOctetString
-#
-#-----------------------------------------------------------------------------
-proc ldap::asnOctetString { string } {
-
- set len [string length $string]
- return [binary format H2a*a$len 04 [asnLength $len] $string]
-}
-
-
-#-----------------------------------------------------------------------------
-# asnGetResponse - LDAP specific ?
-#
-#-----------------------------------------------------------------------------
-proc ldap::asnGetResponse { sock data_var } {
-
- upvar $data_var data
-
- set tag [read $sock 1]
-
- if {$tag == "\x30"} {
- set len1 [read $sock 1]
- binary scan $len1 c num
- set length [expr {($num + 0x100) % 0x100}]
- trace "asnGetResponse length=$length"
- if {$length >= 0x080} {
- set len_length [expr {$length & 0x7f}]
- set lengthBytes [read $sock $len_length]
- 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
- }
- }
- }
- }
- set rest [read $sock $length]
- set data [binary format aa*a$length $tag [asnLength $length] $rest]
- } else {
- set tag_hex ""
- binary scan $tag H2 tag_hex
- error "unknown start tag [string length $tag] $tag_hex"
- }
-}
-
-
-#-----------------------------------------------------------------------------
-# asnGetByte
-#
-#-----------------------------------------------------------------------------
-proc ldap::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]
-
- trace "asnGetByte $byte"
-}
-
-
-#-----------------------------------------------------------------------------
-# asnGetBytes
-#
-#-----------------------------------------------------------------------------
-proc ldap::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]
-
- debugData asnGetBytes $bytes
-}
-
-#-----------------------------------------------------------------------------
-# asnGetLength : Decode an ASN length value (See notes)
-#-----------------------------------------------------------------------------
-
-proc ::ldap::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
- }
- }
- }
- }
- trace "asnGetLength -> length = $length"
- return
-}
-
-#-----------------------------------------------------------------------------
-# asnGetInteger : Retrieve integer.
-#-----------------------------------------------------------------------------
-
-proc ldap::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 ?
-
- trace "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
- return -code error "length information too long"
- }
- }
- trace "asnGetInteger int=$int"
- return
-}
-
-
-
-#-----------------------------------------------------------------------------
-# asnGetEnumeration
-#
-#-----------------------------------------------------------------------------
-proc ldap::asnGetEnumeration { data_var enum_var } {
-
- upvar $data_var data $enum_var enum
-
- asnGetByte data tag
- asnGetLength data len
- asnGetBytes data $len integerBytes
-
- if {$tag != 0x0a} {
- error "Expected Enumeration, but got $tag"
- }
- set enum ?
-
- trace "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 {
- error "length information too long"
- }
- }
- trace "asnGetEnumeration enum=$enum"
-}
-
-
-#-----------------------------------------------------------------------------
-# asnGetOctetString
-#
-#-----------------------------------------------------------------------------
-proc ldap::asnGetOctetString { data_var string_var } {
-
- upvar $data_var data $string_var string
-
- asnGetByte data byte
- if {$byte != 0x04} {
- error "Got different tag than octet string (0x04)"
- }
- asnGetLength data length
- asnGetBytes data $length temp
- set string $temp
-}
-
-
-#-----------------------------------------------------------------------------
-# asnGetSequence
-#
-#-----------------------------------------------------------------------------
-proc ldap::asnGetSequence { data_var sequence_var } {
-
- upvar $data_var data $sequence_var sequence
-
- asnGetByte data byte
- if {$byte != 0x030} {
- error "Got different tag than sequence (0x030)"
- }
- asnGetLength data length
- asnGetBytes data $length temp
- set sequence $temp
-}
-
-
-#-----------------------------------------------------------------------------
-# asnGetSet
-#
-#-----------------------------------------------------------------------------
-proc ldap::asnGetSet { data_var set_var } {
-
- upvar $data_var data $set_var set
-
- asnGetByte data byte
- if {$byte != 0x031} {
- error "Got different tag than set (0x031)"
- }
- asnGetLength data length
- asnGetBytes data $length temp
- set set $temp
-}
-
-
-#-----------------------------------------------------------------------------
-# asnGetApplication
-#
-#-----------------------------------------------------------------------------
-proc ldap::asnGetApplication { data_var appNumber_var } {
-
- upvar $data_var data $appNumber_var appNumber
-
- asnGetByte data byte
- asnGetLength data length
-
- if {($byte & 0xE0) != 0x060} {
- error "Got different tag than application (0x060)"
- }
- set appNumber [expr {$byte & 0x1F}]
}
