Expose fcts and fix string conversion

LDAP/Data.hsc

@@ -17,6 +17,7 @@ Written by John Goerzen, jgoerzen\@complete.org
 module LDAP.Data (module LDAP.Data) where
 
 #include "ldap.h"
+#include "openldap.h"
 
 
 data LDAPReturnCode =
@@ -47,7 +48,7 @@ data LDAPReturnCode =
  | LdapInvalidDnSyntax
  | LdapIsLeaf
  | LdapAliasDerefProblem
- | LdapProxyAuthzFailure
+ | LdapXProxyAuthzFailure
  | LdapInappropriateAuth
  | LdapInvalidCredentials
  | LdapInsufficientAccess
@@ -113,7 +114,7 @@ instance Enum LDAPReturnCode where
  toEnum (#{const LDAP_INVALID_DN_SYNTAX}) = LdapInvalidDnSyntax
  toEnum (#{const LDAP_IS_LEAF}) = LdapIsLeaf
  toEnum (#{const LDAP_ALIAS_DEREF_PROBLEM}) = LdapAliasDerefProblem
- toEnum (#{const LDAP_X_PROXY_AUTHZ_FAILURE}) = LdapProxyAuthzFailure
+ toEnum (#{const LDAP_X_PROXY_AUTHZ_FAILURE}) = LdapXProxyAuthzFailure
  toEnum (#{const LDAP_INAPPROPRIATE_AUTH}) = LdapInappropriateAuth
  toEnum (#{const LDAP_INVALID_CREDENTIALS}) = LdapInvalidCredentials
  toEnum (#{const LDAP_INSUFFICIENT_ACCESS}) = LdapInsufficientAccess
@@ -176,7 +177,7 @@ instance Enum LDAPReturnCode where
  fromEnum LdapInvalidDnSyntax = (#{const LDAP_INVALID_DN_SYNTAX})
  fromEnum LdapIsLeaf = (#{const LDAP_IS_LEAF})
  fromEnum LdapAliasDerefProblem = (#{const LDAP_ALIAS_DEREF_PROBLEM})
- fromEnum LdapProxyAuthzFailure = (#{const LDAP_X_PROXY_AUTHZ_FAILURE})
+ fromEnum LdapXProxyAuthzFailure = (#{const LDAP_X_PROXY_AUTHZ_FAILURE})
  fromEnum LdapInappropriateAuth = (#{const LDAP_INAPPROPRIATE_AUTH})
  fromEnum LdapInvalidCredentials = (#{const LDAP_INVALID_CREDENTIALS})
  fromEnum LdapInsufficientAccess = (#{const LDAP_INSUFFICIENT_ACCESS})
@@ -342,3 +343,32 @@ instance Eq LDAPModOp where
  x == y = (fromEnum x) == (fromEnum y)
 
 
+data LDAPProto =
+   LdapProtoTcp
+ | LdapProtoUdp
+ | LdapProtoIpc
+ | LdapProtoExt
+ | UnknownLDAPProto Int
+
+ deriving (Show)
+
+instance Enum LDAPProto where
+ toEnum (#{const LDAP_PROTO_TCP}) = LdapProtoTcp
+ toEnum (#{const LDAP_PROTO_UDP}) = LdapProtoUdp
+ toEnum (#{const LDAP_PROTO_IPC}) = LdapProtoIpc
+ toEnum (#{const LDAP_PROTO_EXT}) = LdapProtoExt
+ toEnum x = UnknownLDAPProto x
+
+ fromEnum LdapProtoTcp = (#{const LDAP_PROTO_TCP})
+ fromEnum LdapProtoUdp = (#{const LDAP_PROTO_UDP})
+ fromEnum LdapProtoIpc = (#{const LDAP_PROTO_IPC})
+ fromEnum LdapProtoExt = (#{const LDAP_PROTO_EXT})
+ fromEnum (UnknownLDAPProto x) = x
+
+instance Ord LDAPProto where
+ compare x y = compare (fromEnum x) (fromEnum y)
+
+instance Eq LDAPProto where
+ x == y = (fromEnum x) == (fromEnum y)
+
+

LDAP/Init.hsc

@@ -23,6 +23,8 @@ Written by John Goerzen, jgoerzen\@complete.org
 module LDAP.Init(ldapOpen,
                  ldapInit,
                  ldapInitialize,
+                 ldapInitFd,
+                 ldapInstallTls,
                  ldapSimpleBind,
                  ldapExternalSaslBind)
 where
@@ -32,6 +34,7 @@ import Foreign.ForeignPtr
 import Foreign.C.String
 import Foreign.Marshal.Alloc
 import Foreign.Storable
+import LDAP.Data
 import LDAP.Types
 import Foreign.C.Types
 import LDAP.Utils
@@ -92,6 +95,30 @@ ldapInitialize uri =
         ldapSetRestart p
     return ldap
 
+{- | Allows an LDAP structure to be initialized using an already-opened
+connection. -}
+ldapInitFd :: CInt          -- ^ File descriptor
+              -> LDAPProto  -- ^ Protocol
+              -> String     -- ^ URI
+              -> IO LDAP    -- ^ New LDAP Obj
+ldapInitFd fd proto uri =
+    withCString uri $ \cs ->
+        alloca $ \pp -> do
+            r <- cldap_init_fd fd (fromIntegral $ fromEnum proto) cs pp
+            ldap <- fromLDAPPtr "ldapInitFd" (peek pp)
+            _ <- checkLE "ldapInitFd" ldap (return r)
+            withForeignPtr ldap $ \p -> do
+                ldapSetVersion3 p
+                ldapSetRestart p
+            return ldap
+
+ldapInstallTls :: LDAP -- ^ LDAP Object
+               -> IO ()
+ldapInstallTls ld =
+    withLDAPPtr ld (\ptr -> do
+        r <- cldap_install_tls ptr
+        _ <- checkLE "ldapInstallTls" ld (return r)
+        return ())
 
 {- | Bind to the remote server. -}
 ldapSimpleBind :: LDAP          -- ^ LDAP Object
@@ -128,6 +155,12 @@ foreign import ccall safe "ldap.h ldap_open"
 foreign import ccall unsafe "ldap.h ldap_initialize"
   ldap_initialize :: Ptr LDAPPtr -> CString -> IO LDAPInt
 
+foreign import ccall unsafe "openldap.h ldap_init_fd"
+  cldap_init_fd :: CInt -> CInt -> CString -> Ptr LDAPPtr -> IO LDAPInt
+
+foreign import ccall unsafe "ldap.h ldap_install_tls"
+  cldap_install_tls :: LDAPPtr -> IO LDAPInt
+
 foreign import ccall safe "ldap.h ldap_simple_bind_s"
   ldap_simple_bind_s :: LDAPPtr -> CString -> CString -> IO LDAPInt
 

LDAP/Utils.hsc

@@ -168,7 +168,7 @@ bv2str :: Ptr Berval -> IO String
 bv2str bptr = 
     do (len::BERLen) <- ( #{peek struct berval, bv_len} ) bptr
        cstr <- ( #{peek struct berval, bv_val} ) bptr
-       peekCStringLen (cstr, fromIntegral len)
+       peekCAStringLen (cstr, fromIntegral len)
 
 {- | Must be freed later with freeHSBerval! -}
 

utils/genconsts.hs

@@ -54,14 +54,16 @@ modHeader =
  "Written by John Goerzen, jgoerzen\\@complete.org\n" ++
  "-}\n\n" ++
  "module LDAP.Data (module LDAP.Data) where\n" ++
- "\n#include \"ldap.h\"\n\n"
+ "\n#include \"ldap.h\"\n" ++
+ "#include \"openldap.h\"\n\n"
 
 main = 
     do putStrLn modHeader
        putStrLn (errorClause "LDAPReturnCode" errorConsts)
        putStrLn (errorClause "LDAPOptionCode" optionConsts)
        putStrLn (errorClause "LDAPScope" scopeConsts)
        putStrLn (errorClause "LDAPModOp" modConsts)
+       putStrLn (errorClause "LDAPProto" protoConsts)
 
 errorConsts = [
       "LDAP_SUCCESS", "LDAP_OPERATIONS_ERROR", "LDAP_PROTOCOL_ERROR", 
@@ -104,3 +106,5 @@ scopeConsts = [
       "LDAP_SCOPE_SUBTREE"]
 
 modConsts = ["LDAP_MOD_ADD", "LDAP_MOD_DELETE", "LDAP_MOD_REPLACE"]
+
+protoConsts = ["LDAP_PROTO_TCP", "LDAP_PROTO_UDP", "LDAP_PROTO_IPC", "LDAP_PROTO_EXT"]