/usr/share/tcltk/xotcl1.6.7-comm/Ldap.xotcl is in xotcl 1.6.7-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 | package provide xotcl::comm::ldap 0.9
package require xotcl::wafecompat ; # Get 'requireModules'.
package require XOTcl
namespace eval ::xotcl::comm::ldap {
namespace import ::xotcl::*
requireModules { ldapOpen ldaplibGen.so }
Class Ldap -superclass NetAccess -parameter {host port dn attributes scope filter}
Ldap instproc initialize args {
my instvar port mapToC useCache
my set port 389
my set useCache 0
set mapToC(one) onelevel
set mapToC(sub) subtree
set mapToC(base) base
next
}
Ldap proc urlDecode string {
set toParse $string
set parsed ""
while {1} {
if {[regexp {^([^%]*)%(..)(.*)$} $toParse _ front hex toParse]} {
append parsed $front [binary format c 0x$hex]
} else {
append parsed $toParse
break
}
}
return $parsed
}
Ldap instproc getUrlcomponents {} {
showCall
my instvar path dn attributes scope filter url
set path [Ldap urlDecode $path]
puts stderr "___ path=<$path>"
if {[regexp -nocase {^/([^?]*)(\?([^?]*)(\?([^?]*)(\?([^?]*))?)?)?$} \
$path _ dn a attributes s scope f filter]} {
if {$scope eq ""} { set scope "base" }
if {$filter eq ""} { set filter "(objectClass=*)" }
} else {
set errmsg "*** Ldap Url trail=<$path> does not match!\n"
append errmsg "___ RFC 1959 says:\n"
append errmsg " ldap://<host>:<port>/<dn>\[?<attributes>\[?<scope>?<filter>\]\]\n"
append errmsg "___ Cineast and Netscape uses:\n"
append errmsg " ldap://<host>:<port>/<dn>\[?<attributes>\[?<scope>\[?<filter>\]\]\]"
my abort "Unsupported URL: '$url' \n $errmsg"
}
}
Ldap instproc GET {} {
my instvar contentType totalsize state currentsize informObjects block
showCall
set contentType text/html
my getUrlcomponents
if {"start" ne $state } {
puts stderr "... [self]:$proc ignoring request in state $state"
return
}
my open
my search
my body-state
set totalsize [string length $block]
set currentsize $totalsize
foreach obj $informObjects {
$obj incCb [self] $totalsize $currentsize
}
my eof
}
Ldap instproc open {} {
showCall
my instvar port host ldapHandle
set ldapHandle [ldapOpen $host $port]
}
Ldap instproc bind {} {
my instvar ldapHandle
showCall
}
Ldap instproc search {} {
showVars
my instvar url ldapHandle searchHandle dn attributes scope filter results mapToC path
set searchHandle [ldapSearch $ldapHandle $dn \
$mapToC($scope) $filter [split $attributes ,] false results]
set nentries [ldapCountEntries $ldapHandle $searchHandle]
puts stderr "*** nentries = $nentries"
if {!$nentries} {set results ""}
my response
}
Ldap instproc getAttrs {dn} {
}
Ldap instproc makeUrl {dn} {
showCall
my instvar port host scope filter attributes
set tmpUrl ldap://$host:$port/$dn?$attributes?$scope?$filter
return "<a href=\"$tmpUrl\">$dn</a>"
}
Ldap instproc response {} {
showCall
my instvar block results attrsVals ldapHandle searchHandle
set block "
<HTML>
<HEAD><TITLE>LDAP searching result!!</TITLE></HEAD>
<BODY bgcolor=FFFFFF>
<H1>Result</H1>\n <ul>\n"
foreach {resDN} $results {
append block " <li> [my makeUrl $resDN] <p>\n <ul>\n"
ldapAttributes $ldapHandle $searchHandle $resDN attrsVals
foreach {a v} [array get attrsVals] {
append block " <li> <FONT COLOR=\"\#cc0000\" face=\"Arial,Helvetica\" size=4><b> $a </b></FONT> = $v <p>\n"
}
append block " </ul>\n"
}
append block " </ul>\n </BODY>\n</HTML>"
}
# destructor: Close Connection to LDAP-Server and unbind
Ldap instproc destroy {} {
showCall
my instvar ldapHandle
if {[catch {ldapUnbind $ldapHandle} error]} {
return $error
}
my freeSearchHandle
}
Ldap instproc close {} {
showCall
my destroy
next
}
Ldap instproc freeSearchHandle {} {
showCall
my instvar searchHandle
if {[info exists searchHandle]} {
ldapFreeSearch $searchHandle
}
}
namespace export Ldap
}
namespace import ::xotcl::comm::ldap::*
|