diff --git a/COPYING b/COPYING new file mode 100644 --- /dev/null +++ b/COPYING @@ -0,0 +1,26 @@ +Copyright (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. diff --git a/COPYRIGHT b/COPYRIGHT new file mode 100644 --- /dev/null +++ b/COPYRIGHT @@ -0,0 +1,4 @@ +Haskell LDAP Interface +Copyright (C) 2005 John Goerzen + +This code is under a 3-clause BSD license; see COPYING for details. diff --git a/LDAP.cabal b/LDAP.cabal new file mode 100644 --- /dev/null +++ b/LDAP.cabal @@ -0,0 +1,31 @@ +Extra-Libraries: ldap +-- End detected settings section. Everything below here should not +-- need editing. +Name: LDAP +Version: 0.6.1 +License: BSD3 +Maintainer: John Goerzen +Author: John Goerzen +Stability: Beta +Copyright: Copyright (c) 2005-2006 John Goerzen +homepage: http://darcs.complete.org/ldap-haskell +Category: Network +Synopsis: Haskell binding for C LDAP API +license-file: COPYRIGHT +extra-source-files: COPYING +-- C-Sources: glue/glue.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 +GHC-Options: -O2 +-- CC-Options: -Iglue +Extensions: ForeignFunctionInterface, TypeSynonymInstances diff --git a/LDAP.hs b/LDAP.hs new file mode 100644 --- /dev/null +++ b/LDAP.hs @@ -0,0 +1,52 @@ +{- -*- 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(..)) + diff --git a/LDAP/Constants.hsc b/LDAP/Constants.hsc new file mode 100644 --- /dev/null +++ b/LDAP/Constants.hsc @@ -0,0 +1,44 @@ +{- -*- 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 + diff --git a/LDAP/Data.hsc b/LDAP/Data.hsc new file mode 100644 --- /dev/null +++ b/LDAP/Data.hsc @@ -0,0 +1,344 @@ +-- 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_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_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) + + diff --git a/LDAP/Exceptions.hs b/LDAP/Exceptions.hs new file mode 100644 --- /dev/null +++ b/LDAP/Exceptions.hs @@ -0,0 +1,82 @@ +{- -*- 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.Exceptions + Copyright : Copyright (C) 2005-2006 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 + ) + +where +import Data.Dynamic +import Data.Typeable +import Control.Exception +import LDAP.Types +import LDAP.Data + +{- | 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 + } +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) + +ldapExceptionTc :: TyCon +ldapExceptionTc = mkTyCon "LDAP.LDAPException" + +instance Typeable LDAPException where + typeOf _ = mkTyConApp ldapExceptionTc [] + +{- | 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 + +{- | 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) diff --git a/LDAP/Init.hsc b/LDAP/Init.hsc new file mode 100644 --- /dev/null +++ b/LDAP/Init.hsc @@ -0,0 +1,86 @@ +{- -*- 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, + ldapSimpleBind) +where + +import Foreign.Ptr +import Foreign.C.String +import LDAP.Types +import Foreign.C.Types +import LDAP.Utils +import Foreign.Marshal.Utils + +#include + +{- | 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 -> + 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) + 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 -> + fromLDAPPtr "ldapOpen" $ cldap_open cs port) + +{- | 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 () + ))) + +foreign import ccall unsafe "ldap.h ldap_init" + cldap_init :: CString -> CInt -> IO LDAPPtr + + +foreign import ccall unsafe "ldap.h ldap_open" + cldap_open :: CString -> CInt -> IO LDAPPtr + +foreign import ccall unsafe "ldap.h ldap_simple_bind_s" + ldap_simple_bind_s :: LDAPPtr -> CString -> CString -> 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 new file mode 100644 --- /dev/null +++ b/LDAP/Modify.hsc @@ -0,0 +1,129 @@ +{- -*- 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 +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 unsafe "ldap.h ldap_modify_s" + ldap_modify_s :: LDAPPtr -> CString -> Ptr (Ptr CLDAPMod) -> IO LDAPInt + +foreign import ccall unsafe "ldap.h ldap_delete_s" + ldap_delete_s :: LDAPPtr -> CString -> IO LDAPInt + +foreign import ccall unsafe "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 new file mode 100644 --- /dev/null +++ b/LDAP/Result.hsc @@ -0,0 +1,58 @@ +{- -*- 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 + +#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 unsafe "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 ()) diff --git a/LDAP/Search.hsc b/LDAP/Search.hsc new file mode 100644 --- /dev/null +++ b/LDAP/Search.hsc @@ -0,0 +1,162 @@ +{- -*- 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 +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 + 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 unsafe "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 diff --git a/LDAP/Types.hsc b/LDAP/Types.hsc new file mode 100644 --- /dev/null +++ b/LDAP/Types.hsc @@ -0,0 +1,56 @@ +{- -*- 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 diff --git a/LDAP/TypesLL.hs b/LDAP/TypesLL.hs new file mode 100644 --- /dev/null +++ b/LDAP/TypesLL.hs @@ -0,0 +1,27 @@ +{- -*- 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 diff --git a/LDAP/Utils.hsc b/LDAP/Utils.hsc new file mode 100644 --- /dev/null +++ b/LDAP/Utils.hsc @@ -0,0 +1,204 @@ +{- -*- 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 } + throwDyn exc +{- + + else do s <- (ldap_err2string result >>= peekCString) + let exc = LDAPException {code = (toEnum (fromIntegral result)), + description = s, + caller = callername} + throwDyn 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 () diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,7 @@ +#!/usr/bin/env runhugs +arch-tag: Main setup script + +> import Distribution.Simple + +> main = defaultMain +