{-# LINE 1 "LDAP/Utils.hsc" #-}
module LDAP.Utils(checkLE, checkLEe, checkLEn1,
checkNULL, LDAPPtr, fromLDAPPtr,
withLDAPPtr, maybeWithLDAPPtr, withMString,
withCStringArr0, ldap_memfree,
bv2str, newBerval, freeHSBerval,
withAnyArr0) where
import Foreign.Ptr
import LDAP.Constants
import LDAP.Exceptions
import LDAP.Types
import LDAP.Data
import LDAP.TypesLL
import Control.Exception
import Data.Dynamic
import Foreign.C.Error
import Foreign.C.String
import Foreign.ForeignPtr
import Foreign
import Foreign.C.Types
checkLE :: String -> LDAP -> IO LDAPInt -> IO LDAPInt
checkLE :: String -> LDAP -> IO LDAPInt -> IO LDAPInt
checkLE = (LDAPInt -> Bool) -> String -> LDAP -> IO LDAPInt -> IO LDAPInt
checkLEe (\LDAPInt
r -> LDAPInt
r LDAPInt -> LDAPInt -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> LDAPInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (LDAPReturnCode -> Int
forall a. Enum a => a -> Int
fromEnum LDAPReturnCode
LdapSuccess))
checkLEn1 :: String -> LDAP -> IO LDAPInt -> IO LDAPInt
checkLEn1 :: String -> LDAP -> IO LDAPInt -> IO LDAPInt
checkLEn1 = (LDAPInt -> Bool) -> String -> LDAP -> IO LDAPInt -> IO LDAPInt
checkLEe (\LDAPInt
r -> LDAPInt
r LDAPInt -> LDAPInt -> Bool
forall a. Eq a => a -> a -> Bool
/= -LDAPInt
1)
checkLEe :: (LDAPInt -> Bool) -> String -> LDAP -> IO LDAPInt -> IO LDAPInt
checkLEe :: (LDAPInt -> Bool) -> String -> LDAP -> IO LDAPInt -> IO LDAPInt
checkLEe LDAPInt -> Bool
test String
callername LDAP
ld IO LDAPInt
action =
do LDAPInt
result <- IO LDAPInt
action
if LDAPInt -> Bool
test LDAPInt
result
then LDAPInt -> IO LDAPInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return LDAPInt
result
else do LDAPInt
errornum <- LDAP -> LDAPOptionCode -> IO LDAPInt
ldapGetOptionIntNoEc LDAP
ld LDAPOptionCode
LdapOptErrorNumber
let hserror :: LDAPReturnCode
hserror = Int -> LDAPReturnCode
forall a. Enum a => Int -> a
toEnum (LDAPInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral LDAPInt
errornum)
String
err2string <- (LDAPInt -> IO (Ptr CChar)
ldap_err2string LDAPInt
errornum IO (Ptr CChar) -> (Ptr CChar -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr CChar -> IO String
peekCString)
Maybe String
objstring <- LDAP -> LDAPOptionCode -> IO (Maybe String)
ldapGetOptionStrNoEc LDAP
ld LDAPOptionCode
LdapOptErrorString
let desc :: String
desc = case Maybe String
objstring of
Maybe String
Nothing -> String
err2string
Just String
x -> String
err2string String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
let exc :: LDAPException
exc = LDAPException {code :: LDAPReturnCode
code = LDAPReturnCode
hserror,
description :: String
description = String
desc,
caller :: String
caller = String
callername }
LDAPException -> IO LDAPInt
forall a. LDAPException -> IO a
throwLDAP LDAPException
exc
checkNULL :: String -> IO (Ptr a) -> IO (Ptr a)
checkNULL :: forall a. String -> IO (Ptr a) -> IO (Ptr a)
checkNULL = String -> IO (Ptr a) -> IO (Ptr a)
forall a. String -> IO (Ptr a) -> IO (Ptr a)
throwErrnoIfNull
type LDAPPtr = Ptr CLDAP
fromLDAPPtr :: String -> IO LDAPPtr -> IO LDAP
fromLDAPPtr :: String -> IO LDAPPtr -> IO LDAP
fromLDAPPtr String
caller IO LDAPPtr
action =
do LDAPPtr
ptr <- String -> IO LDAPPtr -> IO LDAPPtr
forall a. String -> IO (Ptr a) -> IO (Ptr a)
checkNULL String
caller IO LDAPPtr
action
FinalizerPtr CLDAP -> LDAPPtr -> IO LDAP
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr CLDAP
ldap_unbind LDAPPtr
ptr
withLDAPPtr :: LDAP -> (LDAPPtr -> IO a) -> IO a
withLDAPPtr :: forall a. LDAP -> (LDAPPtr -> IO a) -> IO a
withLDAPPtr LDAP
ld = LDAP -> (LDAPPtr -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr LDAP
ld
maybeWithLDAPPtr :: Maybe LDAP -> (LDAPPtr -> IO a) -> IO a
maybeWithLDAPPtr :: forall a. Maybe LDAP -> (LDAPPtr -> IO a) -> IO a
maybeWithLDAPPtr Maybe LDAP
Nothing LDAPPtr -> IO a
func = LDAPPtr -> IO a
func LDAPPtr
forall a. Ptr a
nullPtr
maybeWithLDAPPtr (Just LDAP
x) LDAPPtr -> IO a
y = LDAP -> (LDAPPtr -> IO a) -> IO a
forall a. LDAP -> (LDAPPtr -> IO a) -> IO a
withLDAPPtr LDAP
x LDAPPtr -> IO a
y
ldapGetOptionIntNoEc :: LDAP -> LDAPOptionCode -> IO LDAPInt
ldapGetOptionIntNoEc :: LDAP -> LDAPOptionCode -> IO LDAPInt
ldapGetOptionIntNoEc LDAP
ld LDAPOptionCode
oc =
LDAP -> (LDAPPtr -> IO LDAPInt) -> IO LDAPInt
forall a. LDAP -> (LDAPPtr -> IO a) -> IO a
withLDAPPtr LDAP
ld (\LDAPPtr
pld -> (Ptr LDAPInt -> IO LDAPInt) -> IO LDAPInt
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca (LDAPPtr -> Ptr LDAPInt -> IO LDAPInt
f LDAPPtr
pld))
where oci :: LDAPInt
oci = Int -> LDAPInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> LDAPInt) -> Int -> LDAPInt
forall a b. (a -> b) -> a -> b
$ LDAPOptionCode -> Int
forall a. Enum a => a -> Int
fromEnum LDAPOptionCode
oc
f :: LDAPPtr -> Ptr LDAPInt -> IO LDAPInt
f LDAPPtr
pld (Ptr LDAPInt
ptr::Ptr LDAPInt) =
do LDAPInt
res <- LDAPPtr -> LDAPInt -> Ptr () -> IO LDAPInt
ldap_get_option LDAPPtr
pld LDAPInt
oci (Ptr LDAPInt -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr LDAPInt
ptr)
if LDAPInt
res LDAPInt -> LDAPInt -> Bool
forall a. Eq a => a -> a -> Bool
/= LDAPInt
0
then String -> IO LDAPInt
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO LDAPInt) -> String -> IO LDAPInt
forall a b. (a -> b) -> a -> b
$ String
"Crash in int ldap_get_option, code " String -> String -> String
forall a. [a] -> [a] -> [a]
++ LDAPInt -> String
forall a. Show a => a -> String
show LDAPInt
res
else Ptr LDAPInt -> IO LDAPInt
forall a. Storable a => Ptr a -> IO a
peek Ptr LDAPInt
ptr
ldapGetOptionStrNoEc :: LDAP -> LDAPOptionCode -> IO (Maybe String)
ldapGetOptionStrNoEc :: LDAP -> LDAPOptionCode -> IO (Maybe String)
ldapGetOptionStrNoEc LDAP
ld LDAPOptionCode
oc =
LDAP -> (LDAPPtr -> IO (Maybe String)) -> IO (Maybe String)
forall a. LDAP -> (LDAPPtr -> IO a) -> IO a
withLDAPPtr LDAP
ld (\LDAPPtr
pld -> (Ptr (Ptr CChar) -> IO (Maybe String)) -> IO (Maybe String)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca (LDAPPtr -> Ptr (Ptr CChar) -> IO (Maybe String)
f LDAPPtr
pld))
where
oci :: Int
oci = LDAPOptionCode -> Int
forall a. Enum a => a -> Int
fromEnum LDAPOptionCode
oc
f :: LDAPPtr -> Ptr (Ptr CChar) -> IO (Maybe String)
f LDAPPtr
pld (Ptr (Ptr CChar)
ptr::Ptr CString) =
do LDAPInt
res <- LDAPPtr -> LDAPInt -> Ptr () -> IO LDAPInt
ldap_get_option LDAPPtr
pld (Int -> LDAPInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
oci) (Ptr (Ptr CChar) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Ptr CChar)
ptr)
if LDAPInt
res LDAPInt -> LDAPInt -> Bool
forall a. Eq a => a -> a -> Bool
/= LDAPInt
0
then String -> IO (Maybe String)
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO (Maybe String)) -> String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String
"Crash in str ldap_get_option, code " String -> String -> String
forall a. [a] -> [a] -> [a]
++ LDAPInt -> String
forall a. Show a => a -> String
show LDAPInt
res
else do Ptr CChar
cstr <- Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
ptr
ForeignPtr CChar
fp <- Ptr CChar -> IO (ForeignPtr CChar)
wrap_memfree Ptr CChar
cstr
ForeignPtr CChar
-> (Ptr CChar -> IO (Maybe String)) -> IO (Maybe String)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CChar
fp (\Ptr CChar
cs ->
do if Ptr CChar
cs Ptr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CChar
forall a. Ptr a
nullPtr
then Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
else do String
hstr <- Ptr CChar -> IO String
peekCString Ptr CChar
cs
Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
hstr
)
wrap_memfree :: CString -> IO (ForeignPtr Foreign.C.Types.CChar)
wrap_memfree :: Ptr CChar -> IO (ForeignPtr CChar)
wrap_memfree Ptr CChar
p = FinalizerPtr CChar -> Ptr CChar -> IO (ForeignPtr CChar)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr CChar
ldap_memfree_call Ptr CChar
p
withMString :: Maybe String -> (CString -> IO a) -> IO a
withMString :: forall a. Maybe String -> (Ptr CChar -> IO a) -> IO a
withMString Maybe String
Nothing Ptr CChar -> IO a
action = Ptr CChar -> IO a
action (Ptr CChar
forall a. Ptr a
nullPtr)
withMString (Just String
str) Ptr CChar -> IO a
action = String -> (Ptr CChar -> IO a) -> IO a
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
str Ptr CChar -> IO a
action
withCStringArr0 :: [String] -> (Ptr CString -> IO a) -> IO a
withCStringArr0 :: forall a. [String] -> (Ptr (Ptr CChar) -> IO a) -> IO a
withCStringArr0 [String]
inp Ptr (Ptr CChar) -> IO a
action = (String -> IO (Ptr CChar))
-> (Ptr CChar -> IO ())
-> [String]
-> (Ptr (Ptr CChar) -> IO a)
-> IO a
forall a b c.
(a -> IO (Ptr b))
-> (Ptr b -> IO ()) -> [a] -> (Ptr (Ptr b) -> IO c) -> IO c
withAnyArr0 String -> IO (Ptr CChar)
newCString Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
free [String]
inp Ptr (Ptr CChar) -> IO a
action
withAnyArr0 :: (a -> IO (Ptr b))
-> (Ptr b -> IO ())
-> [a]
-> (Ptr (Ptr b) -> IO c)
-> IO c
withAnyArr0 :: forall a b c.
(a -> IO (Ptr b))
-> (Ptr b -> IO ()) -> [a] -> (Ptr (Ptr b) -> IO c) -> IO c
withAnyArr0 a -> IO (Ptr b)
input2ptract Ptr b -> IO ()
freeact [a]
inp Ptr (Ptr b) -> IO c
action =
IO [Ptr b] -> ([Ptr b] -> IO ()) -> ([Ptr b] -> IO c) -> IO c
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket ((a -> IO (Ptr b)) -> [a] -> IO [Ptr b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM a -> IO (Ptr b)
input2ptract [a]
inp)
(\[Ptr b]
clist -> (Ptr b -> IO ()) -> [Ptr b] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Ptr b -> IO ()
freeact [Ptr b]
clist)
(\[Ptr b]
clist -> Ptr b -> [Ptr b] -> (Ptr (Ptr b) -> IO c) -> IO c
forall a b. Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b
withArray0 Ptr b
forall a. Ptr a
nullPtr [Ptr b]
clist Ptr (Ptr b) -> IO c
action)
withBervalArr0 :: [String] -> (Ptr (Ptr Berval) -> IO a) -> IO a
withBervalArr0 :: forall a. [String] -> (Ptr (Ptr Berval) -> IO a) -> IO a
withBervalArr0 = (String -> IO (Ptr Berval))
-> (Ptr Berval -> IO ())
-> [String]
-> (Ptr (Ptr Berval) -> IO a)
-> IO a
forall a b c.
(a -> IO (Ptr b))
-> (Ptr b -> IO ()) -> [a] -> (Ptr (Ptr b) -> IO c) -> IO c
withAnyArr0 String -> IO (Ptr Berval)
newBerval Ptr Berval -> IO ()
freeHSBerval
bv2str :: Ptr Berval -> IO String
bv2str :: Ptr Berval -> IO String
bv2str Ptr Berval
bptr =
do (BERLen
len::BERLen) <- ( (\Ptr Berval
hsc_ptr -> Ptr Berval -> Int -> IO BERLen
forall b. Ptr b -> Int -> IO BERLen
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Berval
hsc_ptr Int
0) ) Ptr Berval
bptr
{-# LINE 170 "LDAP/Utils.hsc" #-}
cstr <- ( (\hsc_ptr -> peekByteOff hsc_ptr 8) ) bptr
{-# LINE 171 "LDAP/Utils.hsc" #-}
peekCStringLen (cstr, fromIntegral len)
newBerval :: String -> IO (Ptr Berval)
newBerval :: String -> IO (Ptr Berval)
newBerval String
str =
do (Ptr Berval
ptr::Ptr Berval) <- Int -> IO (Ptr Berval)
forall a. Int -> IO (Ptr a)
mallocBytes (Int
16)
{-# LINE 178 "LDAP/Utils.hsc" #-}
(Ptr CChar
cstr, Int
len) <- String -> IO CStringLen
newCStringLen String
str
let (BERLen
clen::BERLen) = Int -> BERLen
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len
( (\Ptr Berval
hsc_ptr -> Ptr Berval -> Int -> BERLen -> IO ()
forall b. Ptr b -> Int -> BERLen -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Berval
hsc_ptr Int
0) ) Ptr Berval
ptr BERLen
clen
{-# LINE 181 "LDAP/Utils.hsc" #-}
( (\Ptr Berval
hsc_ptr -> Ptr Berval -> Int -> Ptr CChar -> IO ()
forall b. Ptr b -> Int -> Ptr CChar -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Berval
hsc_ptr Int
8) ) Ptr Berval
ptr Ptr CChar
cstr
{-# LINE 182 "LDAP/Utils.hsc" #-}
Ptr Berval -> IO (Ptr Berval)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Berval
ptr
freeHSBerval :: Ptr Berval -> IO ()
freeHSBerval :: Ptr Berval -> IO ()
freeHSBerval Ptr Berval
ptr =
do Ptr Any
cstr <- ( (\Ptr Berval
hsc_ptr -> Ptr Berval -> Int -> IO (Ptr Any)
forall b. Ptr b -> Int -> IO (Ptr Any)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Berval
hsc_ptr Int
8) ) Ptr Berval
ptr
{-# LINE 188 "LDAP/Utils.hsc" #-}
free cstr
Ptr Berval -> IO ()
forall a. Ptr a -> IO ()
free Ptr Berval
ptr
foreign import ccall unsafe "ldap.h &ldap_unbind"
ldap_unbind :: FunPtr (LDAPPtr -> IO ())
foreign import ccall unsafe "ldap.h ldap_err2string"
ldap_err2string :: LDAPInt -> IO CString
foreign import ccall unsafe "ldap.h ldap_get_option"
ldap_get_option :: LDAPPtr -> LDAPInt -> Ptr () -> IO LDAPInt
foreign import ccall unsafe "ldap.h &ldap_memfree"
ldap_memfree_call :: FunPtr (CString -> IO ())
foreign import ccall unsafe "ldap.h ldap_memfree"
ldap_memfree :: CString -> IO ()