From d776b838db944767dd0d60fbfcda68d961e1f1d2 Mon Sep 17 00:00:00 2001 From: jecaro Date: Wed, 9 Mar 2022 10:13:30 +0100 Subject: [PATCH 1/3] Expose ldap_init_fd --- LDAP/Data.hsc | 36 +++++++++++++++++++++++++++++++++--- LDAP/Init.hsc | 21 +++++++++++++++++++++ utils/genconsts.hs | 6 +++++- 3 files changed, 59 insertions(+), 4 deletions(-) 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..e7b4182 100644 --- a/LDAP/Init.hsc +++ b/LDAP/Init.hsc @@ -23,6 +23,7 @@ Written by John Goerzen, jgoerzen\@complete.org module LDAP.Init(ldapOpen, ldapInit, ldapInitialize, + ldapInitFd, ldapSimpleBind, ldapExternalSaslBind) where @@ -32,6 +33,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 +94,22 @@ 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 {- | Bind to the remote server. -} ldapSimpleBind :: LDAP -- ^ LDAP Object @@ -128,6 +146,9 @@ 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 safe "ldap.h ldap_simple_bind_s" ldap_simple_bind_s :: LDAPPtr -> CString -> CString -> IO LDAPInt 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"] From bfb51e471a0fbf0fa757a07fa2b716570b908770 Mon Sep 17 00:00:00 2001 From: jecaro Date: Wed, 9 Mar 2022 17:44:40 +0100 Subject: [PATCH 2/3] Expose ldap_install_tls --- LDAP/Init.hsc | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/LDAP/Init.hsc b/LDAP/Init.hsc index e7b4182..4dd8d14 100644 --- a/LDAP/Init.hsc +++ b/LDAP/Init.hsc @@ -24,6 +24,7 @@ module LDAP.Init(ldapOpen, ldapInit, ldapInitialize, ldapInitFd, + ldapInstallTls, ldapSimpleBind, ldapExternalSaslBind) where @@ -111,6 +112,14 @@ ldapInitFd fd proto uri = 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 -> String -- ^ DN (Distinguished Name) @@ -149,6 +158,9 @@ foreign import ccall unsafe "ldap.h ldap_initialize" 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 From a6a27f3e8b03f06b6ce6d22a24dbbc56e88abf85 Mon Sep 17 00:00:00 2001 From: jecaro Date: Fri, 11 Mar 2022 10:22:03 +0100 Subject: [PATCH 3/3] Fix issue in string conversion peekCStringLen uses the local encoding to convert the bytes to an Haskell String. This can result in bytes dropped by the conversion if the sequence of bytes is not interpretable in the current encoding. We should actually use ByteString here as the value is not necessarily a String. Using the version peekCAStringLen ensures all the actual bytes end up in the Haskell String. Then one can convert it to a ByteString with Data.ByteString.Char8 --- LDAP/Utils.hsc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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! -}