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
|
{- -*- 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.Modify
Copyright : Copyright (C) 2005 John Goerzen
License : BSD
Maintainer : John Goerzen,
Maintainer : jgoerzen\@complete.org
Stability : provisional
Portability: portable
LDAP changes
Written by John Goerzen, jgoerzen\@complete.org
-}
module LDAP.Modify (-- * Basics
LDAPModOp(..), LDAPMod(..),
ldapAdd, ldapModify, ldapDelete,
-- * Utilities
list2ldm, pairs2ldm
)
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)
import Data.Bits
#include <ldap.h>
data LDAPMod = LDAPMod {modOp :: LDAPModOp -- ^ Type of operation to perform
,modType :: String -- ^ Name of attribute to edit
,modVals :: [String] -- ^ New values
}
deriving (Eq, Show)
ldapModify :: LDAP -- ^ LDAP connection object
-> String -- ^ DN to modify
-> [LDAPMod] -- ^ Changes to make
-> IO ()
ldapModify = genericChange "ldapModify" ldap_modify_s
ldapAdd :: LDAP -- ^ LDAP connection object
-> String -- ^ DN to add
-> [LDAPMod] -- ^ Items to add
-> IO ()
ldapAdd = genericChange "ldapAdd" ldap_add_s
genericChange name func ld dn changelist =
withLDAPPtr ld (\cld ->
withCString dn (\cdn ->
withCLDAPModArr0 changelist (\cmods ->
do checkLE name ld $ func cld cdn cmods
return ()
)))
{- | Delete the specified DN -}
ldapDelete :: LDAP -> String -> IO ()
ldapDelete ld dn =
withLDAPPtr ld (\cld ->
withCString dn (\cdn ->
do checkLE "ldapDelete" ld $ ldap_delete_s cld cdn
return ()
))
{- | Takes a list of name\/value points and converts them to LDAPMod
entries. Each item will have the specified 'LDAPModOp'. -}
list2ldm :: LDAPModOp -> [(String, [String])] -> [LDAPMod]
list2ldm mo = map (\(key, vals) -> LDAPMod {modOp = mo, modType = key,
modVals = vals}
)
{- | Similar to list2ldm, but handles pairs with only one value. -}
pairs2ldm :: LDAPModOp -> [(String, String)] -> [LDAPMod]
pairs2ldm mo = list2ldm mo . map (\(x, y) -> (x, [y]))
data CLDAPMod
newCLDAPMod :: LDAPMod -> IO (Ptr CLDAPMod)
newCLDAPMod lm =
do (ptr::(Ptr CLDAPMod)) <- mallocBytes #{size LDAPMod}
cmodtype <- newCString (modType lm)
let (cmodop::LDAPInt) =
(fromIntegral . fromEnum . modOp $ lm) .|.
#{const LDAP_MOD_BVALUES}
bervals <- mapM newBerval (modVals lm)
(arrptr::Ptr (Ptr Berval)) <- newArray0 nullPtr bervals
( #{poke LDAPMod, mod_op} ) ptr cmodop
( #{poke LDAPMod, mod_type } ) ptr cmodtype
( #{poke LDAPMod, mod_vals } ) ptr arrptr
return ptr
freeCLDAPMod :: Ptr CLDAPMod -> IO ()
freeCLDAPMod ptr =
do -- Free the array of Bervals
(arrptr::Ptr (Ptr Berval)) <- ( #{peek LDAPMod, mod_vals} ) ptr
(arr::[Ptr Berval]) <- peekArray0 nullPtr arrptr
mapM_ freeHSBerval arr
free arrptr
-- Free the modtype
(cmodtype::CString) <- ( #{peek LDAPMod, mod_type} ) ptr
free cmodtype
-- mod_op is an int and doesn't need freeing
-- free the LDAPMod itself.
free ptr
withCLDAPModArr0 :: [LDAPMod] -> (Ptr (Ptr CLDAPMod) -> IO a) -> IO a
withCLDAPModArr0 = withAnyArr0 newCLDAPMod freeCLDAPMod
foreign import ccall safe "ldap.h ldap_modify_s"
ldap_modify_s :: LDAPPtr -> CString -> Ptr (Ptr CLDAPMod) -> IO LDAPInt
foreign import ccall safe "ldap.h ldap_delete_s"
ldap_delete_s :: LDAPPtr -> CString -> IO LDAPInt
foreign import ccall safe "ldap.h ldap_add_s"
ldap_add_s :: LDAPPtr -> CString -> Ptr (Ptr CLDAPMod) -> IO LDAPInt
|
