diff --git a/LDAP/Data.hsc b/LDAP/Data.hsc index f51749b..90b44e1 100644 --- a/LDAP/Data.hsc +++ b/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) + + diff --git a/LDAP/Init.hsc b/LDAP/Init.hsc index 7c94512..4dd8d14 100644 --- a/LDAP/Init.hsc +++ b/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 diff --git a/LDAP/Utils.hsc b/LDAP/Utils.hsc index 1102e81..d200d55 100644 --- a/LDAP/Utils.hsc +++ b/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! -} diff --git a/utils/genconsts.hs b/utils/genconsts.hs index b4dbd3a..610831e 100644 --- a/utils/genconsts.hs +++ b/utils/genconsts.hs @@ -54,7 +54,8 @@ 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 @@ -62,6 +63,7 @@ main = 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"]