diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,5 @@ +0.6.11 +====== + + * Added `ldapExternalSaslBind`. + diff --git a/LDAP.cabal b/LDAP.cabal --- a/LDAP.cabal +++ b/LDAP.cabal @@ -1,27 +1,31 @@ +cabal-version: >=1.8 + Name: LDAP -Version: 0.6.6 +Version: 0.6.11 License: BSD3 -Maintainer: John Goerzen -Author: John Goerzen +Maintainer: Edward Z. Yang +Author: John Goerzen, Edward Z. Yang Stability: Beta -Copyright: Copyright (c) 2005-2010 John Goerzen -homepage: http://software.complete.org/ldap-haskell +Copyright: Copyright (c) 2005-2017 John Goerzen, Edward Z. Yang +homepage: https://github.com/ezyang/ldap-haskell Category: Network Synopsis: Haskell binding for C LDAP API Description: This package provides LDAP interface code for Haskell programs, binding to the C LDAP API. license-file: COPYRIGHT -extra-source-files: COPYING +extra-source-files: + COPYING + ChangeLog.md + sasl_external.h Build-Type: Simple -Cabal-Version: >=1.2.3 Flag buildtests description: Build the executable to run unit tests default: False Library - -- C-Sources: glue/glue.c + C-Sources: sasl_external.c Exposed-Modules: LDAP, LDAP.Types, LDAP.Init, @@ -37,22 +41,43 @@ build-depends: base >= 4 && <5 - Extra-Libraries: ldap + Extra-Libraries: ldap, lber + GHC-Options: -O2 - -- CC-Options: -Iglue - CC-Options: -DLDAP_DEPRECATED=1 + if os(openbsd) + CC-Options: -DLDAP_X_PROXY_AUTHZ_FAILURE=LDAP_PROXY_AUTHZ_FAILURE + else + CC-Options: -DLDAP_DEPRECATED=1 Extensions: ForeignFunctionInterface, TypeSynonymInstances, EmptyDataDecls, ScopedTypeVariables, CPP +Test-Suite test-ldap + type: exitcode-stdio-1.0 + main-is: runtests.hs + Extra-Libraries: ldap, lber + build-depends: base >= 4 && < 5, + LDAP, + HUnit + if os(openbsd) + CC-Options: -DLDAP_X_PROXY_AUTHZ_FAILURE=LDAP_PROXY_AUTHZ_FAILURE + else + CC-Options: -DLDAP_DEPRECATED=1 + GHC-Options: -O2 + Extensions: ForeignFunctionInterface, TypeSynonymInstances, + EmptyDataDecls, ScopedTypeVariables, CPP + hs-source-dirs: testsrc, . + Executable runtests if flag(buildtests) Buildable: True else Buildable: False - Extra-Libraries: ldap Main-Is: runtests.hs - CC-Options: -DLDAP_DEPRECATED=1 + if os(openbsd) + CC-Options: -DLDAP_X_PROXY_AUTHZ_FAILURE=LDAP_PROXY_AUTHZ_FAILURE + else + CC-Options: -DLDAP_DEPRECATED=1 Extensions: ForeignFunctionInterface, TypeSynonymInstances, EmptyDataDecls, ScopedTypeVariables, CPP Hs-Source-Dirs: testsrc, . diff --git a/LDAP/Exceptions.hs b/LDAP/Exceptions.hs --- a/LDAP/Exceptions.hs +++ b/LDAP/Exceptions.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveDataTypeable #-} {- -*- Mode: haskell; -*- Haskell LDAP Interface Copyright (C) 2005-2009 John Goerzen @@ -47,6 +48,7 @@ description :: String, -- ^ Description of error caller :: String -- ^ Calling function } + deriving (Typeable) instance Show LDAPException where show x = caller x ++ ": LDAPException " ++ show (code x) ++ "(" ++ show (fromEnum $ code x) ++ "): " ++ @@ -57,12 +59,6 @@ instance Ord LDAPException where compare x y = compare (code x) (code y) - -instance Typeable LDAPException where - typeOf _ = mkTyConApp ldapExceptionTc [] - -ldapExceptionTc :: TyCon -ldapExceptionTc = mkTyCon "LDAP.LDAPException" #if __GLASGOW_HASKELL__ >= 610 instance Exception LDAPException where diff --git a/LDAP/Init.hsc b/LDAP/Init.hsc --- a/LDAP/Init.hsc +++ b/LDAP/Init.hsc @@ -22,11 +22,16 @@ module LDAP.Init(ldapOpen, ldapInit, - ldapSimpleBind) + 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 @@ -34,6 +39,17 @@ #include + +ldapSetVersion3 :: LDAPPtr -> IO LDAPInt +ldapSetVersion3 cld = + with ((#{const LDAP_VERSION3})::LDAPInt) $ \copt -> + ldap_set_option cld #{const LDAP_OPT_PROTOCOL_VERSION} (castPtr copt) + +ldapSetRestart :: LDAPPtr -> IO LDAPInt +ldapSetRestart cld = + with ((#{const LDAP_OPT_ON})::LDAPInt) $ \copt -> + ldap_set_option cld #{const LDAP_OPT_RESTART} (castPtr copt) + {- | Preferred way to initialize a LDAP connection. The default port is given in 'LDAP.Constants.ldapPort'. @@ -42,13 +58,12 @@ -> LDAPInt -- ^ Port -> IO LDAP -- ^ New LDAP Obj ldapInit host port = - withCString host (\cs -> - with ((#{const LDAP_VERSION3})::LDAPInt) (\copt -> - do cld <- cldap_init cs port - rv <- fromLDAPPtr "ldapInit" (return cld) - ldap_set_option cld #{const LDAP_OPT_PROTOCOL_VERSION} (castPtr copt) + withCString host $ \cs -> + do rv <- fromLDAPPtr "ldapInit" (cldap_init cs port) + withForeignPtr rv $ \cld -> do + ldapSetVersion3 cld + ldapSetRestart cld return rv - )) {- | Like 'ldapInit', but establish network connection immediately. -} ldapOpen :: String -- ^ Host @@ -56,8 +71,28 @@ -> IO LDAP -- ^ New LDAP Obj ldapOpen host port = withCString host (\cs -> - fromLDAPPtr "ldapOpen" $ cldap_open cs port) + do rv <- fromLDAPPtr "ldapOpen" (cldap_open cs port) + withForeignPtr rv ldapSetRestart + return 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 uri = + withCString uri $ \cs -> + alloca $ \pp -> do + r <- ldap_initialize pp cs + ldap <- fromLDAPPtr "ldapInitialize" (peek pp) + _ <- checkLE "ldapInitialize" ldap (return r) + withForeignPtr ldap $ \p -> do + ldapSetVersion3 p + ldapSetRestart p + return ldap + + {- | Bind to the remote server. -} ldapSimpleBind :: LDAP -- ^ LDAP Object -> String -- ^ DN (Distinguished Name) @@ -72,15 +107,32 @@ 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 ld authz = + withLDAPPtr ld (\ptr -> + withCStringLen authz (\(authzPtr,authzLen) -> + do checkLE "ldapExternalSaslBind" ld (external_sasl_bind ptr authzPtr authzLen) + return () + )) + foreign import ccall unsafe "ldap.h ldap_init" cldap_init :: CString -> CInt -> IO LDAPPtr -foreign import ccall unsafe "ldap.h ldap_open" +foreign import ccall safe "ldap.h ldap_open" cldap_open :: CString -> CInt -> IO LDAPPtr -foreign import ccall unsafe "ldap.h ldap_simple_bind_s" +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 diff --git a/LDAP/Modify.hsc b/LDAP/Modify.hsc --- a/LDAP/Modify.hsc +++ b/LDAP/Modify.hsc @@ -34,6 +34,9 @@ import LDAP.Data import Foreign import Foreign.C.String +#if (__GLASGOW_HASKELL__>=705) +import Foreign.C.Types(CInt(..)) +#endif import LDAP.Result import Control.Exception(finally) import Data.Bits @@ -119,11 +122,11 @@ withCLDAPModArr0 :: [LDAPMod] -> (Ptr (Ptr CLDAPMod) -> IO a) -> IO a withCLDAPModArr0 = withAnyArr0 newCLDAPMod freeCLDAPMod -foreign import ccall unsafe "ldap.h ldap_modify_s" +foreign import ccall safe "ldap.h ldap_modify_s" ldap_modify_s :: LDAPPtr -> CString -> Ptr (Ptr CLDAPMod) -> IO LDAPInt -foreign import ccall unsafe "ldap.h ldap_delete_s" +foreign import ccall safe "ldap.h ldap_delete_s" ldap_delete_s :: LDAPPtr -> CString -> IO LDAPInt -foreign import ccall unsafe "ldap.h ldap_add_s" +foreign import ccall safe "ldap.h ldap_add_s" ldap_add_s :: LDAPPtr -> CString -> Ptr (Ptr CLDAPMod) -> IO LDAPInt diff --git a/LDAP/Result.hsc b/LDAP/Result.hsc --- a/LDAP/Result.hsc +++ b/LDAP/Result.hsc @@ -27,6 +27,9 @@ import LDAP.Utils import LDAP.Types import Foreign +#if (__GLASGOW_HASKELL__>=705) +import Foreign.C.Types(CInt(..)) +#endif #include @@ -51,7 +54,7 @@ then fail (caller ++ ": got null LDAPMessage pointer") else newForeignPtr ldap_msgfree_call ptr -foreign import ccall unsafe "ldap.h ldap_result" +foreign import ccall safe "ldap.h ldap_result" ldap_result :: LDAPPtr -> LDAPInt -> LDAPInt -> Ptr () -> Ptr (Ptr CLDAPMessage) -> IO LDAPInt foreign import ccall unsafe "ldap.h &ldap_msgfree" diff --git a/LDAP/Search.hsc b/LDAP/Search.hsc --- a/LDAP/Search.hsc +++ b/LDAP/Search.hsc @@ -32,6 +32,9 @@ import LDAP.Data import Foreign import Foreign.C.String +#if (__GLASGOW_HASKELL__>=705) +import Foreign.C.Types(CInt(..)) +#endif import LDAP.Result import Control.Exception(finally) @@ -129,7 +132,11 @@ getvalues cld clm attr = withCString attr (\cattr -> do berarr <- ldap_get_values_len cld clm cattr - finally (procberarr berarr) (ldap_value_free_len berarr) + if berarr == nullPtr + -- Work around bug between Fedora DS and OpenLDAP (ldapvi + -- does the same thing) + then return [] + else finally (procberarr berarr) (ldap_value_free_len berarr) ) procberarr :: Ptr (Ptr Berval) -> IO [String] @@ -146,7 +153,7 @@ foreign import ccall unsafe "ldap.h ldap_value_free_len" ldap_value_free_len :: Ptr (Ptr Berval) -> IO () -foreign import ccall unsafe "ldap.h ldap_search" +foreign import ccall safe "ldap.h ldap_search" ldap_search :: LDAPPtr -> CString -> LDAPInt -> CString -> Ptr CString -> LDAPInt -> IO LDAPInt diff --git a/sasl_external.c b/sasl_external.c new file mode 100644 --- /dev/null +++ b/sasl_external.c @@ -0,0 +1,39 @@ +#include +#include + +#include "sasl_external.h" + +struct external_defaults { + const char *authzPtr; + int authzLen; +}; + +static int external_interact (LDAP *ld, unsigned flags, void *defaults, void *sasl_interact) +{ + (void)ld; + (void)flags; + struct external_defaults *defs = defaults; + sasl_interact_t *interact; + + for (interact = sasl_interact; interact->id != SASL_CB_LIST_END; interact++) { + switch (interact->id) { + case SASL_CB_USER: + if (defs->authzLen) { + interact->result = defs->authzPtr; + interact->len = defs->authzLen; + } + break; + /* RFC 4422 (SASL) doesn't allow any other callbacks for EXTERNAL */ + } + } + return LDAP_SUCCESS; +} + +int external_sasl_bind (LDAP *ld, const char *authz, int len) +{ + struct external_defaults defaults = { authzPtr: authz, authzLen: len }; + + return ldap_sasl_interactive_bind_s (ld, NULL, "EXTERNAL", NULL, NULL, + LDAP_SASL_QUIET, + external_interact, &defaults); +} diff --git a/sasl_external.h b/sasl_external.h new file mode 100644 --- /dev/null +++ b/sasl_external.h @@ -0,0 +1,3 @@ +#include + +int external_sasl_bind (LDAP *ld, const char *authz, int len);