packages feed

LDAP (empty) → 0.6.1

raw patch · 15 files changed

+1312/−0 lines, 15 filesdep +basebuild-type:Customsetup-changed

Dependencies added: base

Files

+ COPYING view
@@ -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.
@@ -0,0 +1,4 @@+Haskell LDAP Interface+Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>++This code is under a 3-clause BSD license; see COPYING for details.
+ LDAP.cabal view
@@ -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 <jgoerzen@complete.org>+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
+ LDAP.hs view
@@ -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:++<http://software.complete.org/ldap-haskell>+-}++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/Constants.hsc view
@@ -0,0 +1,44 @@+{- -*- Mode: haskell; -*-+Haskell LDAP Interface+Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>++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/Data.hsc view
@@ -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)++
+ LDAP/Exceptions.hs view
@@ -0,0 +1,82 @@+{- -*- Mode: haskell; -*-+Haskell LDAP Interface+Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>++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)
+ LDAP/Init.hsc view
@@ -0,0 +1,86 @@+{- -*- Mode: haskell; -*-+Haskell LDAP Interface+Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>++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 <ldap.h>++{- | 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
+ LDAP/Modify.hsc view
@@ -0,0 +1,129 @@+{- -*- Mode: haskell; -*-+Haskell LDAP Interface+Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>++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 <ldap.h>++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
+ LDAP/Result.hsc view
@@ -0,0 +1,58 @@+{- -*- Mode: haskell; -*-+Haskell LDAP Interface+Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>++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 <ldap.h>++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 ())
+ LDAP/Search.hsc view
@@ -0,0 +1,162 @@+{- -*- Mode: haskell; -*-+Haskell LDAP Interface+Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>++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 <ldap.h>++{- | 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
+ LDAP/Types.hsc view
@@ -0,0 +1,56 @@+{-  -*- Mode: haskell; -*-+Haskell LDAP Interface+Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>++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 <ldap.h>++{- | 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/TypesLL.hs view
@@ -0,0 +1,27 @@+{-  -*- Mode: haskell; -*-+Haskell LDAP Interface+Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>++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/Utils.hsc view
@@ -0,0 +1,204 @@+{- -*- Mode: haskell; -*-+Haskell LDAP Interface+Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>++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 <ldap.h>++{- 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 ()
+ Setup.lhs view
@@ -0,0 +1,7 @@+#!/usr/bin/env runhugs+arch-tag: Main setup script++> import Distribution.Simple++> main = defaultMain+