--- /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 <andreas_kupries@users.sourceforge.net>}]
 [copyright {2004 Jochen Loewer <loewerj@web.de>}]
 [copyright {2006 Michael Schlenker <mic42@users.sourceforge.net>}]
 [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        "test.user@google.com"
-	uid         "testuid"
-	sn          User
+	objectClass     OpenLDAPperson
+	cn              {Test User}
+	mail            test.user@google.com
+	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            {test.user@google.com}
+	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)
