Merge commit '7c621da28f07e449ad90c387344f07a453927569' as 'tcllib'

4 files changed, 360 insertions, 0 deletions

diff --git a/tcllib/examples/ldap/ldapChangeTest b/tcllib/examples/ldap/ldapChangeTest
new file mode 100755
index 0000000..e491ac4
--- /dev/null
+++ b/tcllib/examples/ldap/ldapChangeTest
@@ -0,0 +1,152 @@
+#!/usr/bin/env tclsh
+## -*- tcl -*-
+#-----------------------------------------------------------------------------
+#   
+#   A small script to test the update/modify/delete capabilites of
+#   pure-Tcl LDAP package.
+#
+#   This has been used against OpenLDAP test suite 
+#   (pause at step 'test003-search' Waiting 5 secods for slapd to start ...'
+#
+#-----------------------------------------------------------------------------
+
+package require ldap
+#source ./ldap.tcl
+
+#-----------------------------------------------------------------------------
+#   Query
+#
+#-----------------------------------------------------------------------------
+
+proc Query {handle} {
+    set results [ldap::search $handle \
+	    "o=University of Michigan,c=US" \
+	    "(cn=Tes*)" {}]
+
+    foreach result $results {
+	foreach {object attributes} $result break
+
+	#------------------------------------------
+	#    calculate optimal width
+	#------------------------------------------
+	set width 0
+	set Attribs {}
+	foreach {type values} $attributes {
+	    if {[string length $type] > $width} {
+		set width [string length $type] 
+	    }
+	    lappend Attribs [list $type $values]
+	}     
+
+	puts "object='$object'"
+
+	foreach sortedAttrib  [lsort -index 0 $Attribs] {
+	    foreach {type values} $sortedAttrib break
+	    foreach value $values {
+		regsub -all "\[\x01-\x1f\]" $value ? value
+		puts [format "  %-${width}s %s" $type $value]
+	    }
+	}
+	puts ""
+    }
+}
+
+#-----------------------------------------------------------------------------
+#                begin of   M A I N  part
+#-----------------------------------------------------------------------------
+
+#---------------------------------------------------------------
+#   connect to the local LDAP server using a non standard port
+#   (here OpenLDAP test suite)
+#
+#---------------------------------------------------------------
+set handle [ldap::connect localhost 9009]
+
+#---------------------------------------------------------------
+#   bind to the manager user (which was update/insert rights)
+#   ie. login into LDAP server
+#
+#---------------------------------------------------------------
+set dn "cn=Manager, o=University of Michigan, c=US"
+set pw secret
+
+ldap::bind $handle $dn $pw
+
+#---------------------------------------------------------------
+#   create a new object (DN) with a couple of attrbitues
+#
+#---------------------------------------------------------------
+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
+}
+
+puts "after DN creation:"
+Query $handle
+
+#---------------------------------------------------------------
+#   replace some attributes (overwrite or create new one!)
+#
+#---------------------------------------------------------------
+ldap::modify $handle $dn [list drink icetea uid JOLO]
+
+puts "after replacing some attrbitues:"
+Query $handle
+
+#---------------------------------------------------------------
+#   add some attributes (even multiple times!)
+#
+#---------------------------------------------------------------
+ldap::modify $handle $dn {} {} [list drink water \
+	drink orangeJuice pager "+1 313 555 7671"]
+
+puts "after adding multiple attrbitues:"
+Query $handle
+
+#----------------------------------------------------------------
+#   delete some attributes ( delete the whole attribute or only
+#   matching ones)
+#
+#----------------------------------------------------------------
+ldap::modify $handle $dn {} [list drink water \
+	pager ""]
+
+puts "after delete some attrbitues:"
+Query $handle
+
+#----------------------------------------------------------------
+#   move object (DN) to different place in LDAP tree, 
+#   here: basically rename it
+#
+#----------------------------------------------------------------
+ldap::modifyDN $handle $dn "cn=Tester"
+
+puts "after moving/renaming DN:"
+Query $handle
+
+#---------------------------------------------------------------
+#   delete the whole object plus all its attrbutes
+#
+#---------------------------------------------------------------
+set dn "cn=Tester,ou=People,o=University of Michigan,c=US"
+ldap::delete $handle $dn 
+
+puts "after deleting the whole DN:"
+Query $handle
+
+#---------------------------------------------------------------
+#   unbind and disconnect from the LDAP server
+#
+#---------------------------------------------------------------
+ldap::unbind     $handle
+ldap::disconnect $handle
+
+#-----------------------------------------------------------------------------
+#                end of   M A I N  part
+#-----------------------------------------------------------------------------
diff --git a/tcllib/examples/ldap/ldapChangeTest.output b/tcllib/examples/ldap/ldapChangeTest.output
new file mode 100644
index 0000000..294a127
--- /dev/null
+++ b/tcllib/examples/ldap/ldapChangeTest.output
@@ -0,0 +1,50 @@
+after DN creation:
+object='cn=Test User,ou=People,o=University of Michigan,c=US'
+  cn          Test User
+  mail        test.user@google.com
+  objectClass OpenLDAPperson
+  sn          User
+  uid         testuid
+
+after replacing some attrbitues:
+object='cn=Test User,ou=People,o=University of Michigan,c=US'
+  cn          Test User
+  drink       icetea
+  mail        test.user@google.com
+  objectClass OpenLDAPperson
+  sn          User
+  uid         JOLO
+
+after adding multiple attrbitues:
+object='cn=Test User,ou=People,o=University of Michigan,c=US'
+  cn          Test User
+  drink       icetea
+  drink       water
+  drink       orangeJuice
+  mail        test.user@google.com
+  objectClass OpenLDAPperson
+  pager       +1 313 555 7671
+  sn          User
+  uid         JOLO
+
+after delete some attrbitues:
+object='cn=Test User,ou=People,o=University of Michigan,c=US'
+  cn          Test User
+  drink       icetea
+  drink       orangeJuice
+  mail        test.user@google.com
+  objectClass OpenLDAPperson
+  sn          User
+  uid         JOLO
+
+after moving/renaming DN:
+object='cn=Tester,ou=People,o=University of Michigan,c=US'
+  cn          Tester
+  drink       icetea
+  drink       orangeJuice
+  mail        test.user@google.com
+  objectClass OpenLDAPperson
+  sn          User
+  uid         JOLO
+
+after deleting the whole DN:
diff --git a/tcllib/examples/ldap/ldapquery b/tcllib/examples/ldap/ldapquery
new file mode 100755
index 0000000..1a715cc
--- /dev/null
+++ b/tcllib/examples/ldap/ldapquery
@@ -0,0 +1,106 @@
+#!/usr/bin/env tclsh
+## -*- tcl -*-
+#-----------------------------------------------------------------------------
+#   
+#   A small tool to query a LDAP database and to display all/some
+#   attributes.
+#
+#
+#   $Log: ldapquery,v $
+#   Revision 1.2  2004/04/27 21:15:02  andreas_kupries
+#   Fixed buglet. (Typo of varname).
+#
+#   Revision 1.1  2004/04/27 19:45:35  andreas_kupries
+#
+#   	* installed_modules.tcl: Added new module.
+#   	* examples/ldap:
+#   	* modules/ldap: New module: LDAP client. Provided to us by Joechen
+#   	  Loewer <loewerj@web.de>.
+#
+#   	* Added doctools documentation.
+#
+#   Revision 1.3  2000/03/23  18:03:10  18:03:10  jolo (Jochen Loewer)
+#   added sorting of types when all types/attributes 
+#   are listed
+#   
+#   Revision 1.2  2000/03/23  17:45:40  17:45:40  jolo (Jochen Loewer)
+#   does a package require now!
+#   
+#   Revision 1.1  2000/03/23  17:40:23  17:40:23  jolo (Jochen Loewer)
+#   Initial revision
+#   
+#
+#
+#   written by Jochen Loewer
+#   4 June, 1999
+#
+#-----------------------------------------------------------------------------
+
+package require ldap
+#source ./ldap.tcl
+
+#-----------------------------------------------------------------------------
+#                begin of   M A I N  part
+#-----------------------------------------------------------------------------
+
+if {$argc <  3} {
+    puts stderr "usage: "
+    puts stderr "    ldapquery <ldapserver> <base> <filter> ?<attribute> <attribute> ...?"
+    puts stderr "example: "
+    puts stderr "    ldapquery ldap.acme.com \"o=acme.com\" \"(cn=Miller*)\" "
+    puts stderr "    ldapquery ldap.acme.com:389 \"o=acme.com\" \"(cn=Miller*)\" l mail"
+    puts stderr "    ldapquery ldap \"o=acme.com\" \"&(l=Paris*)(cn=Miller*)\" cn telephonenumber ou"
+    exit 1
+}
+foreach {server base query} [lrange $argv 0 2] break
+set fields [lrange $argv 3 end]
+
+
+set port 389
+regexp {([^:]*):([0-9]*)} $server --> server port
+
+set handle [ldap::connect $server $port]
+
+ldap::bind $handle
+
+set results [ldap::search $handle $base $query $fields]
+
+foreach result $results {
+
+    foreach {object attributes} $result break
+
+    #------------------------------------------
+    #    calculate optimal width
+    #------------------------------------------
+    set width 0
+    set sortedAttribs {}
+    foreach {type values} $attributes {
+	if {[string length $type] > $width} {
+	    set width [string length $type] 
+	}
+	lappend sortedAttribs [list $type $values]
+    }     
+
+    if {$fields == {}} {
+	# sort all by type
+	set sortedAttribs [lsort -index 0 $sortedAttribs]
+    }
+
+    puts "object='$object'"
+
+    foreach sortedAttrib  $sortedAttribs {
+	foreach {type values} $sortedAttrib break
+	foreach value $values {
+	    regsub -all "\[\x01-\x1f\]" $value ? value
+	    puts [format "  %-${width}s %s" $type $value]
+	}
+    }
+    puts ""
+}
+
+ldap::unbind $handle
+ldap::disconnect $handle
+
+#-----------------------------------------------------------------------------
+#                begin of   M A I N  part
+#-----------------------------------------------------------------------------
diff --git a/tcllib/examples/ldap/ldifdump b/tcllib/examples/ldap/ldifdump
new file mode 100755
index 0000000..fe73f54
--- /dev/null
+++ b/tcllib/examples/ldap/ldifdump
@@ -0,0 +1,52 @@
+#!/usr/bin/env tclsh
+## -*- tcl -*-
+########################################################################
+#
+# Load and print an ldif file
+#
+########################################################################
+
+package require ldapx
+
+if {![llength $argv]} {
+    puts stderr "Usage: [info script] file ?file ... file?"
+    exit 1
+}
+set entries [list]
+
+proc loadLDIF {fd} {
+    global entries
+    
+    ldapx::ldif ld
+    ld channel $fd
+    
+    set e [ldapx::entry %AUTO%]
+    while {[ld read $e]} {
+       lappend entries $e
+       set e [ldapx::entry %AUTO%]
+    }
+    $e destroy
+    
+}
+
+proc displayLDIF {} {
+    global entries
+    set sort [list]
+    foreach e $entries {
+        lappend sort [list [$e dn] $e]
+    }
+    set sort [lsort -index 0 $sort]
+    foreach key $sort {
+        set e [lindex $key 1]
+        puts "[$e print] \n"
+    }
+    
+}
+
+foreach file $argv {
+    set fd [open $file]
+    loadLDIF $fd
+    close $fd
+}
+displayLDIF
+exit