LDAP-0.6.11/0000755000000000000000000000000013035724255010513 5ustar0000000000000000LDAP-0.6.11/LDAP.hs0000644000000000000000000000241213035724255011566 0ustar0000000000000000{- -*- Mode: haskell; -*- Haskell LDAP Interface This code is under a 3-clause BSD license; see COPYING for details. -} {- | Module : LDAP Copyright : Copyright (C) 2005-2007 John Goerzen License : BSD Maintainer : John Goerzen, Maintainer : jgoerzen\@complete.org Stability : provisional Portability: portable Top-level LDAP module. Written by John Goerzen, jgoerzen\@complete.org Welcome to the LDAP interface for Haskell. Please see one of the sections below for more information. This package comes from: -} module LDAP (-- * Basic Types module LDAP.Types, -- * Initialization module LDAP.Init, -- * Searching module LDAP.Search, -- * Adding, Deleting, and Altering module LDAP.Modify, -- * Error Handling module LDAP.Exceptions, -- * Haskell enumerated LDAP types module LDAP.Data, -- * Other LDAP constants module LDAP.Constants ) where import LDAP.Exceptions import LDAP.Types import LDAP.Init import LDAP.Data import LDAP.Constants import LDAP.Search hiding (LDAPScope(..)) import LDAP.Modify hiding (LDAPModOp(..)) LDAP-0.6.11/sasl_external.c0000644000000000000000000000203313035724255013521 0ustar0000000000000000#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); } LDAP-0.6.11/sasl_external.h0000644000000000000000000000012213035724255013523 0ustar0000000000000000#include int external_sasl_bind (LDAP *ld, const char *authz, int len); LDAP-0.6.11/Setup.hs0000644000000000000000000000010713035724255012145 0ustar0000000000000000#!/usr/bin/env runhugs import Distribution.Simple main = defaultMain LDAP-0.6.11/LDAP.cabal0000644000000000000000000000413713035724255012224 0ustar0000000000000000cabal-version: >=1.8 Name: LDAP Version: 0.6.11 License: BSD3 Maintainer: Edward Z. Yang Author: John Goerzen, Edward Z. Yang Stability: Beta 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 ChangeLog.md sasl_external.h Build-Type: Simple Flag buildtests description: Build the executable to run unit tests default: False Library C-Sources: sasl_external.c Exposed-Modules: LDAP, LDAP.Types, LDAP.Init, LDAP.Constants, LDAP.Data, LDAP.Exceptions, LDAP.Search, LDAP.Modify Other-Modules: LDAP.Utils, LDAP.TypesLL, LDAP.Result Build-Depends: base build-depends: base >= 4 && <5 Extra-Libraries: ldap, lber GHC-Options: -O2 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 Main-Is: runtests.hs 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, . GHC-Options: -O2 build-depends: base >= 4 && < 5 LDAP-0.6.11/ChangeLog.md0000644000000000000000000000006213035724255012662 0ustar00000000000000000.6.11 ====== * Added `ldapExternalSaslBind`. LDAP-0.6.11/COPYING0000644000000000000000000000267313035724255011556 0ustar0000000000000000Copyright (c) 2005 John Goerzen. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of John Goerzen nor the names of contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. LDAP-0.6.11/COPYRIGHT0000644000000000000000000000022413035724255012004 0ustar0000000000000000Haskell LDAP Interface Copyright (C) 2005 John Goerzen This code is under a 3-clause BSD license; see COPYING for details. LDAP-0.6.11/LDAP/0000755000000000000000000000000013035724255011233 5ustar0000000000000000LDAP-0.6.11/LDAP/Modify.hsc0000644000000000000000000001021313035724255013156 0ustar0000000000000000{- -*- Mode: haskell; -*- Haskell LDAP Interface Copyright (C) 2005 John Goerzen This code is under a 3-clause BSD license; see COPYING for details. -} {- | Module : LDAP.Modify Copyright : Copyright (C) 2005 John Goerzen License : BSD Maintainer : John Goerzen, Maintainer : jgoerzen\@complete.org Stability : provisional Portability: portable LDAP changes Written by John Goerzen, jgoerzen\@complete.org -} module LDAP.Modify (-- * Basics LDAPModOp(..), LDAPMod(..), ldapAdd, ldapModify, ldapDelete, -- * Utilities list2ldm, pairs2ldm ) where import LDAP.Utils import LDAP.Types import LDAP.TypesLL 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 #include data LDAPMod = LDAPMod {modOp :: LDAPModOp -- ^ Type of operation to perform ,modType :: String -- ^ Name of attribute to edit ,modVals :: [String] -- ^ New values } deriving (Eq, Show) ldapModify :: LDAP -- ^ LDAP connection object -> String -- ^ DN to modify -> [LDAPMod] -- ^ Changes to make -> IO () ldapModify = genericChange "ldapModify" ldap_modify_s ldapAdd :: LDAP -- ^ LDAP connection object -> String -- ^ DN to add -> [LDAPMod] -- ^ Items to add -> IO () ldapAdd = genericChange "ldapAdd" ldap_add_s genericChange name func ld dn changelist = withLDAPPtr ld (\cld -> withCString dn (\cdn -> withCLDAPModArr0 changelist (\cmods -> do checkLE name ld $ func cld cdn cmods return () ))) {- | Delete the specified DN -} ldapDelete :: LDAP -> String -> IO () ldapDelete ld dn = withLDAPPtr ld (\cld -> withCString dn (\cdn -> do checkLE "ldapDelete" ld $ ldap_delete_s cld cdn return () )) {- | Takes a list of name\/value points and converts them to LDAPMod entries. Each item will have the specified 'LDAPModOp'. -} list2ldm :: LDAPModOp -> [(String, [String])] -> [LDAPMod] list2ldm mo = map (\(key, vals) -> LDAPMod {modOp = mo, modType = key, modVals = vals} ) {- | Similar to list2ldm, but handles pairs with only one value. -} pairs2ldm :: LDAPModOp -> [(String, String)] -> [LDAPMod] pairs2ldm mo = list2ldm mo . map (\(x, y) -> (x, [y])) data CLDAPMod newCLDAPMod :: LDAPMod -> IO (Ptr CLDAPMod) newCLDAPMod lm = do (ptr::(Ptr CLDAPMod)) <- mallocBytes #{size LDAPMod} cmodtype <- newCString (modType lm) let (cmodop::LDAPInt) = (fromIntegral . fromEnum . modOp $ lm) .|. #{const LDAP_MOD_BVALUES} bervals <- mapM newBerval (modVals lm) (arrptr::Ptr (Ptr Berval)) <- newArray0 nullPtr bervals ( #{poke LDAPMod, mod_op} ) ptr cmodop ( #{poke LDAPMod, mod_type } ) ptr cmodtype ( #{poke LDAPMod, mod_vals } ) ptr arrptr return ptr freeCLDAPMod :: Ptr CLDAPMod -> IO () freeCLDAPMod ptr = do -- Free the array of Bervals (arrptr::Ptr (Ptr Berval)) <- ( #{peek LDAPMod, mod_vals} ) ptr (arr::[Ptr Berval]) <- peekArray0 nullPtr arrptr mapM_ freeHSBerval arr free arrptr -- Free the modtype (cmodtype::CString) <- ( #{peek LDAPMod, mod_type} ) ptr free cmodtype -- mod_op is an int and doesn't need freeing -- free the LDAPMod itself. free ptr withCLDAPModArr0 :: [LDAPMod] -> (Ptr (Ptr CLDAPMod) -> IO a) -> IO a withCLDAPModArr0 = withAnyArr0 newCLDAPMod freeCLDAPMod foreign import ccall safe "ldap.h ldap_modify_s" ldap_modify_s :: LDAPPtr -> CString -> Ptr (Ptr CLDAPMod) -> IO LDAPInt foreign import ccall safe "ldap.h ldap_delete_s" ldap_delete_s :: LDAPPtr -> CString -> IO LDAPInt foreign import ccall safe "ldap.h ldap_add_s" ldap_add_s :: LDAPPtr -> CString -> Ptr (Ptr CLDAPMod) -> IO LDAPInt LDAP-0.6.11/LDAP/Exceptions.hs0000644000000000000000000000716513035724255013721 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {- -*- Mode: haskell; -*- Haskell LDAP Interface Copyright (C) 2005-2009 John Goerzen This code is under a 3-clause BSD license; see COPYING for details. -} {- | Module : LDAP.Exceptions Copyright : Copyright (C) 2005-2009 John Goerzen License : BSD Maintainer : John Goerzen, Maintainer : jgoerzen\@complete.org Stability : provisional Portability: portable Handling LDAP Exceptions Written by John Goerzen, jgoerzen\@complete.org -} module LDAP.Exceptions (-- * Types LDAPException(..), -- * General Catching catchLDAP, handleLDAP, failLDAP, throwLDAP ) where import Data.Typeable import Control.Exception import LDAP.Types import LDAP.Data #if __GLASGOW_HASKELL__ < 610 import Data.Dynamic #endif {- | The basic type of LDAP exceptions. These are raised when an operation does not indicate success. -} data LDAPException = LDAPException {code :: LDAPReturnCode, -- ^ Numeric error code 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) ++ "): " ++ description x instance Eq LDAPException where x == y = code x == code y instance Ord LDAPException where compare x y = compare (code x) (code y) #if __GLASGOW_HASKELL__ >= 610 instance Exception LDAPException where {- toException = SomeException fromException (SomeException e) = Just e fromException _ = Nothing -} {- | Execute the given IO action. If it raises a 'LDAPException', then execute the supplied handler and return its return value. Otherwise, process as normal. -} catchLDAP :: IO a -> (LDAPException -> IO a) -> IO a catchLDAP action handler = catchJust ldapExceptions action handler {- | Like 'catchLDAP', with the order of arguments reversed. -} handleLDAP :: (LDAPException -> IO a) -> IO a -> IO a handleLDAP = flip catchLDAP {- | Given an Exception, return Just LDAPException if it was an 'LDAPExcetion', or Nothing otherwise. Useful with functions like catchJust. -} ldapExceptions :: LDAPException -> Maybe LDAPException ldapExceptions e = Just e #else {- | Execute the given IO action. If it raises a 'LDAPException', then execute the supplied handler and return its return value. Otherwise, process as normal. -} catchLDAP :: IO a -> (LDAPException -> IO a) -> IO a catchLDAP = catchDyn {- | Like 'catchLDAP', with the order of arguments reversed. -} handleLDAP :: (LDAPException -> IO a) -> IO a -> IO a handleLDAP = flip catchLDAP #endif {- | Catches LDAP errors, and re-raises them as IO errors with fail. Useful if you don't care to catch LDAP errors, but want to see a sane error message if one happens. One would often use this as a high-level wrapper around LDAP calls. -} failLDAP :: IO a -> IO a failLDAP action = catchLDAP action handler where handler e = fail ("LDAP error: " ++ show e) {- | A utility function to throw an 'LDAPException'. The mechanics of throwing such a thing differ between GHC 6.8.x, Hugs, and GHC 6.10. This function takes care of the special cases to make it simpler. With GHC 6.10, it is a type-restricted alias for throw. On all other systems, it is a type-restricted alias for throwDyn. -} throwLDAP :: LDAPException -> IO a #if __GLASGOW_HASKELL__ >= 610 throwLDAP = throw #else throwLDAP = throwDyn #endif LDAP-0.6.11/LDAP/Init.hsc0000644000000000000000000001056513035724255012644 0ustar0000000000000000{- -*- Mode: haskell; -*- Haskell LDAP Interface Copyright (C) 2005 John Goerzen 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 #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'. Could throw IOError on failure. -} ldapInit :: String -- ^ Host -> LDAPInt -- ^ Port -> IO LDAP -- ^ New LDAP Obj ldapInit host port = 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 -> LDAPInt -- ^ Port -> IO LDAP -- ^ New LDAP Obj ldapOpen host port = withCString host (\cs -> 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) -> String -- ^ Password -> IO () ldapSimpleBind ld dn passwd = withLDAPPtr ld (\ptr -> withCString dn (\cdn -> withCString passwd (\cpasswd -> do checkLE "ldapSimpleBind" ld (ldap_simple_bind_s ptr cdn cpasswd) 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 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 LDAP-0.6.11/LDAP/Search.hsc0000644000000000000000000001344313035724255013144 0ustar0000000000000000{- -*- Mode: haskell; -*- Haskell LDAP Interface Copyright (C) 2005 John Goerzen This code is under a 3-clause BSD license; see COPYING for details. -} {- | Module : LDAP.Search Copyright : Copyright (C) 2005 John Goerzen License : BSD Maintainer : John Goerzen, Maintainer : jgoerzen\@complete.org Stability : provisional Portability: portable LDAP Searching Written by John Goerzen, jgoerzen\@complete.org -} module LDAP.Search (SearchAttributes(..), LDAPEntry(..), LDAPScope(..), ldapSearch, ) where import LDAP.Utils import LDAP.Types import LDAP.TypesLL 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) #include {- | Defines what attributes to return with the search result. -} data SearchAttributes = LDAPNoAttrs -- ^ No attributes | LDAPAllUserAttrs -- ^ User attributes only | LDAPAttrList [String] -- ^ User-specified list deriving (Eq, Show) sa2sl :: SearchAttributes -> [String] sa2sl LDAPNoAttrs = [ #{const_str LDAP_NO_ATTRS} ] sa2sl LDAPAllUserAttrs = [ #{const_str LDAP_ALL_USER_ATTRIBUTES} ] sa2sl (LDAPAttrList x) = x data LDAPEntry = LDAPEntry {ledn :: String -- ^ Distinguished Name of this object ,leattrs :: [(String, [String])] -- ^ Mapping from attribute name to values } deriving (Eq, Show) ldapSearch :: LDAP -- ^ LDAP connection object -> Maybe String -- ^ Base DN for search, if any -> LDAPScope -- ^ Scope of the search -> Maybe String -- ^ Filter to be used (none if Nothing) -> SearchAttributes -- ^ Desired attributes in result set -> Bool -- ^ If True, exclude attribute values (return types only) -> IO [LDAPEntry] ldapSearch ld base scope filter attrs attrsonly = withLDAPPtr ld (\cld -> withMString base (\cbase -> withMString filter (\cfilter -> withCStringArr0 (sa2sl attrs) (\cattrs -> do msgid <- checkLEn1 "ldapSearch" ld $ ldap_search cld cbase (fromIntegral $ fromEnum scope) cfilter cattrs (fromBool attrsonly) procSR ld cld msgid ) ) ) ) procSR :: LDAP -> Ptr CLDAP -> LDAPInt -> IO [LDAPEntry] procSR ld cld msgid = do res1 <- ldap_1result ld msgid --putStrLn "Have 1result" withForeignPtr res1 (\cres1 -> do felm <- ldap_first_entry cld cres1 if felm == nullPtr then return [] else do --putStrLn "Have first entry" cdn <- ldap_get_dn cld felm -- FIXME: check null dn <- peekCString cdn ldap_memfree cdn attrs <- getattrs ld felm next <- procSR ld cld msgid --putStrLn $ "Next is " ++ (show next) return $ (LDAPEntry {ledn = dn, leattrs = attrs}):next ) data BerElement getattrs :: LDAP -> (Ptr CLDAPMessage) -> IO [(String, [String])] getattrs ld lmptr = withLDAPPtr ld (\cld -> alloca (f cld)) where f cld (ptr::Ptr (Ptr BerElement)) = do cstr <- ldap_first_attribute cld lmptr ptr if cstr == nullPtr then return [] else do str <- peekCString cstr ldap_memfree cstr bptr <- peek ptr values <- getvalues cld lmptr str nextitems <- getnextitems cld lmptr bptr return $ (str, values):nextitems getnextitems :: Ptr CLDAP -> Ptr CLDAPMessage -> Ptr BerElement -> IO [(String, [String])] getnextitems cld lmptr bptr = do cstr <- ldap_next_attribute cld lmptr bptr if cstr == nullPtr then return [] else do str <- peekCString cstr ldap_memfree cstr values <- getvalues cld lmptr str nextitems <- getnextitems cld lmptr bptr return $ (str, values):nextitems getvalues :: LDAPPtr -> Ptr CLDAPMessage -> String -> IO [String] getvalues cld clm attr = withCString attr (\cattr -> do berarr <- ldap_get_values_len cld clm cattr 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] procberarr pbv = do bvl <- peekArray0 nullPtr pbv mapM bv2str bvl foreign import ccall unsafe "ldap.h ldap_get_dn" ldap_get_dn :: LDAPPtr -> Ptr CLDAPMessage -> IO CString foreign import ccall unsafe "ldap.h ldap_get_values_len" ldap_get_values_len :: LDAPPtr -> Ptr CLDAPMessage -> CString -> IO (Ptr (Ptr Berval)) foreign import ccall unsafe "ldap.h ldap_value_free_len" ldap_value_free_len :: Ptr (Ptr Berval) -> IO () foreign import ccall safe "ldap.h ldap_search" ldap_search :: LDAPPtr -> CString -> LDAPInt -> CString -> Ptr CString -> LDAPInt -> IO LDAPInt foreign import ccall unsafe "ldap.h ldap_first_entry" ldap_first_entry :: LDAPPtr -> Ptr CLDAPMessage -> IO (Ptr CLDAPMessage) foreign import ccall unsafe "ldap.h ldap_first_attribute" ldap_first_attribute :: LDAPPtr -> Ptr CLDAPMessage -> Ptr (Ptr BerElement) -> IO CString foreign import ccall unsafe "ldap.h ldap_next_attribute" ldap_next_attribute :: LDAPPtr -> Ptr CLDAPMessage -> Ptr BerElement -> IO CString LDAP-0.6.11/LDAP/Utils.hsc0000644000000000000000000001646313035724255013044 0ustar0000000000000000{- -*- Mode: haskell; -*- Haskell LDAP Interface Copyright (C) 2005 John Goerzen This code is under a 3-clause BSD license; see COPYING for details. -} {- | Module : LDAP.Utils Copyright : Copyright (C) 2005 John Goerzen License : BSD Maintainer : John Goerzen, Maintainer : jgoerzen\@complete.org Stability : provisional Portability: portable LDAP low-level utilities Written by John Goerzen, jgoerzen\@complete.org Please use sparingly and with caution. The documentation for their behavior should be considered to be the source code. -} module LDAP.Utils(checkLE, checkLEe, checkLEn1, checkNULL, LDAPPtr, fromLDAPPtr, withLDAPPtr, maybeWithLDAPPtr, withMString, withCStringArr0, ldap_memfree, bv2str, newBerval, freeHSBerval, withAnyArr0) where import Foreign.Ptr import LDAP.Constants import LDAP.Exceptions import LDAP.Types import LDAP.Data import LDAP.TypesLL import Control.Exception import Data.Dynamic import Foreign.C.Error import Foreign.C.String import Foreign.ForeignPtr import Foreign import Foreign.C.Types #include {- FIXME frmo python: return native oom for LDAP_NO_MEMORY? load up LDAP_OPT_MATCHED_DN? handle LDAP_REFERRAL? -} {- | Check the return value. If it's something other than 'LDAP.Constants.ldapSuccess', raise an LDAP exception. -} checkLE :: String -> LDAP -> IO LDAPInt -> IO LDAPInt checkLE = checkLEe (\r -> r == fromIntegral (fromEnum LdapSuccess)) checkLEn1 :: String -> LDAP -> IO LDAPInt -> IO LDAPInt checkLEn1 = checkLEe (\r -> r /= -1) checkLEe :: (LDAPInt -> Bool) -> String -> LDAP -> IO LDAPInt -> IO LDAPInt checkLEe test callername ld action = do result <- action if test result then return result else do errornum <- ldapGetOptionIntNoEc ld LdapOptErrorNumber let hserror = toEnum (fromIntegral errornum) err2string <- (ldap_err2string errornum >>= peekCString) objstring <- ldapGetOptionStrNoEc ld LdapOptErrorString let desc = case objstring of Nothing -> err2string Just x -> err2string ++ " (" ++ x ++ ")" let exc = LDAPException {code = hserror, description = desc, caller = callername } throwLDAP exc {- else do s <- (ldap_err2string result >>= peekCString) let exc = LDAPException {code = (toEnum (fromIntegral result)), description = s, caller = callername} throwLDAP exc -} {- | Raise an IOError based on errno if getting a NULL. Identical to Foreign.C.Error.throwErrnoIfNull. -} checkNULL :: String -> IO (Ptr a) -> IO (Ptr a) checkNULL = throwErrnoIfNull {- | Value coming in from C -} type LDAPPtr = Ptr CLDAP {- | Convert a LDAPPtr into a LDAP type. Checks it with 'checkNULL' automatically. -} fromLDAPPtr :: String -> IO LDAPPtr -> IO LDAP fromLDAPPtr caller action = do ptr <- checkNULL caller action newForeignPtr ldap_unbind ptr {- | Use a 'LDAP' in a function that needs 'LDAPPtr'. -} withLDAPPtr :: LDAP -> (LDAPPtr -> IO a) -> IO a withLDAPPtr ld = withForeignPtr ld {- | Same as 'withLDAPPtr', but uses nullPtr if the input is Nothing. -} maybeWithLDAPPtr :: Maybe LDAP -> (LDAPPtr -> IO a) -> IO a maybeWithLDAPPtr Nothing func = func nullPtr maybeWithLDAPPtr (Just x) y = withLDAPPtr x y {- | Returns an int, doesn't raise exceptions on err (just crashes) -} ldapGetOptionIntNoEc :: LDAP -> LDAPOptionCode -> IO LDAPInt ldapGetOptionIntNoEc ld oc = withLDAPPtr ld (\pld -> alloca (f pld)) where oci = fromIntegral $ fromEnum oc f pld (ptr::Ptr LDAPInt) = do res <- ldap_get_option pld oci (castPtr ptr) if res /= 0 then fail $ "Crash in int ldap_get_option, code " ++ show res else peek ptr {- | Returns a string, doesn't raise exceptions on err (just crashes) -} ldapGetOptionStrNoEc :: LDAP -> LDAPOptionCode -> IO (Maybe String) ldapGetOptionStrNoEc ld oc = withLDAPPtr ld (\pld -> alloca (f pld)) where oci = fromEnum oc f pld (ptr::Ptr CString) = do res <- ldap_get_option pld (fromIntegral oci) (castPtr ptr) if res /= 0 then fail $ "Crash in str ldap_get_option, code " ++ show res else do cstr <- peek ptr fp <- wrap_memfree cstr withForeignPtr fp (\cs -> do if cs == nullPtr then return Nothing else do hstr <- peekCString cs return $ Just hstr ) wrap_memfree :: CString -> IO (ForeignPtr Foreign.C.Types.CChar) wrap_memfree p = newForeignPtr ldap_memfree_call p withMString :: Maybe String -> (CString -> IO a) -> IO a withMString Nothing action = action (nullPtr) withMString (Just str) action = withCString str action withCStringArr0 :: [String] -> (Ptr CString -> IO a) -> IO a withCStringArr0 inp action = withAnyArr0 newCString free inp action withAnyArr0 :: (a -> IO (Ptr b)) -- ^ Function that transforms input data into pointer -> (Ptr b -> IO ()) -- ^ Function that frees generated data -> [a] -- ^ List of input data -> (Ptr (Ptr b) -> IO c) -- ^ Action to run with the C array -> IO c -- Return value withAnyArr0 input2ptract freeact inp action = bracket (mapM input2ptract inp) (\clist -> mapM_ freeact clist) (\clist -> withArray0 nullPtr clist action) withBervalArr0 :: [String] -> (Ptr (Ptr Berval) -> IO a) -> IO a withBervalArr0 = withAnyArr0 newBerval freeHSBerval 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) {- | Must be freed later with freeHSBerval! -} newBerval :: String -> IO (Ptr Berval) newBerval str = do (ptr::Ptr Berval) <- mallocBytes #{size struct berval} (cstr, len) <- newCStringLen str let (clen::BERLen) = fromIntegral len ( #{poke struct berval, bv_len} ) ptr clen ( #{poke struct berval, bv_val} ) ptr cstr return ptr {- | Free a berval allocated from Haskell. -} freeHSBerval :: Ptr Berval -> IO () freeHSBerval ptr = do cstr <- ( #{peek struct berval, bv_val} ) ptr free cstr free ptr foreign import ccall unsafe "ldap.h &ldap_unbind" ldap_unbind :: FunPtr (LDAPPtr -> IO ()) -- ldap_unbind, ignoring retval foreign import ccall unsafe "ldap.h ldap_err2string" ldap_err2string :: LDAPInt -> IO CString foreign import ccall unsafe "ldap.h ldap_get_option" ldap_get_option :: LDAPPtr -> LDAPInt -> Ptr () -> IO LDAPInt foreign import ccall unsafe "ldap.h &ldap_memfree" ldap_memfree_call :: FunPtr (CString -> IO ()) foreign import ccall unsafe "ldap.h ldap_memfree" ldap_memfree :: CString -> IO () LDAP-0.6.11/LDAP/TypesLL.hs0000644000000000000000000000106313035724255013123 0ustar0000000000000000{- -*- Mode: haskell; -*- Haskell LDAP Interface Copyright (C) 2005 John Goerzen This code is under a 3-clause BSD license; see COPYING for details. -} {- | Module : LDAP.TypesLL Copyright : Copyright (C) 2005-2006 John Goerzen License : BSD Maintainer : John Goerzen, Maintainer : jgoerzen\@complete.org Stability : provisional Portability: portable Low-level types for LDAP programs. Written by John Goerzen, jgoerzen\@complete.org -} module LDAP.TypesLL(CLDAP, Berval) where data CLDAP data Berval LDAP-0.6.11/LDAP/Result.hsc0000644000000000000000000000321713035724255013213 0ustar0000000000000000{- -*- Mode: haskell; -*- Haskell LDAP Interface Copyright (C) 2005 John Goerzen This code is under a 3-clause BSD license; see COPYING for details. -} {- | Module : LDAP.Result Copyright : Copyright (C) 2005 John Goerzen License : BSD Maintainer : John Goerzen, Maintainer : jgoerzen\@complete.org Stability : provisional Portability: portable LDAP Result Processing Written by John Goerzen, jgoerzen\@complete.org -} module LDAP.Result (LDAPMessage, CLDAPMessage, ldap_1result ) where import LDAP.Utils import LDAP.Types import Foreign #if (__GLASGOW_HASKELL__>=705) import Foreign.C.Types(CInt(..)) #endif #include data CLDAPMessage type LDAPMessage = ForeignPtr CLDAPMessage {- | Get 1 result from an operation. -} ldap_1result :: LDAP -> LDAPInt -> IO (LDAPMessage) ldap_1result ld msgid = withLDAPPtr ld (\cld -> alloca (f cld) ) where f cld (ptr::Ptr (Ptr CLDAPMessage)) = do checkLEn1 "ldap_1result" ld $ ldap_result cld msgid 0 nullPtr ptr fromldmptr "ldap_1result" (peek ptr) fromldmptr :: String -> IO (Ptr CLDAPMessage) -> IO LDAPMessage fromldmptr caller action = do ptr <- action if ptr == nullPtr then fail (caller ++ ": got null LDAPMessage pointer") else newForeignPtr ldap_msgfree_call ptr 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" ldap_msgfree_call :: FunPtr (Ptr CLDAPMessage -> IO ()) LDAP-0.6.11/LDAP/Constants.hsc0000644000000000000000000000270013035724255013705 0ustar0000000000000000{- -*- Mode: haskell; -*- Haskell LDAP Interface Copyright (C) 2005 John Goerzen This code is under a 3-clause BSD license; see COPYING for details. -} {- | Module : LDAP.Constants Copyright : Copyright (C) 2005-2006 John Goerzen License : BSD Maintainer : John Goerzen, Maintainer : jgoerzen\@complete.org Stability : provisional Portability: portable LDAP constants for use in your programs Written by John Goerzen, jgoerzen\@complete.org -} module LDAP.Constants(module LDAP.Constants) where import Foreign.C.Types import LDAP.Types #include "ldap.h" #enum LDAPInt, , LDAP_PORT, LDAPS_PORT, LDAP_API_VERSION, LDAP_VENDOR_NAME, \ LDAP_API_INFO_VERSION, LDAP_FEATURE_INFO_VERSION, \ LDAP_CONTROL_VALUESRETURNFILTER, LDAP_CONTROL_SUBENTRIES, \ LDAP_CONTROL_NOOP, LDAP_CONTROL_MANAGEDSAIT, LDAP_CONTROL_PROXY_AUTHZ, \ LDAP_CONTROL_SORTREQUEST, LDAP_CONTROL_SORTRESPONSE, \ LDAP_CONTROL_VLVREQUEST, LDAP_CONTROL_VLVRESPONSE, \ LDAP_NOTICE_OF_DISCONNECTION, LDAP_NOTICE_DISCONNECT #enum BERTag, , LDAP_FILTER_AND, LDAP_FILTER_OR, LDAP_FILTER_NOT, \ LDAP_FILTER_EQUALITY, LDAP_FILTER_SUBSTRINGS, LDAP_FILTER_GE,\ LDAP_FILTER_LE, LDAP_FILTER_PRESENT, LDAP_FILTER_APPROX,\ LDAP_FILTER_EXT, LDAP_FILTER_EXT_OID, LDAP_FILTER_EXT_TYPE,\ LDAP_FILTER_EXT_VALUE,LDAP_FILTER_EXT_DNATTRS, \ LDAP_SUBSTRING_ANY, LDAP_SUBSTRING_FINAL, LDAP_SUBSTRING_INITIAL LDAP-0.6.11/LDAP/Data.hsc0000644000000000000000000003342213035724255012607 0ustar0000000000000000-- AUTO-GENERATED FILE, DO NOT EDIT. GENERATED BY utils/genconsts.hs {- | Module : LDAP.Data Copyright : Copyright (C) 2005 John Goerzen License : BSD Maintainer : John Goerzen, Maintainer : jgoerzen\@complete.org Stability : provisional Portability: portable Haskell types for LDAP constants Written by John Goerzen, jgoerzen\@complete.org -} module LDAP.Data (module LDAP.Data) where #include "ldap.h" data LDAPReturnCode = LdapSuccess | LdapOperationsError | LdapProtocolError | LdapTimelimitExceeded | LdapSizelimitExceeded | LdapCompareFalse | LdapCompareTrue | LdapAuthMethodNotSupported | LdapStrongAuthNotSupported | LdapStrongAuthRequired | LdapPartialResults | LdapReferral | LdapAdminlimitExceeded | LdapUnavailableCriticalExtension | LdapConfidentialityRequired | LdapSaslBindInProgress | LdapNoSuchAttribute | LdapUndefinedType | LdapInappropriateMatching | LdapConstraintViolation | LdapTypeOrValueExists | LdapInvalidSyntax | LdapNoSuchObject | LdapAliasProblem | LdapInvalidDnSyntax | LdapIsLeaf | LdapAliasDerefProblem | LdapProxyAuthzFailure | LdapInappropriateAuth | LdapInvalidCredentials | LdapInsufficientAccess | LdapBusy | LdapUnavailable | LdapUnwillingToPerform | LdapLoopDetect | LdapNamingViolation | LdapObjectClassViolation | LdapNotAllowedOnNonleaf | LdapNotAllowedOnRdn | LdapAlreadyExists | LdapNoObjectClassMods | LdapResultsTooLarge | LdapAffectsMultipleDsas | LdapOther | LdapServerDown | LdapLocalError | LdapEncodingError | LdapDecodingError | LdapTimeout | LdapAuthUnknown | LdapFilterError | LdapUserCancelled | LdapParamError | LdapNoMemory | LdapConnectError | LdapNotSupported | LdapControlNotFound | LdapNoResultsReturned | LdapMoreResultsToReturn | LdapClientLoop | LdapReferralLimitExceeded | UnknownLDAPReturnCode Int deriving (Show) instance Enum LDAPReturnCode where toEnum (#{const LDAP_SUCCESS}) = LdapSuccess toEnum (#{const LDAP_OPERATIONS_ERROR}) = LdapOperationsError toEnum (#{const LDAP_PROTOCOL_ERROR}) = LdapProtocolError toEnum (#{const LDAP_TIMELIMIT_EXCEEDED}) = LdapTimelimitExceeded toEnum (#{const LDAP_SIZELIMIT_EXCEEDED}) = LdapSizelimitExceeded toEnum (#{const LDAP_COMPARE_FALSE}) = LdapCompareFalse toEnum (#{const LDAP_COMPARE_TRUE}) = LdapCompareTrue toEnum (#{const LDAP_AUTH_METHOD_NOT_SUPPORTED}) = LdapAuthMethodNotSupported toEnum (#{const LDAP_STRONG_AUTH_NOT_SUPPORTED}) = LdapStrongAuthNotSupported toEnum (#{const LDAP_STRONG_AUTH_REQUIRED}) = LdapStrongAuthRequired toEnum (#{const LDAP_PARTIAL_RESULTS}) = LdapPartialResults toEnum (#{const LDAP_REFERRAL}) = LdapReferral toEnum (#{const LDAP_ADMINLIMIT_EXCEEDED}) = LdapAdminlimitExceeded toEnum (#{const LDAP_UNAVAILABLE_CRITICAL_EXTENSION}) = LdapUnavailableCriticalExtension toEnum (#{const LDAP_CONFIDENTIALITY_REQUIRED}) = LdapConfidentialityRequired toEnum (#{const LDAP_SASL_BIND_IN_PROGRESS}) = LdapSaslBindInProgress toEnum (#{const LDAP_NO_SUCH_ATTRIBUTE}) = LdapNoSuchAttribute toEnum (#{const LDAP_UNDEFINED_TYPE}) = LdapUndefinedType toEnum (#{const LDAP_INAPPROPRIATE_MATCHING}) = LdapInappropriateMatching toEnum (#{const LDAP_CONSTRAINT_VIOLATION}) = LdapConstraintViolation toEnum (#{const LDAP_TYPE_OR_VALUE_EXISTS}) = LdapTypeOrValueExists toEnum (#{const LDAP_INVALID_SYNTAX}) = LdapInvalidSyntax toEnum (#{const LDAP_NO_SUCH_OBJECT}) = LdapNoSuchObject toEnum (#{const LDAP_ALIAS_PROBLEM}) = LdapAliasProblem 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_INAPPROPRIATE_AUTH}) = LdapInappropriateAuth toEnum (#{const LDAP_INVALID_CREDENTIALS}) = LdapInvalidCredentials toEnum (#{const LDAP_INSUFFICIENT_ACCESS}) = LdapInsufficientAccess toEnum (#{const LDAP_BUSY}) = LdapBusy toEnum (#{const LDAP_UNAVAILABLE}) = LdapUnavailable toEnum (#{const LDAP_UNWILLING_TO_PERFORM}) = LdapUnwillingToPerform toEnum (#{const LDAP_LOOP_DETECT}) = LdapLoopDetect toEnum (#{const LDAP_NAMING_VIOLATION}) = LdapNamingViolation toEnum (#{const LDAP_OBJECT_CLASS_VIOLATION}) = LdapObjectClassViolation toEnum (#{const LDAP_NOT_ALLOWED_ON_NONLEAF}) = LdapNotAllowedOnNonleaf toEnum (#{const LDAP_NOT_ALLOWED_ON_RDN}) = LdapNotAllowedOnRdn toEnum (#{const LDAP_ALREADY_EXISTS}) = LdapAlreadyExists toEnum (#{const LDAP_NO_OBJECT_CLASS_MODS}) = LdapNoObjectClassMods toEnum (#{const LDAP_RESULTS_TOO_LARGE}) = LdapResultsTooLarge toEnum (#{const LDAP_AFFECTS_MULTIPLE_DSAS}) = LdapAffectsMultipleDsas toEnum (#{const LDAP_OTHER}) = LdapOther toEnum (#{const LDAP_SERVER_DOWN}) = LdapServerDown toEnum (#{const LDAP_LOCAL_ERROR}) = LdapLocalError toEnum (#{const LDAP_ENCODING_ERROR}) = LdapEncodingError toEnum (#{const LDAP_DECODING_ERROR}) = LdapDecodingError toEnum (#{const LDAP_TIMEOUT}) = LdapTimeout toEnum (#{const LDAP_AUTH_UNKNOWN}) = LdapAuthUnknown toEnum (#{const LDAP_FILTER_ERROR}) = LdapFilterError toEnum (#{const LDAP_USER_CANCELLED}) = LdapUserCancelled toEnum (#{const LDAP_PARAM_ERROR}) = LdapParamError toEnum (#{const LDAP_NO_MEMORY}) = LdapNoMemory toEnum (#{const LDAP_CONNECT_ERROR}) = LdapConnectError toEnum (#{const LDAP_NOT_SUPPORTED}) = LdapNotSupported toEnum (#{const LDAP_CONTROL_NOT_FOUND}) = LdapControlNotFound toEnum (#{const LDAP_NO_RESULTS_RETURNED}) = LdapNoResultsReturned toEnum (#{const LDAP_MORE_RESULTS_TO_RETURN}) = LdapMoreResultsToReturn toEnum (#{const LDAP_CLIENT_LOOP}) = LdapClientLoop toEnum (#{const LDAP_REFERRAL_LIMIT_EXCEEDED}) = LdapReferralLimitExceeded toEnum x = UnknownLDAPReturnCode x fromEnum LdapSuccess = (#{const LDAP_SUCCESS}) fromEnum LdapOperationsError = (#{const LDAP_OPERATIONS_ERROR}) fromEnum LdapProtocolError = (#{const LDAP_PROTOCOL_ERROR}) fromEnum LdapTimelimitExceeded = (#{const LDAP_TIMELIMIT_EXCEEDED}) fromEnum LdapSizelimitExceeded = (#{const LDAP_SIZELIMIT_EXCEEDED}) fromEnum LdapCompareFalse = (#{const LDAP_COMPARE_FALSE}) fromEnum LdapCompareTrue = (#{const LDAP_COMPARE_TRUE}) fromEnum LdapAuthMethodNotSupported = (#{const LDAP_AUTH_METHOD_NOT_SUPPORTED}) fromEnum LdapStrongAuthNotSupported = (#{const LDAP_STRONG_AUTH_NOT_SUPPORTED}) fromEnum LdapStrongAuthRequired = (#{const LDAP_STRONG_AUTH_REQUIRED}) fromEnum LdapPartialResults = (#{const LDAP_PARTIAL_RESULTS}) fromEnum LdapReferral = (#{const LDAP_REFERRAL}) fromEnum LdapAdminlimitExceeded = (#{const LDAP_ADMINLIMIT_EXCEEDED}) fromEnum LdapUnavailableCriticalExtension = (#{const LDAP_UNAVAILABLE_CRITICAL_EXTENSION}) fromEnum LdapConfidentialityRequired = (#{const LDAP_CONFIDENTIALITY_REQUIRED}) fromEnum LdapSaslBindInProgress = (#{const LDAP_SASL_BIND_IN_PROGRESS}) fromEnum LdapNoSuchAttribute = (#{const LDAP_NO_SUCH_ATTRIBUTE}) fromEnum LdapUndefinedType = (#{const LDAP_UNDEFINED_TYPE}) fromEnum LdapInappropriateMatching = (#{const LDAP_INAPPROPRIATE_MATCHING}) fromEnum LdapConstraintViolation = (#{const LDAP_CONSTRAINT_VIOLATION}) fromEnum LdapTypeOrValueExists = (#{const LDAP_TYPE_OR_VALUE_EXISTS}) fromEnum LdapInvalidSyntax = (#{const LDAP_INVALID_SYNTAX}) fromEnum LdapNoSuchObject = (#{const LDAP_NO_SUCH_OBJECT}) fromEnum LdapAliasProblem = (#{const LDAP_ALIAS_PROBLEM}) 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 LdapInappropriateAuth = (#{const LDAP_INAPPROPRIATE_AUTH}) fromEnum LdapInvalidCredentials = (#{const LDAP_INVALID_CREDENTIALS}) fromEnum LdapInsufficientAccess = (#{const LDAP_INSUFFICIENT_ACCESS}) fromEnum LdapBusy = (#{const LDAP_BUSY}) fromEnum LdapUnavailable = (#{const LDAP_UNAVAILABLE}) fromEnum LdapUnwillingToPerform = (#{const LDAP_UNWILLING_TO_PERFORM}) fromEnum LdapLoopDetect = (#{const LDAP_LOOP_DETECT}) fromEnum LdapNamingViolation = (#{const LDAP_NAMING_VIOLATION}) fromEnum LdapObjectClassViolation = (#{const LDAP_OBJECT_CLASS_VIOLATION}) fromEnum LdapNotAllowedOnNonleaf = (#{const LDAP_NOT_ALLOWED_ON_NONLEAF}) fromEnum LdapNotAllowedOnRdn = (#{const LDAP_NOT_ALLOWED_ON_RDN}) fromEnum LdapAlreadyExists = (#{const LDAP_ALREADY_EXISTS}) fromEnum LdapNoObjectClassMods = (#{const LDAP_NO_OBJECT_CLASS_MODS}) fromEnum LdapResultsTooLarge = (#{const LDAP_RESULTS_TOO_LARGE}) fromEnum LdapAffectsMultipleDsas = (#{const LDAP_AFFECTS_MULTIPLE_DSAS}) fromEnum LdapOther = (#{const LDAP_OTHER}) fromEnum LdapServerDown = (#{const LDAP_SERVER_DOWN}) fromEnum LdapLocalError = (#{const LDAP_LOCAL_ERROR}) fromEnum LdapEncodingError = (#{const LDAP_ENCODING_ERROR}) fromEnum LdapDecodingError = (#{const LDAP_DECODING_ERROR}) fromEnum LdapTimeout = (#{const LDAP_TIMEOUT}) fromEnum LdapAuthUnknown = (#{const LDAP_AUTH_UNKNOWN}) fromEnum LdapFilterError = (#{const LDAP_FILTER_ERROR}) fromEnum LdapUserCancelled = (#{const LDAP_USER_CANCELLED}) fromEnum LdapParamError = (#{const LDAP_PARAM_ERROR}) fromEnum LdapNoMemory = (#{const LDAP_NO_MEMORY}) fromEnum LdapConnectError = (#{const LDAP_CONNECT_ERROR}) fromEnum LdapNotSupported = (#{const LDAP_NOT_SUPPORTED}) fromEnum LdapControlNotFound = (#{const LDAP_CONTROL_NOT_FOUND}) fromEnum LdapNoResultsReturned = (#{const LDAP_NO_RESULTS_RETURNED}) fromEnum LdapMoreResultsToReturn = (#{const LDAP_MORE_RESULTS_TO_RETURN}) fromEnum LdapClientLoop = (#{const LDAP_CLIENT_LOOP}) fromEnum LdapReferralLimitExceeded = (#{const LDAP_REFERRAL_LIMIT_EXCEEDED}) fromEnum (UnknownLDAPReturnCode x) = x instance Ord LDAPReturnCode where compare x y = compare (fromEnum x) (fromEnum y) instance Eq LDAPReturnCode where x == y = (fromEnum x) == (fromEnum y) data LDAPOptionCode = LdapOptApiInfo | LdapOptDesc | LdapOptDeref | LdapOptSizelimit | LdapOptTimelimit | LdapOptReferrals | LdapOptRestart | LdapOptProtocolVersion | LdapOptServerControls | LdapOptClientControls | LdapOptApiFeatureInfo | LdapOptHostName | LdapOptErrorNumber | LdapOptErrorString | LdapOptMatchedDn | LdapOptSuccess | LdapOptError | UnknownLDAPOptionCode Int deriving (Show) instance Enum LDAPOptionCode where toEnum (#{const LDAP_OPT_API_INFO}) = LdapOptApiInfo toEnum (#{const LDAP_OPT_DESC}) = LdapOptDesc toEnum (#{const LDAP_OPT_DEREF}) = LdapOptDeref toEnum (#{const LDAP_OPT_SIZELIMIT}) = LdapOptSizelimit toEnum (#{const LDAP_OPT_TIMELIMIT}) = LdapOptTimelimit toEnum (#{const LDAP_OPT_REFERRALS}) = LdapOptReferrals toEnum (#{const LDAP_OPT_RESTART}) = LdapOptRestart toEnum (#{const LDAP_OPT_PROTOCOL_VERSION}) = LdapOptProtocolVersion toEnum (#{const LDAP_OPT_SERVER_CONTROLS}) = LdapOptServerControls toEnum (#{const LDAP_OPT_CLIENT_CONTROLS}) = LdapOptClientControls toEnum (#{const LDAP_OPT_API_FEATURE_INFO}) = LdapOptApiFeatureInfo toEnum (#{const LDAP_OPT_HOST_NAME}) = LdapOptHostName toEnum (#{const LDAP_OPT_ERROR_NUMBER}) = LdapOptErrorNumber toEnum (#{const LDAP_OPT_ERROR_STRING}) = LdapOptErrorString toEnum (#{const LDAP_OPT_MATCHED_DN}) = LdapOptMatchedDn toEnum (#{const LDAP_OPT_SUCCESS}) = LdapOptSuccess toEnum (#{const LDAP_OPT_ERROR}) = LdapOptError toEnum x = UnknownLDAPOptionCode x fromEnum LdapOptApiInfo = (#{const LDAP_OPT_API_INFO}) fromEnum LdapOptDesc = (#{const LDAP_OPT_DESC}) fromEnum LdapOptDeref = (#{const LDAP_OPT_DEREF}) fromEnum LdapOptSizelimit = (#{const LDAP_OPT_SIZELIMIT}) fromEnum LdapOptTimelimit = (#{const LDAP_OPT_TIMELIMIT}) fromEnum LdapOptReferrals = (#{const LDAP_OPT_REFERRALS}) fromEnum LdapOptRestart = (#{const LDAP_OPT_RESTART}) fromEnum LdapOptProtocolVersion = (#{const LDAP_OPT_PROTOCOL_VERSION}) fromEnum LdapOptServerControls = (#{const LDAP_OPT_SERVER_CONTROLS}) fromEnum LdapOptClientControls = (#{const LDAP_OPT_CLIENT_CONTROLS}) fromEnum LdapOptApiFeatureInfo = (#{const LDAP_OPT_API_FEATURE_INFO}) fromEnum LdapOptHostName = (#{const LDAP_OPT_HOST_NAME}) fromEnum LdapOptErrorNumber = (#{const LDAP_OPT_ERROR_NUMBER}) fromEnum LdapOptErrorString = (#{const LDAP_OPT_ERROR_STRING}) fromEnum LdapOptMatchedDn = (#{const LDAP_OPT_MATCHED_DN}) fromEnum LdapOptSuccess = (#{const LDAP_OPT_SUCCESS}) fromEnum LdapOptError = (#{const LDAP_OPT_ERROR}) fromEnum (UnknownLDAPOptionCode x) = x instance Ord LDAPOptionCode where compare x y = compare (fromEnum x) (fromEnum y) instance Eq LDAPOptionCode where x == y = (fromEnum x) == (fromEnum y) data LDAPScope = LdapScopeDefault | LdapScopeBase | LdapScopeOnelevel | LdapScopeSubtree | UnknownLDAPScope Int deriving (Show) instance Enum LDAPScope where toEnum (#{const LDAP_SCOPE_DEFAULT}) = LdapScopeDefault toEnum (#{const LDAP_SCOPE_BASE}) = LdapScopeBase toEnum (#{const LDAP_SCOPE_ONELEVEL}) = LdapScopeOnelevel toEnum (#{const LDAP_SCOPE_SUBTREE}) = LdapScopeSubtree toEnum x = UnknownLDAPScope x fromEnum LdapScopeDefault = (#{const LDAP_SCOPE_DEFAULT}) fromEnum LdapScopeBase = (#{const LDAP_SCOPE_BASE}) fromEnum LdapScopeOnelevel = (#{const LDAP_SCOPE_ONELEVEL}) fromEnum LdapScopeSubtree = (#{const LDAP_SCOPE_SUBTREE}) fromEnum (UnknownLDAPScope x) = x instance Ord LDAPScope where compare x y = compare (fromEnum x) (fromEnum y) instance Eq LDAPScope where x == y = (fromEnum x) == (fromEnum y) data LDAPModOp = LdapModAdd | LdapModDelete | LdapModReplace | UnknownLDAPModOp Int deriving (Show) instance Enum LDAPModOp where toEnum (#{const LDAP_MOD_ADD}) = LdapModAdd toEnum (#{const LDAP_MOD_DELETE}) = LdapModDelete toEnum (#{const LDAP_MOD_REPLACE}) = LdapModReplace toEnum x = UnknownLDAPModOp x fromEnum LdapModAdd = (#{const LDAP_MOD_ADD}) fromEnum LdapModDelete = (#{const LDAP_MOD_DELETE}) fromEnum LdapModReplace = (#{const LDAP_MOD_REPLACE}) fromEnum (UnknownLDAPModOp x) = x instance Ord LDAPModOp where compare x y = compare (fromEnum x) (fromEnum y) instance Eq LDAPModOp where x == y = (fromEnum x) == (fromEnum y) LDAP-0.6.11/LDAP/Types.hsc0000644000000000000000000000235113035724255013037 0ustar0000000000000000{- -*- Mode: haskell; -*- Haskell LDAP Interface Copyright (C) 2005 John Goerzen This code is under a 3-clause BSD license; see COPYING for details. -} {- | Module : LDAP.Types Copyright : Copyright (C) 2005-2006 John Goerzen License : BSD Maintainer : John Goerzen, Maintainer : jgoerzen\@complete.org Stability : provisional Portability: portable Basic types for LDAP programs. Written by John Goerzen, jgoerzen\@complete.org See also "LDAP.Data" for types relating to return codes, option codes, etc. -} module LDAP.Types(-- * General LDAP, LDAPInt, BERInt, BERTag, BERLen ) where import Foreign.Ptr import Data.Word import Data.Int import Foreign.C.Types import Foreign.ForeignPtr import LDAP.TypesLL import LDAP.Data #include {- | Main LDAP object type. LDAP objects are automatically unbound (and memory freed) when they are garbage-collected by Haskell. -} type LDAP = ForeignPtr CLDAP {- | Convenience type so we use the correct ints for the LDAP library. -} type LDAPInt = CInt {- | BER type tag -} type BERTag = #type ber_tag_t {- | BER int type -} type BERInt = #type ber_int_t {- | BER length type -} type BERLen = #type ber_len_t LDAP-0.6.11/testsrc/0000755000000000000000000000000013035724255012202 5ustar0000000000000000LDAP-0.6.11/testsrc/runtests.hs0000644000000000000000000000024113035724255014422 0ustar0000000000000000{- arch-tag: Test runner Copyright (C) 2005 John Goerzen -} module Main where import Test.HUnit import Tests main = runTestTT tests