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
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
|
{- -*- Mode: haskell; -*-
Haskell LDAP Interface
Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>
This code is under a 3-clause BSD license; see COPYING for details.
-}
{- |
Module : LDAP.Search
Copyright : Copyright (C) 2005 John Goerzen
License : BSD
Maintainer : John Goerzen,
Maintainer : jgoerzen\@complete.org
Stability : provisional
Portability: portable
LDAP Searching
Written by John Goerzen, jgoerzen\@complete.org
-}
module LDAP.Search (SearchAttributes(..),
LDAPEntry(..), LDAPScope(..),
ldapSearch,
)
where
import LDAP.Utils
import LDAP.Types
import LDAP.TypesLL
import LDAP.Data
import Foreign
import Foreign.C.String
#if (__GLASGOW_HASKELL__>=705)
import Foreign.C.Types(CInt(..))
#endif
import LDAP.Result
import Control.Exception(finally)
#include <ldap.h>
{- | Defines what attributes to return with the search result. -}
data SearchAttributes =
LDAPNoAttrs -- ^ No attributes
| LDAPAllUserAttrs -- ^ User attributes only
| LDAPAttrList [String] -- ^ User-specified list
deriving (Eq, Show)
sa2sl :: SearchAttributes -> [String]
sa2sl LDAPNoAttrs = [ #{const_str LDAP_NO_ATTRS} ]
sa2sl LDAPAllUserAttrs = [ #{const_str LDAP_ALL_USER_ATTRIBUTES} ]
sa2sl (LDAPAttrList x) = x
data LDAPEntry = LDAPEntry
{ledn :: String -- ^ Distinguished Name of this object
,leattrs :: [(String, [String])] -- ^ Mapping from attribute name to values
}
deriving (Eq, Show)
ldapSearch :: LDAP -- ^ LDAP connection object
-> Maybe String -- ^ Base DN for search, if any
-> LDAPScope -- ^ Scope of the search
-> Maybe String -- ^ Filter to be used (none if Nothing)
-> SearchAttributes -- ^ Desired attributes in result set
-> Bool -- ^ If True, exclude attribute values (return types only)
-> IO [LDAPEntry]
ldapSearch ld base scope filter attrs attrsonly =
withLDAPPtr ld (\cld ->
withMString base (\cbase ->
withMString filter (\cfilter ->
withCStringArr0 (sa2sl attrs) (\cattrs ->
do msgid <- checkLEn1 "ldapSearch" ld $
ldap_search cld cbase (fromIntegral $ fromEnum scope)
cfilter cattrs (fromBool attrsonly)
procSR ld cld msgid
)
)
)
)
procSR :: LDAP -> Ptr CLDAP -> LDAPInt -> IO [LDAPEntry]
procSR ld cld msgid =
do res1 <- ldap_1result ld msgid
--putStrLn "Have 1result"
withForeignPtr res1 (\cres1 ->
do felm <- ldap_first_entry cld cres1
if felm == nullPtr
then return []
else do --putStrLn "Have first entry"
cdn <- ldap_get_dn cld felm -- FIXME: check null
dn <- peekCString cdn
ldap_memfree cdn
attrs <- getattrs ld felm
next <- procSR ld cld msgid
--putStrLn $ "Next is " ++ (show next)
return $ (LDAPEntry {ledn = dn, leattrs = attrs}):next
)
data BerElement
getattrs :: LDAP -> (Ptr CLDAPMessage) -> IO [(String, [String])]
getattrs ld lmptr =
withLDAPPtr ld (\cld -> alloca (f cld))
where f cld (ptr::Ptr (Ptr BerElement)) =
do cstr <- ldap_first_attribute cld lmptr ptr
if cstr == nullPtr
then return []
else do str <- peekCString cstr
ldap_memfree cstr
bptr <- peek ptr
values <- getvalues cld lmptr str
nextitems <- getnextitems cld lmptr bptr
return $ (str, values):nextitems
getnextitems :: Ptr CLDAP -> Ptr CLDAPMessage -> Ptr BerElement
-> IO [(String, [String])]
getnextitems cld lmptr bptr =
do cstr <- ldap_next_attribute cld lmptr bptr
if cstr == nullPtr
then return []
else do str <- peekCString cstr
ldap_memfree cstr
values <- getvalues cld lmptr str
nextitems <- getnextitems cld lmptr bptr
return $ (str, values):nextitems
getvalues :: LDAPPtr -> Ptr CLDAPMessage -> String -> IO [String]
getvalues cld clm attr =
withCString attr (\cattr ->
do berarr <- ldap_get_values_len cld clm cattr
if berarr == nullPtr
-- Work around bug between Fedora DS and OpenLDAP (ldapvi
-- does the same thing)
then return []
else finally (procberarr berarr) (ldap_value_free_len berarr)
)
procberarr :: Ptr (Ptr Berval) -> IO [String]
procberarr pbv =
do bvl <- peekArray0 nullPtr pbv
mapM bv2str bvl
foreign import ccall unsafe "ldap.h ldap_get_dn"
ldap_get_dn :: LDAPPtr -> Ptr CLDAPMessage -> IO CString
foreign import ccall unsafe "ldap.h ldap_get_values_len"
ldap_get_values_len :: LDAPPtr -> Ptr CLDAPMessage -> CString -> IO (Ptr (Ptr Berval))
foreign import ccall unsafe "ldap.h ldap_value_free_len"
ldap_value_free_len :: Ptr (Ptr Berval) -> IO ()
foreign import ccall safe "ldap.h ldap_search"
ldap_search :: LDAPPtr -> CString -> LDAPInt -> CString -> Ptr CString ->
LDAPInt -> IO LDAPInt
foreign import ccall unsafe "ldap.h ldap_first_entry"
ldap_first_entry :: LDAPPtr -> Ptr CLDAPMessage -> IO (Ptr CLDAPMessage)
foreign import ccall unsafe "ldap.h ldap_first_attribute"
ldap_first_attribute :: LDAPPtr -> Ptr CLDAPMessage -> Ptr (Ptr BerElement)
-> IO CString
foreign import ccall unsafe "ldap.h ldap_next_attribute"
ldap_next_attribute :: LDAPPtr -> Ptr CLDAPMessage -> Ptr BerElement
-> IO CString
|
