package require twapi
twapi::import_commands
#
# Ported by MHo from VBScript: Windows Script Referenz, T.Weltner, S. 306
#
namespace eval adtools {
proc attrFromEMail {mail attr} {
catch {searchAD "(&(objectCategory=person)(objectClass=user)(mail=$mail))" $attr} ret
return $ret
}
### Parameter:
# LDAP-Searchfilter
# List of Attributes (separated by ,) to return (as a dictionary key value ...)
# Attention: no error catching (it's up to the caller)
#
proc searchAD {filter return} {
# ADODB-Connection
set connection [comobj "ADODB.Connection"]
$connection -set Provider "ADsDSOObject"
$connection Open
set command [comobj "ADODB.Command"]
$command -set ActiveConnection $connection
# ADsPath of the current domain (where this script is currently running)
set rootDSE [comobj_object "LDAP://rootDSE"]
set ADsPath [$rootDSE -call Get defaultNamingContext]
# The query
set query "<LDAP://${ADsPath}>;$filter;$return;subtree"
# execute...oh my, why doing things simple....
$command -set CommandText $query
set recordSet [$command Execute]
set ret [list]
if {[$recordSet RecordCount]} {
while {![$recordSet EOF]} {
set d [dict create]
set o [$recordSet Fields]
for {set i 0} {$i < [$o Count]} {incr i} {
set item [$o item $i]
dict set d [$item Name] [$item Value]
}
lappend ret $d
$recordSet MoveNext
}
}
return $ret
}
}
### A few tests
if {[info exists argv0] && [file tail [info script]] eq [file tail $argv0]} {
puts [::adtools::attrFromEMail "[email protected]" "HomeDirectory"]
puts [::adtools::attrFromEMail "[email protected]" "HomeDirectory,cn"]
puts [::adtools::attrFromEMail "Test.*@xyz.de" "HomeDirectory,sAMAccountName"]
puts [::adtools::attrFromEMail "*@xyz.de" "sAMAccountName"]
}