{-# LINE 1 "LDAP/Init.hsc" #-}
{- -*- 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.Init
   Copyright  : Copyright (C) 2005 John Goerzen
   License    : BSD

   Maintainer : John Goerzen,
   Maintainer : jgoerzen\@complete.org
   Stability  : provisional
   Portability: portable

Initialization and shutdown for LDAP programs

Written by John Goerzen, jgoerzen\@complete.org
-}

module LDAP.Init(ldapOpen,
                 ldapInit,
                 ldapInitialize,
                 ldapSimpleBind,
                 ldapExternalSaslBind)
where

import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.C.String
import Foreign.Marshal.Alloc
import Foreign.Storable
import LDAP.Types
import Foreign.C.Types
import LDAP.Utils
import Foreign.Marshal.Utils




ldapSetVersion3 :: LDAPPtr -> IO LDAPInt
ldapSetVersion3 :: LDAPPtr -> IO LDAPInt
ldapSetVersion3 LDAPPtr
cld =
    LDAPInt -> (Ptr LDAPInt -> IO LDAPInt) -> IO LDAPInt
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with ((LDAPInt
3)::LDAPInt) ((Ptr LDAPInt -> IO LDAPInt) -> IO LDAPInt)
-> (Ptr LDAPInt -> IO LDAPInt) -> IO LDAPInt
forall a b. (a -> b) -> a -> b
$ \Ptr LDAPInt
copt ->
{-# LINE 46 "LDAP/Init.hsc" #-}
    ldap_set_option cld 17 (castPtr copt)
{-# LINE 47 "LDAP/Init.hsc" #-}

ldapSetRestart :: LDAPPtr -> IO LDAPInt
ldapSetRestart :: LDAPPtr -> IO LDAPInt
ldapSetRestart LDAPPtr
cld =
    LDAPInt -> (Ptr LDAPInt -> IO LDAPInt) -> IO LDAPInt
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with ((LDAPInt
94610915864640)::LDAPInt) ((Ptr LDAPInt -> IO LDAPInt) -> IO LDAPInt)
-> (Ptr LDAPInt -> IO LDAPInt) -> IO LDAPInt
forall a b. (a -> b) -> a -> b
$ \Ptr LDAPInt
copt ->
{-# LINE 51 "LDAP/Init.hsc" #-}
    ldap_set_option cld 9 (castPtr copt)
{-# LINE 52 "LDAP/Init.hsc" #-}

{- | Preferred way to initialize a LDAP connection. 
The default port is given in 'LDAP.Constants.ldapPort'.

Could throw IOError on failure. -}
ldapInit :: String              -- ^ Host
         -> LDAPInt             -- ^ Port
         -> IO LDAP             -- ^ New LDAP Obj
ldapInit :: String -> LDAPInt -> IO LDAP
ldapInit String
host LDAPInt
port =
    String -> (CString -> IO LDAP) -> IO LDAP
forall a. String -> (CString -> IO a) -> IO a
withCString String
host ((CString -> IO LDAP) -> IO LDAP)
-> (CString -> IO LDAP) -> IO LDAP
forall a b. (a -> b) -> a -> b
$ \CString
cs ->
       do LDAP
rv <- String -> IO LDAPPtr -> IO LDAP
fromLDAPPtr String
"ldapInit" (CString -> LDAPInt -> IO LDAPPtr
cldap_init CString
cs LDAPInt
port)
          LDAP -> (LDAPPtr -> IO LDAPInt) -> IO LDAPInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr LDAP
rv ((LDAPPtr -> IO LDAPInt) -> IO LDAPInt)
-> (LDAPPtr -> IO LDAPInt) -> IO LDAPInt
forall a b. (a -> b) -> a -> b
$ \LDAPPtr
cld -> do
              LDAPPtr -> IO LDAPInt
ldapSetVersion3 LDAPPtr
cld
              LDAPPtr -> IO LDAPInt
ldapSetRestart LDAPPtr
cld
          LDAP -> IO LDAP
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return LDAP
rv

{- | Like 'ldapInit', but establish network connection immediately. -}
ldapOpen :: String              -- ^ Host
            -> LDAPInt          -- ^ Port
            -> IO LDAP          -- ^ New LDAP Obj
ldapOpen :: String -> LDAPInt -> IO LDAP
ldapOpen String
host LDAPInt
port =
    String -> (CString -> IO LDAP) -> IO LDAP
forall a. String -> (CString -> IO a) -> IO a
withCString String
host (\CString
cs ->
        do LDAP
rv <- String -> IO LDAPPtr -> IO LDAP
fromLDAPPtr String
"ldapOpen" (CString -> LDAPInt -> IO LDAPPtr
cldap_open CString
cs LDAPInt
port)
           LDAP -> (LDAPPtr -> IO LDAPInt) -> IO LDAPInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr LDAP
rv LDAPPtr -> IO LDAPInt
ldapSetRestart
           LDAP -> IO LDAP
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return LDAP
rv)

{- | Like 'ldapInit', but accepts a URI (or whitespace/comma separated
list of URIs) which can contain a schema, a host and a port.  Besides
ldap, valid schemas are ldaps (LDAP over TLS), ldapi (LDAP over IPC),
and cldap (connectionless LDAP). -}
ldapInitialize :: String        -- ^ URI
                  -> IO LDAP    -- ^ New LDAP Obj
ldapInitialize :: String -> IO LDAP
ldapInitialize String
uri =
    String -> (CString -> IO LDAP) -> IO LDAP
forall a. String -> (CString -> IO a) -> IO a
withCString String
uri ((CString -> IO LDAP) -> IO LDAP)
-> (CString -> IO LDAP) -> IO LDAP
forall a b. (a -> b) -> a -> b
$ \CString
cs ->
    (Ptr LDAPPtr -> IO LDAP) -> IO LDAP
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr LDAPPtr -> IO LDAP) -> IO LDAP)
-> (Ptr LDAPPtr -> IO LDAP) -> IO LDAP
forall a b. (a -> b) -> a -> b
$ \Ptr LDAPPtr
pp -> do
    LDAPInt
r <- Ptr LDAPPtr -> CString -> IO LDAPInt
ldap_initialize Ptr LDAPPtr
pp CString
cs
    LDAP
ldap <- String -> IO LDAPPtr -> IO LDAP
fromLDAPPtr String
"ldapInitialize" (Ptr LDAPPtr -> IO LDAPPtr
forall a. Storable a => Ptr a -> IO a
peek Ptr LDAPPtr
pp)
    LDAPInt
_ <- String -> LDAP -> IO LDAPInt -> IO LDAPInt
checkLE String
"ldapInitialize" LDAP
ldap (LDAPInt -> IO LDAPInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return LDAPInt
r)
    LDAP -> (LDAPPtr -> IO LDAPInt) -> IO LDAPInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr LDAP
ldap ((LDAPPtr -> IO LDAPInt) -> IO LDAPInt)
-> (LDAPPtr -> IO LDAPInt) -> IO LDAPInt
forall a b. (a -> b) -> a -> b
$ \LDAPPtr
p -> do
        LDAPPtr -> IO LDAPInt
ldapSetVersion3 LDAPPtr
p
        LDAPPtr -> IO LDAPInt
ldapSetRestart LDAPPtr
p
    LDAP -> IO LDAP
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return LDAP
ldap


{- | Bind to the remote server. -}
ldapSimpleBind :: LDAP          -- ^ LDAP Object
               -> String        -- ^ DN (Distinguished Name)
               -> String        -- ^ Password
               -> IO ()
ldapSimpleBind :: LDAP -> String -> String -> IO ()
ldapSimpleBind LDAP
ld String
dn String
passwd =
    LDAP -> (LDAPPtr -> IO ()) -> IO ()
forall a. LDAP -> (LDAPPtr -> IO a) -> IO a
withLDAPPtr LDAP
ld (\LDAPPtr
ptr ->
     String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
dn (\CString
cdn ->
      String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
passwd (\CString
cpasswd -> 
        do String -> LDAP -> IO LDAPInt -> IO LDAPInt
checkLE String
"ldapSimpleBind" LDAP
ld
                            (LDAPPtr -> CString -> CString -> IO LDAPInt
ldap_simple_bind_s LDAPPtr
ptr CString
cdn CString
cpasswd)
           () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                         )))

{- | Bind with the SASL EXTERNAL mechanism. -}
ldapExternalSaslBind :: LDAP   -- ^ LDAP Object
                     -> String -- ^ Authorization identity (UTF-8 encoded; pass "" to derive it from the authentication identity)
                     -> IO ()
ldapExternalSaslBind :: LDAP -> String -> IO ()
ldapExternalSaslBind LDAP
ld String
authz =
    LDAP -> (LDAPPtr -> IO ()) -> IO ()
forall a. LDAP -> (LDAPPtr -> IO a) -> IO a
withLDAPPtr LDAP
ld (\LDAPPtr
ptr ->
     String -> (CStringLen -> IO ()) -> IO ()
forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
authz (\(CString
authzPtr,Int
authzLen) ->
        do String -> LDAP -> IO LDAPInt -> IO LDAPInt
checkLE String
"ldapExternalSaslBind" LDAP
ld (LDAPPtr -> CString -> Int -> IO LDAPInt
external_sasl_bind LDAPPtr
ptr CString
authzPtr Int
authzLen)
           () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      ))

foreign import ccall unsafe "ldap.h ldap_init"
  cldap_init :: CString -> CInt -> IO LDAPPtr


foreign import ccall safe "ldap.h ldap_open"
  cldap_open :: CString -> CInt -> IO LDAPPtr

foreign import ccall unsafe "ldap.h ldap_initialize"
  ldap_initialize :: Ptr LDAPPtr -> CString -> IO LDAPInt

foreign import ccall safe "ldap.h ldap_simple_bind_s"
  ldap_simple_bind_s :: LDAPPtr -> CString -> CString -> IO LDAPInt

foreign import ccall safe "sasl_external.h external_sasl_bind"
  external_sasl_bind :: LDAPPtr -> CString -> Int -> IO LDAPInt

foreign import ccall unsafe "ldap.h ldap_set_option"
  ldap_set_option :: LDAPPtr -> LDAPInt -> Ptr () -> IO LDAPInt