Attachment "ldap.patch" to
ticket [1541828fff]
added by
pdav
2006-08-17 22:43:52.
--- /home/pda/tcllib/modules/ldap/ldap.man Tue Aug 15 16:11:34 2006
+++ ldap.man Thu Aug 17 11:23:18 2006
@@ -1,12 +1,12 @@
[comment {-*- tcl -*- doctools manpage}]
-[manpage_begin ldap n 1.5]
+[manpage_begin ldap n 1.6]
[copyright {2004 Andreas Kupries <[email protected]>}]
[copyright {2004 Jochen Loewer <[email protected]>}]
[copyright {2006 Michael Schlenker <[email protected]>}]
[moddesc {LDAP client}]
[titledesc {LDAP client}]
[require Tcl 8.4]
-[require ldap [opt 1.5]]
+[require ldap [opt 1.6]]
[description]
[para]
@@ -99,11 +99,85 @@
[nl]
[example {
- {dn1 {attr1 val1 attr2 val2 ...}} {dn2 {a1 v1 ...}} ...
+ {dn1 {attr1 {val11 val12 ...} attr2 {val21...} ...}} {dn2 {a1 {v11 ...} ...}} ...
}]
[nl]
+[call [cmd ::ldap::searchInit] [arg handle] [arg baseObject] [arg filterString] [arg attributes] [arg options]]
+
+This command initiates a LDAP search below the [arg baseObject] tree
+using a complex LDAP search expression [arg filterString]. The search
+must return the specified [arg attributes] of all matching objects (DNs).
+If the list of [arg attributes] was empty all attributes wille be returned.
+The parameter [arg options] specifies the options to be used in the search,
+and has the following format:
+
+[nl]
+[example {
+ {-option1 value1 -option2 value2 ... }
+}]
+[nl]
+
+Following options are available:
+
+[list_begin arg]
+[arg_def -scope base|one|sub (default sub)]
+
+See ldapsearch(1)
+
+[arg_def -derefaliases never|search|find|always (default never)]
+
+See ldapsearch(1)
+
+[arg_def -sizelimit value (default 0, meaning no limit)]
+
+See ldapsearch(1)
+
+[arg_def -timelimit value (default 0, meaning no limit)]
+
+See ldapsearch(1)
+
+[arg_def -attrsonly value (default 0)]
+
+See ldapsearch(1)
+
+[list_end]
+[nl]
+
+The initiated search results are returned by subsequent calls to
+[call ::ldap::searchNext]. A search must be terminated by
+[call ::ldap::searchEnd]. No other ldap command may be called
+while the search is in progress.
+
+[nl]
+
+[call [cmd ::ldap::searchNext] [arg handle]]
+
+This command returns the next entry from a LDAP search initiated
+by [call ::ldap::searchInit]. The returned entry is a list with
+two elements: the first is the DN of the entry, the second is the
+list of attributes and values, under the format:
+
+[nl]
+[example {
+ dn {attr1 {val11 val12 ...} attr2 {val21...} ...}
+}]
+[nl]
+
+The [cmd ::ldap::searchNext] command returns an empty list at the
+end of the search.
+
+
+[nl]
+
+[call [cmd ::ldap::searchEnd] [arg handle]]
+
+This command terminates a LDAP search initiated
+by [call ::ldap::searchInit].
+
+[nl]
+
[call [cmd ::ldap::modify] [arg handle] [arg dn] \
[arg attrValToReplace] \
[opt [arg attrToDelete]] \
@@ -154,6 +228,7 @@
The command blocks until the operation has completed. Its result
is the empty string.
+
[call [cmd ::ldap::addMulti] [arg handle] [arg dn] [arg attrValueTuples]]
This command is the preferred one to create
@@ -165,6 +240,7 @@
The command blocks until the operation has completed. Its result
is the empty string.
+
[call [cmd ::ldap::delete] [arg handle] [arg dn]]
This command removes the object specified by [arg dn], and all its
@@ -174,16 +250,22 @@
is the empty string.
-[call [cmd ::ldap::modifyDN] [arg handle] [arg dn] [arg newrdn] [opt [arg deleteOld]]]
+[call [cmd ::ldap::modifyDN] [arg handle] [arg dn] [arg newrdn] [opt [arg deleteOld] [opt [arg newSuperior]]]]
This command moves or copies the object specified by [arg dn]
to a new location in the tree of object. This location is
-specified by [arg newrdn], a [emph relative] designation.
+specified by [arg newrdn], a [emph relative] designation,
+or by [arg newrdn] and [arg newSuperior], a [emph absolute] designation.
-The optional argument [arg deleteOld] default to to [const true],
+The optional argument [arg deleteOld] defaults to [const true],
i.e. a move operation. If [arg deleteOld] is not set, then the
operation will create a copy of [arg dn] in the new location.
+The optional argument [arg newSuperior] defaults an empty string,
+meaning that the object must not be relocated in another branch of
+the tree. If this argument is given, the argument [arg deleteOld]
+must be specified also.
+
The command blocks until the operation has completed. Its result
is the empty string.
@@ -230,11 +312,24 @@
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
+ telephoneNumber +27182818285
+ }
+
+ set dn "cn=Another User,ou=People,o=University of Michigan,c=US"
+
+ ldap::addMulti $handle $dn {
+ objectClass {OpenLDAPperson}
+ cn {{Anotther User}}
+ mail {[email protected]}
+ uid {testuid}
+ sn {User}
+ telephoneNumber {+31415926535 +27182818285}
}
# Replace all attributes
--- /home/pda/tcllib/modules/ldap/ldap.tcl Tue Aug 15 16:11:34 2006
+++ ldap.tcl Thu Aug 17 17:42:03 2006
@@ -34,7 +34,7 @@
# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
# MODIFICATIONS.
#
-# $Id: ldap.tcl,v 1.11 2006/08/15 14:11:34 mic42 Exp $
+# $Id: ldap.tcl,v 1.8 2006/08/17 09:35:10 pda Exp $
#
# written by Jochen Loewer
# 3 June, 1999
@@ -43,8 +43,7 @@
package require Tcl 8.4
package require asn 0.6
-package provide ldap 1.5
-
+package provide ldap 1.6
namespace eval ldap {
@@ -52,6 +51,9 @@
disconnect \
bind unbind \
search \
+ searchInit \
+ searchNext \
+ searchEnd \
modify \
add \
addMulti \
@@ -287,6 +289,8 @@
upvar $handle conn
+ checkNotSearch $handle
+
incr conn(messageId)
#-----------------------------------------------------------------
@@ -339,6 +343,8 @@
upvar $handle conn
+ checkNotSearch $handle
+
incr conn(messageId)
#------------------------------------------------
@@ -464,21 +470,62 @@
# and returns all matching objects (DNs) with given attributes
# (or all attributes if empty list is given) as list:
#
-# dn1 { attr1 val1 attr2 val2 ... } dn2 { a1 v1 } ....
+# {dn1 { attr1 {val11 val12 ...} attr2 {val21 val22 ... } ... }} {dn2 { ... }} ...
#
#-----------------------------------------------------------------------------
proc ldap::search { handle baseObject filterString attributes args} {
upvar $handle conn
+ searchInit $handle $baseObject $filterString $attributes $args
+
+ set results {}
+ set lastPacket 0
+ while { !$lastPacket } {
+
+ set r [searchNext $handle]
+ if {[llength $r] > 0} then {
+ lappend results $r
+ } else {
+ set lastPacket 1
+ }
+ }
+ searchEnd $handle
+
+ return $results
+}
+#-----------------------------------------------------------------------------
+# checkNotSearch - checks if a search is in progress
+#
+#-----------------------------------------------------------------------------
+proc ldap::checkNotSearch { handle } {
+
+ upvar $handle conn
+
+ if {[::info exists conn(search)]} then {
+ return -code error \
+ "Cannot handle request: search in progress"
+ }
+}
+
+#-----------------------------------------------------------------------------
+# searchInit - initiates an LDAP search
+#
+#-----------------------------------------------------------------------------
+proc ldap::searchInit { handle baseObject filterString attributes opt} {
+
+ upvar $handle conn
+
+ checkNotSearch $handle
+
set scope 2
set derefAliases 0
set sizeLimit 0
set timeLimit 0
set attrsOnly 0
- foreach {key value} $args {
- switch -- $key {
+ foreach {key value} $opt {
+ switch -- [string tolower $key] {
-scope {
switch -- $value {
base { set scope 0 }
@@ -487,6 +534,28 @@
default { set scope $value }
}
}
+ -derefaliases {
+ switch -- $value {
+ never { set derefAliases 0 }
+ search { set derefAliases 1 }
+ find { set derefAliases 2 }
+ always { set derefAliases 3 }
+ default { set derefAliases $value }
+ }
+ }
+ -sizelimit {
+ set sizeLimit $value
+ }
+ -timelimit {
+ set timeLimit $value
+ }
+ -attrsonly {
+ set attrsOnly $value
+ }
+ default {
+ return -code error \
+ "Invalid search option '$key'"
+ }
}
}
@@ -524,61 +593,128 @@
puts -nonewline $conn(sock) $request
flush $conn(sock)
+ set conn(search) "started"
+
+ return
+}
+
+#-----------------------------------------------------------------------------
+# searchNext - returns the next result of an LDAP search
+#
+#-----------------------------------------------------------------------------
+proc ldap::searchNext { handle } {
+
+ upvar $handle conn
+
+ if {! [::info exists conn(search)]} then {
+ return -code error \
+ "Not in search"
+ }
+ if {! [string equal $conn(search) "started"]} then {
+ return {}
+ }
+
+ set result {}
+ set lastPacket 0
+
#----------------------------------------------------------
- # receive (blocking) search response packet(s)
+ # Wait for a search response packet
#----------------------------------------------------------
- set results {}
- set lastPacket 0
- while { !$lastPacket } {
- asnGetResponse $conn(sock) response
- debugData searchResponse $response
+ asnGetResponse $conn(sock) response
+ debugData searchResponse $response
- asnGetSequence response response
- asnGetInteger response MessageID
- if { $MessageID != $conn(messageId) } {
- error "umatching response packet ($MessageID != $conn(messageId))"
- }
- asnGetApplication response appNum
- if { ($appNum != 4) && ($appNum != 5) } {
- error "unexpected application number ($appNum != 4 or 5)"
- }
- if {$appNum == 4} {
- #----------------------------------------------------------
- # unmarshal search data packet
- #----------------------------------------------------------
- asnGetOctetString response objectName
- asnGetSequence response attributes
- set result_attributes {}
- while { [string length $attributes] != 0 } {
- asnGetSequence attributes attribute
- asnGetOctetString attribute attrType
- asnGetSet attribute attrValues
- set result_attrValues {}
- while { [string length $attrValues] != 0 } {
- asnGetOctetString attrValues attrValue
- lappend result_attrValues $attrValue
- }
- lappend result_attributes $attrType $result_attrValues
- }
- lappend results [list $objectName $result_attributes]
- }
- if {$appNum == 5} {
- #----------------------------------------------------------
- # unmarshal search final response packet
- #----------------------------------------------------------
- asnGetEnumeration response resultCode
- asnGetOctetString response matchedDN
- asnGetOctetString response errorMessage
- if {$resultCode != 0} {
- return -code error "LDAP error $ldap::resultCode2String($resultCode): $errorMessage"
- }
- set lastPacket 1
- }
+ asnGetSequence response response
+ asnGetInteger response MessageID
+ if { $MessageID != $conn(messageId) } {
+ error "umatching response packet ($MessageID != $conn(messageId))"
}
- return $results
+ asnGetApplication response appNum
+
+ if {$appNum == 4} {
+ #----------------------------------------------------------
+ # unmarshal search data packet
+ #----------------------------------------------------------
+ asnGetOctetString response objectName
+ asnGetSequence response attributes
+ set result_attributes {}
+ while { [string length $attributes] != 0 } {
+ asnGetSequence attributes attribute
+ asnGetOctetString attribute attrType
+ asnGetSet attribute attrValues
+ set result_attrValues {}
+ while { [string length $attrValues] != 0 } {
+ asnGetOctetString attrValues attrValue
+ lappend result_attrValues $attrValue
+ }
+ lappend result_attributes $attrType $result_attrValues
+ }
+ set result [list $objectName $result_attributes]
+ } elseif {$appNum == 5} {
+ #----------------------------------------------------------
+ # unmarshal search final response packet
+ #----------------------------------------------------------
+ asnGetEnumeration response resultCode
+ asnGetOctetString response matchedDN
+ asnGetOctetString response errorMessage
+ if {$resultCode != 0} {
+ return -code error "LDAP error $ldap::resultCode2String($resultCode): $errorMessage"
+ }
+ set result {}
+ set conn(search) "end"
+ } else {
+ error "unexpected application number ($appNum != 4 or 5)"
+ }
+
+ return $result
}
+#-----------------------------------------------------------------------------
+# searchEnd - end an LDAP search
+#
+#-----------------------------------------------------------------------------
+proc ldap::searchEnd { handle } {
+
+ upvar $handle conn
+
+ if {! [::info exists conn(search)]} then {
+ return -code error \
+ "Not in search"
+ }
+ if {[string equal $conn(search) "started"]} then {
+ #
+ # In an ideal world, this code should use an LDAP Abandon
+ # operation (RFC 2251, section 4.11)
+ #
+ # For the moment, we just aborb final results.
+ #
+
+ set lastPacket 0
+ while {! $lastPacket } {
+ #----------------------------------------------------------
+ # Wait for a search response packet
+ #----------------------------------------------------------
+
+ asnGetResponse $conn(sock) response
+
+ asnGetSequence response response
+ asnGetInteger response MessageID
+ if { $MessageID != $conn(messageId) } {
+ error "umatching response packet ($MessageID != $conn(messageId))"
+ }
+ asnGetApplication response appNum
+
+ if {$appNum == 4} {
+ # nothing
+ } elseif {$appNum == 5} {
+ set lastPacket 1
+ } else {
+ error "unexpected application number ($appNum != 4 or 5)"
+ }
+ }
+ }
+ unset conn(search)
+}
#-----------------------------------------------------------------------------
# modify - provides attribute modifications on one single object (DN):
@@ -592,6 +728,8 @@
upvar $handle conn
+ checkNotSearch $handle
+
set operationAdd 0
set operationDelete 1
set operationReplace 2
@@ -703,34 +841,39 @@
#-----------------------------------------------------------------------------
# add - will create a new object using given DN and sets the given
-# attributes
+# attributes. Multiple value attributes may be used, provided
+# that each attr-val pair be listed.
#
#-----------------------------------------------------------------------------
proc ldap::add { handle dn attrValueTuples } {
- #
- # In order to handle multi-valuated attributes (see bug 1191326 on
- # sourceforge), we walk through tuples to collect all values for
- # an attribute.
- # http://sourceforge.net/tracker/index.php?func=detail&atid=112883&group_id=12883&aid=1191326
- #
-
- foreach { attrName attrValue } $attrValueTuples {
- lappend avpairs($attrName) $attrValue
- }
+ upvar $handle conn
- return [addMulti $handle $dn [array get avpairs]]
+ #
+ # In order to handle multi-valuated attributes (see bug 1191326 on
+ # sourceforge), we walk through tuples to collect all values for
+ # an attribute.
+ # http://sourceforge.net/tracker/index.php?func=detail&atid=112883&group_id=12883&aid=1191326
+ #
+
+ foreach { attrName attrValue } $attrValueTuples {
+ lappend avpairs($attrName) $attrValue
+ }
+
+ return [addMulti $handle $dn [array get avpairs]]
}
#-----------------------------------------------------------------------------
# addMulti - will create a new object using given DN and sets the given
-# attributes. Argument is a list of attr-listOfVals pair.
+# attributes. Argument is a list of attr-listOfVals pair.
#
#-----------------------------------------------------------------------------
proc ldap::addMulti { handle dn attrValueTuples } {
upvar $handle conn
+ checkNotSearch $handle
+
#------------------------------------------------------------------
# marshal attribute list
#
@@ -738,15 +881,15 @@
set attrList ""
foreach { attrName attrValues } $attrValueTuples {
- set valList {}
- foreach val $attrValues {
- lappend valList [asnOctetString $val]
- }
- append attrList [asnSequence \
- [asnOctetString $attrName ] \
- [asnSetFromList $valList] \
- ]
- }
+ set valList {}
+ foreach val $attrValues {
+ lappend valList [asnOctetString $val]
+ }
+ append attrList [asnSequence \
+ [asnOctetString $attrName ] \
+ [asnSetFromList $valList] \
+ ]
+ }
#----------------------------------------------------------
# marshal search 'add' request packet and send it
@@ -797,6 +940,8 @@
upvar $handle conn
+ checkNotSearch $handle
+
#----------------------------------------------------------
# marshal 'delete' request packet and send it
#----------------------------------------------------------
@@ -840,22 +985,37 @@
# modifyDN - moves an object (DN) to another (relative) place
#
#-----------------------------------------------------------------------------
-proc ldap::modifyDN { handle dn newrdn { deleteOld 1 } } {
+proc ldap::modifyDN { handle dn newrdn { deleteOld 1 } {newSuperior ! } } {
upvar $handle conn
+ checkNotSearch $handle
+
#----------------------------------------------------------
# marshal 'modifyDN' request packet and send it
#----------------------------------------------------------
incr conn(messageId)
- set request [asnSequence \
- [asnInteger $conn(messageId)] \
- [asnApplicationConstr 12 \
- [asnOctetString $dn ] \
- [asnOctetString $newrdn ] \
- [asnBoolean $deleteOld ] \
- ] \
- ]
+
+ if {[string equal $newSuperior "!"]} then {
+ set request [asn::asnSequence \
+ [asn::asnInteger $conn(messageId)] \
+ [asn::asnApplicationConstr 12 \
+ [asn::asnOctetString $dn ] \
+ [asn::asnOctetString $newrdn ] \
+ [asn::asnBoolean $deleteOld ] \
+ ] \
+ ]
+ } else {
+ set request [asn::asnSequence \
+ [asn::asnInteger $conn(messageId)] \
+ [asn::asnApplicationConstr 12 \
+ [asn::asnOctetString $dn ] \
+ [asn::asnOctetString $newrdn ] \
+ [asn::asnBoolean $deleteOld ] \
+ [asn::asnContext 0 $newSuperior] \
+ ] \
+ ]
+ }
debugData modifyRequest $request
puts -nonewline $conn(sock) $request
flush $conn(sock)
@@ -892,6 +1052,8 @@
proc ldap::disconnect { handle } {
upvar $handle conn
+
+ checkNotSearch $handle
# should we sent an 'unbind' ?
close $conn(sock)
