module Network.Protocol.SASL.GNU
(
headerVersion
, libraryVersion
, checkVersion
, SASL
, runSASL
, setCallback
, runCallback
, Mechanism (..)
, clientMechanisms
, clientSupports
, clientSuggestMechanism
, serverMechanisms
, serverSupports
, Session
, runClient
, runServer
, mechanismName
, Property (..)
, setProperty
, getProperty
, getPropertyFast
, Progress (..)
, step
, step64
, encode
, decode
, Error (..)
, catch
, handle
, try
, throw
, toBase64
, fromBase64
, md5
, sha1
, hmacMD5
, hmacSHA1
, nonce
, random
) where
import Prelude hiding (catch)
import qualified Control.Exception as E
import qualified Data.ByteString as B
import qualified Data.ByteString.Unsafe as B
import Data.ByteString.Char8 ()
import Data.Char (isDigit)
import Data.Typeable (Typeable)
import Data.String (IsString, fromString)
import qualified Foreign as F
import qualified Foreign.C as F
import System.IO.Unsafe (unsafePerformIO)
import Control.Monad (when, unless)
import Control.Monad.IO.Class (MonadIO, liftIO)
import qualified Control.Monad.Trans.Reader as R
import qualified Text.ParserCombinators.ReadP as P
headerVersion :: (Integer, Integer, Integer)
headerVersion = (major, minor, patch) where
major = toInteger hsgsasl_VERSION_MAJOR
minor = toInteger hsgsasl_VERSION_MINOR
patch = toInteger hsgsasl_VERSION_PATCH
libraryVersion :: IO (Integer, Integer, Integer)
libraryVersion = io where
parseVersion str = case P.readP_to_S parser str of
[] -> Nothing
((parsed, _):_) -> Just parsed
parser = do
majorS <- P.munch1 isDigit
P.char '.'
minorS <- P.munch1 isDigit
P.char '.'
patchS <- P.munch1 isDigit
P.eof
return (read majorS, read minorS, read patchS)
io = do
cstr <- gsasl_check_version F.nullPtr
maybeStr <- F.maybePeek F.peekCString cstr
return $ case maybeStr >>= parseVersion of
Just version -> version
Nothing -> error $ "Invalid version string: " ++ show maybeStr
checkVersion :: IO Bool
checkVersion = fmap (== 1) hsgsasl_check_version
newtype Context = Context (F.Ptr Context)
newtype SASL a = SASL { unSASL :: R.ReaderT Context IO a }
instance Functor SASL where
fmap f = SASL . fmap f . unSASL
instance Monad SASL where
return = SASL . return
(>>=) sasl f = SASL $ unSASL sasl >>= unSASL . f
instance MonadIO SASL where
liftIO = SASL . liftIO
runSASL :: SASL a -> IO a
runSASL = withContext . R.runReaderT . unSASL
withContext :: (Context -> IO a) -> IO a
withContext = E.bracket newContext freeContext where
newContext = F.alloca $ \pCtxt -> do
gsasl_init pCtxt >>= checkRC
Context `fmap` F.peek pCtxt
freeContext (Context ctx) = do
hook <- gsasl_callback_hook_get ctx
gsasl_done ctx
freeCallbackHook hook
getContext :: SASL (F.Ptr Context)
getContext = SASL $ do
Context ptr <- R.ask
return ptr
bracketSASL :: (F.Ptr Context -> IO a) -> (a -> IO b) -> (a -> IO c) -> SASL c
bracketSASL before after thing = do
ctx <- getContext
liftIO $ E.bracket (before ctx) after thing
newtype Mechanism = Mechanism B.ByteString
deriving (Show, Eq)
instance IsString Mechanism where
fromString = Mechanism . fromString
clientMechanisms :: SASL [Mechanism]
clientMechanisms = bracketSASL io gsasl_free splitMechListPtr where
io ctx = F.alloca $ \pStr -> do
gsasl_client_mechlist ctx pStr >>= checkRC
F.peek pStr
clientSupports :: Mechanism -> SASL Bool
clientSupports (Mechanism name) = do
ctx <- getContext
liftIO $ B.useAsCString name $ \pName -> do
cres <- gsasl_client_support_p ctx pName
return $ cres == 1
clientSuggestMechanism :: [Mechanism] -> SASL (Maybe Mechanism)
clientSuggestMechanism mechs = do
let bytes = B.intercalate " " [x | Mechanism x <- mechs]
ctx <- getContext
liftIO $ B.useAsCString bytes $ \pMechlist ->
gsasl_client_suggest_mechanism ctx pMechlist >>=
F.maybePeek (fmap Mechanism . B.packCString)
serverMechanisms :: SASL [Mechanism]
serverMechanisms = bracketSASL io gsasl_free splitMechListPtr where
io ctx = F.alloca $ \pStr -> do
gsasl_server_mechlist ctx pStr >>= checkRC
F.peek pStr
serverSupports :: Mechanism -> SASL Bool
serverSupports (Mechanism name) = do
ctx <- getContext
liftIO $ B.useAsCString name $ \pName -> do
cres <- gsasl_server_support_p ctx pName
return $ cres == 1
splitMechListPtr :: F.CString -> IO [Mechanism]
splitMechListPtr ptr = unfoldrM step' (ptr, ptr, 0, True) where
step' (_, _, _, False) = return Nothing
step' (p_0, p_i, i, _) = F.peek p_i >>= \chr -> let
p_i' = F.plusPtr p_i 1
peek continue = if i == 0
then step' (p_i', p_i', 0, continue)
else do
bytes <- B.packCStringLen (p_0, i)
return $ Just (Mechanism bytes, (p_i', p_i', 0, continue))
in case chr of
0x00 -> peek False
0x20 -> peek True
_ -> step' (p_0, p_i', i + 1, True)
newtype SessionCtx = SessionCtx (F.Ptr SessionCtx)
newtype Session a = Session { unSession :: R.ReaderT SessionCtx IO a }
instance Functor Session where
fmap f = Session . fmap f . unSession
instance Monad Session where
return = Session . return
(>>=) m f = Session $ unSession m >>= unSession . f
instance MonadIO Session where
liftIO = Session . liftIO
type SessionProc = F.Ptr Context -> F.CString -> F.Ptr (F.Ptr SessionCtx) -> IO F.CInt
runSession :: SessionProc -> Mechanism -> Session a -> SASL (Either Error a)
runSession start (Mechanism mech) session = bracketSASL newSession freeSession io where
newSession ctx =
B.useAsCString mech $ \pMech ->
F.alloca $ \pSessionCtx -> E.handle noSession $ do
start ctx pMech pSessionCtx >>= checkRC
fmap (Right . SessionCtx) $ F.peek pSessionCtx
noSession (SASLException err) = return $ Left err
freeSession (Left _) = return ()
freeSession (Right (SessionCtx ptr)) = gsasl_finish ptr
io (Left err) = return $ Left err
io (Right sctx) = E.catch
(fmap Right $ R.runReaderT (unSession session) sctx)
(\(SASLException err) -> return $ Left err)
runClient :: Mechanism -> Session a -> SASL (Either Error a)
runClient = runSession gsasl_client_start
runServer :: Mechanism -> Session a -> SASL (Either Error a)
runServer = runSession gsasl_server_start
getSessionContext :: Session (F.Ptr SessionCtx)
getSessionContext = Session $ do
SessionCtx sctx <- R.ask
return sctx
mechanismName :: Session Mechanism
mechanismName = do
sctx <- getSessionContext
liftIO $ do
cstr <- gsasl_mechanism_name sctx
Mechanism `fmap` B.packCString cstr
bracketSession :: (F.Ptr SessionCtx -> IO a) -> (a -> IO b) -> (a -> IO c) -> Session c
bracketSession before after thing = do
sctx <- getSessionContext
liftIO $ E.bracket (before sctx) after thing
data Error
= UnknownMechanism
| MechanismCalledTooManyTimes
| MallocError
| Base64Error
| CryptoError
| SASLPrepError
| MechanismParseError
| AuthenticationError
| IntegrityError
| NoClientCode
| NoServerCode
| NoCallback
| NoAnonymousToken
| NoAuthID
| NoAuthzID
| NoPassword
| NoPasscode
| NoPIN
| NoService
| NoHostname
| GSSAPI_ReleaseBufferError
| GSSAPI_ImportNameError
| GSSAPI_InitSecContextError
| GSSAPI_AcceptSecContextError
| GSSAPI_UnwrapError
| GSSAPI_WrapError
| GSSAPI_AquireCredError
| GSSAPI_DisplayNameError
| GSSAPI_UnsupportedProtectionError
| GSSAPI_EncapsulateTokenError
| GSSAPI_DecapsulateTokenError
| GSSAPI_InquireMechForSASLNameError
| GSSAPI_TestOIDSetMemberError
| GSSAPI_ReleaseOIDSetError
| KerberosV5_InitError
| KerberosV5_InternalError
| SecurID_ServerNeedAdditionalPasscode
| SecurID_ServerNeedNewPIN
instance Show Error where
show = strError
strError :: Error -> String
strError err = unsafePerformIO $ gsasl_strerror (cFromError err) >>= F.peekCString
data SASLException = SASLException Error
deriving (Show, Typeable)
instance E.Exception SASLException
cFromError :: Error -> F.CInt
cFromError e = case e of
UnknownMechanism -> 2
MechanismCalledTooManyTimes -> 3
MallocError -> 7
Base64Error -> 8
CryptoError -> 9
SASLPrepError -> 29
MechanismParseError -> 30
AuthenticationError -> 31
IntegrityError -> 33
NoClientCode -> 35
NoServerCode -> 36
NoCallback -> 51
NoAnonymousToken -> 52
NoAuthID -> 53
NoAuthzID -> 54
NoPassword -> 55
NoPasscode -> 56
NoPIN -> 57
NoService -> 58
NoHostname -> 59
GSSAPI_ReleaseBufferError -> 37
GSSAPI_ImportNameError -> 38
GSSAPI_InitSecContextError -> 39
GSSAPI_AcceptSecContextError -> 40
GSSAPI_UnwrapError -> 41
GSSAPI_WrapError -> 42
GSSAPI_AquireCredError -> 43
GSSAPI_DisplayNameError -> 44
GSSAPI_UnsupportedProtectionError -> 45
GSSAPI_EncapsulateTokenError -> 60
GSSAPI_DecapsulateTokenError -> 61
GSSAPI_InquireMechForSASLNameError -> 62
GSSAPI_TestOIDSetMemberError -> 63
GSSAPI_ReleaseOIDSetError -> 64
KerberosV5_InitError -> 46
KerberosV5_InternalError -> 47
SecurID_ServerNeedAdditionalPasscode -> 48
SecurID_ServerNeedNewPIN -> 49
cToError :: F.CInt -> Error
cToError x = case x of
2 -> UnknownMechanism
3 -> MechanismCalledTooManyTimes
7 -> MallocError
8 -> Base64Error
9 -> CryptoError
29 -> SASLPrepError
30 -> MechanismParseError
31 -> AuthenticationError
33 -> IntegrityError
35 -> NoClientCode
36 -> NoServerCode
51 -> NoCallback
52 -> NoAnonymousToken
53 -> NoAuthID
54 -> NoAuthzID
55 -> NoPassword
56 -> NoPasscode
57 -> NoPIN
58 -> NoService
59 -> NoHostname
37 -> GSSAPI_ReleaseBufferError
38 -> GSSAPI_ImportNameError
39 -> GSSAPI_InitSecContextError
40 -> GSSAPI_AcceptSecContextError
41 -> GSSAPI_UnwrapError
42 -> GSSAPI_WrapError
43 -> GSSAPI_AquireCredError
44 -> GSSAPI_DisplayNameError
45 -> GSSAPI_UnsupportedProtectionError
60 -> GSSAPI_EncapsulateTokenError
61 -> GSSAPI_DecapsulateTokenError
62 -> GSSAPI_InquireMechForSASLNameError
63 -> GSSAPI_TestOIDSetMemberError
64 -> GSSAPI_ReleaseOIDSetError
46 -> KerberosV5_InitError
47 -> KerberosV5_InternalError
48 -> SecurID_ServerNeedAdditionalPasscode
49 -> SecurID_ServerNeedNewPIN
_ -> error $ "Unknown GNU SASL return code: " ++ show x
throw :: Error -> Session a
throw = liftIO . E.throwIO . SASLException
catch :: Session a -> (Error -> Session a) -> Session a
catch m f = do
sctx <- SessionCtx `fmap` getSessionContext
Session . liftIO $ E.catch
(R.runReaderT (unSession m) sctx)
(\(SASLException err) -> R.runReaderT (unSession (f err)) sctx)
handle :: (Error -> Session a) -> Session a -> Session a
handle = flip catch
try :: Session a -> Session (Either Error a)
try m = catch (fmap Right m) (return . Left)
data Property
= PropertyAuthID
| PropertyAuthzID
| PropertyPassword
| PropertyAnonymousToken
| PropertyService
| PropertyHostname
| PropertyGSSAPIDisplayName
| PropertyPasscode
| PropertySuggestedPIN
| PropertyPIN
| PropertyRealm
| PropertyDigestMD5HashedPassword
| PropertyQOPS
| PropertyQOP
| PropertyScramIter
| PropertyScramSalt
| PropertyScramSaltedPassword
| ValidateSimple
| ValidateExternal
| ValidateAnonymous
| ValidateGSSAPI
| ValidateSecurID
deriving (Show, Eq)
cFromProperty :: Property -> F.CInt
cFromProperty x = case x of
PropertyAuthID -> 1
PropertyAuthzID -> 2
PropertyPassword -> 3
PropertyAnonymousToken -> 4
PropertyService -> 5
PropertyHostname -> 6
PropertyGSSAPIDisplayName -> 7
PropertyPasscode -> 8
PropertySuggestedPIN -> 9
PropertyPIN -> 10
PropertyRealm -> 11
PropertyDigestMD5HashedPassword -> 12
PropertyQOPS -> 13
PropertyQOP -> 14
PropertyScramIter -> 15
PropertyScramSalt -> 16
PropertyScramSaltedPassword -> 17
ValidateSimple -> 500
ValidateExternal -> 501
ValidateAnonymous -> 502
ValidateGSSAPI -> 503
ValidateSecurID -> 504
cToProperty :: F.CInt -> Property
cToProperty x = case x of
1 -> PropertyAuthID
2 -> PropertyAuthzID
3 -> PropertyPassword
4 -> PropertyAnonymousToken
5 -> PropertyService
6 -> PropertyHostname
7 -> PropertyGSSAPIDisplayName
8 -> PropertyPasscode
9 -> PropertySuggestedPIN
10 -> PropertyPIN
11 -> PropertyRealm
12 -> PropertyDigestMD5HashedPassword
13 -> PropertyQOPS
14 -> PropertyQOP
15 -> PropertyScramIter
16 -> PropertyScramSalt
17 -> PropertyScramSaltedPassword
500 -> ValidateSimple
501 -> ValidateExternal
502 -> ValidateAnonymous
503 -> ValidateGSSAPI
504 -> ValidateSecurID
_ -> error $ "Unknown GNU SASL property code: " ++ show x
setProperty :: Property -> B.ByteString -> Session ()
setProperty prop bytes = do
sctx <- getSessionContext
liftIO $
B.useAsCString bytes $
gsasl_property_set sctx (cFromProperty prop)
getProperty :: Property -> Session (Maybe B.ByteString)
getProperty prop = do
sctx <- getSessionContext
liftIO $ do
cstr <- gsasl_property_get sctx (cFromProperty prop)
if cstr /= F.nullPtr
then fmap Just $ B.packCString cstr
else do
liftIO $ checkCallbackException sctx
return Nothing
getPropertyFast :: Property -> Session (Maybe B.ByteString)
getPropertyFast prop = do
sctx <- getSessionContext
liftIO $
gsasl_property_fast sctx (cFromProperty prop) >>=
F.maybePeek B.packCString
type CallbackFn = F.Ptr Context -> F.Ptr SessionCtx -> F.CInt -> IO F.CInt
data CallbackHook = CallbackHook (F.FunPtr CallbackFn) (Property -> Session Progress)
newCallbackHook :: (Property -> Session Progress) -> IO (F.Ptr CallbackHook, F.FunPtr CallbackFn)
newCallbackHook cb = E.bracketOnError
(wrapCallbackImpl (callbackImpl cb))
F.freeHaskellFunPtr
(\funPtr -> let hook = CallbackHook funPtr cb in E.bracketOnError
(F.newStablePtr hook)
F.freeStablePtr
(\stablePtr -> let
hookPtr = F.castPtr (F.castStablePtrToPtr stablePtr)
in return (hookPtr, funPtr)))
freeCallbackHook :: F.Ptr CallbackHook -> IO ()
freeCallbackHook ptr = unless (ptr == F.nullPtr) $ do
let stablePtr = F.castPtrToStablePtr $ F.castPtr ptr
hook <- F.deRefStablePtr stablePtr
F.freeStablePtr stablePtr
let (CallbackHook funPtr _) = hook
F.freeHaskellFunPtr funPtr
callbackImpl :: (Property -> Session Progress) -> CallbackFn
callbackImpl cb _ sctx cProp = let
globalIO = error "globalIO is not implemented"
sessionIO = do
let session = cb $ cToProperty cProp
fmap cFromProgress $ R.runReaderT (unSession session) (SessionCtx sctx)
onError :: SASLException -> IO F.CInt
onError (SASLException err) = return $ cFromError err
onException :: E.SomeException -> IO F.CInt
onException exc = do
stablePtr <- F.newStablePtr exc
gsasl_session_hook_set sctx $ F.castStablePtrToPtr stablePtr
return (1)
catchErrors io = E.catches io [E.Handler onError, E.Handler onException]
in catchErrors $ if sctx == F.nullPtr then globalIO else sessionIO
foreign import ccall "wrapper"
wrapCallbackImpl :: CallbackFn -> IO (F.FunPtr CallbackFn)
checkCallbackException :: F.Ptr SessionCtx -> IO ()
checkCallbackException sctx = do
hook <- gsasl_session_hook_get sctx
when (hook /= F.nullPtr) $ do
let stable = F.castPtrToStablePtr hook
exc <- F.deRefStablePtr stable
F.freeStablePtr stable
E.throwIO (exc :: E.SomeException)
setCallback :: (Property -> Session Progress) -> SASL ()
setCallback cb = do
ctx <- getContext
liftIO $ do
freeCallbackHook =<< gsasl_callback_hook_get ctx
(hook, cbPtr) <- newCallbackHook cb
gsasl_callback_hook_set ctx hook
gsasl_callback_set ctx cbPtr
runCallback :: Property -> Session Progress
runCallback prop = do
ctx <- fmap F.castPtr getSessionContext
hookPtr <- liftIO $ gsasl_callback_hook_get ctx
when (hookPtr == F.nullPtr) $ throw NoCallback
hook <- liftIO $ F.deRefStablePtr $ F.castPtrToStablePtr hookPtr
let (CallbackHook _ cb) = hook
cb prop
data Progress = Complete | NeedsMore
deriving (Show, Eq)
cFromProgress :: Progress -> F.CInt
cFromProgress x = case x of
Complete -> 0
NeedsMore -> 1
step :: B.ByteString -> Session (B.ByteString, Progress)
step input = bracketSession get free peek where
get sctx =
B.unsafeUseAsCStringLen input $ \(pInput, inputLen) ->
F.alloca $ \pOutput ->
F.alloca $ \pOutputLen -> do
rc <- gsasl_step sctx pInput (fromIntegral inputLen) pOutput pOutputLen
when (rc /= 0) $ checkCallbackException sctx
progress <- checkStepRC rc
cstr <- F.peek pOutput
cstrLen <- F.peek pOutputLen
return (cstr, cstrLen, progress)
free (cstr, _, _) = gsasl_free cstr
peek (cstr, cstrLen, progress) = do
output <- B.packCStringLen (cstr, fromIntegral cstrLen)
return (output, progress)
step64 :: B.ByteString -> Session (B.ByteString, Progress)
step64 input = bracketSession get free peek where
get sctx =
B.useAsCString input $ \pInput ->
F.alloca $ \pOutput -> do
rc <- gsasl_step64 sctx pInput pOutput
when (rc /= 0) $ checkCallbackException sctx
progress <- checkStepRC rc
cstr <- F.peek pOutput
return (cstr, progress)
free (cstr, _) = gsasl_free cstr
peek (cstr, progress) = do
output <- B.packCString cstr
return (output, progress)
checkStepRC :: F.CInt -> IO Progress
checkStepRC x = case x of
0 -> return Complete
1 -> return NeedsMore
_ -> E.throwIO (SASLException (cToError x))
encode :: B.ByteString -> Session B.ByteString
encode input = do
sctx <- getSessionContext
liftIO $
B.unsafeUseAsCStringLen input $ \(cstr, cstrLen) ->
F.alloca $ \pOutput ->
F.alloca $ \pOutputLen -> do
rc <- gsasl_encode sctx cstr (fromIntegral cstrLen) pOutput pOutputLen
when (rc /= 0) $ checkCallbackException sctx
checkRC rc
output <- F.peek pOutput
outputLen <- fromIntegral `fmap` F.peek pOutputLen
outBytes <- B.packCStringLen (output, outputLen)
gsasl_free output
return outBytes
decode :: B.ByteString -> Session B.ByteString
decode input = do
sctx <- getSessionContext
liftIO $
B.unsafeUseAsCStringLen input $ \(cstr, cstrLen) ->
F.alloca $ \pOutput ->
F.alloca $ \pOutputLen -> do
rc <- gsasl_decode sctx cstr (fromIntegral cstrLen) pOutput pOutputLen
when (rc /= 0) $ checkCallbackException sctx
checkRC rc
output <- F.peek pOutput
outputLen <- fromIntegral `fmap` F.peek pOutputLen
outputBytes <- B.packCStringLen (output, outputLen)
gsasl_free output
return outputBytes
toBase64 :: B.ByteString -> B.ByteString
toBase64 input = unsafePerformIO $
B.unsafeUseAsCStringLen input $ \(pIn, inLen) ->
F.alloca $ \pOut ->
F.alloca $ \pOutLen -> do
gsasl_base64_to pIn (fromIntegral inLen) pOut pOutLen >>= checkRC
outLen <- F.peek pOutLen
outPtr <- F.peek pOut
B.packCStringLen (outPtr, fromIntegral outLen)
fromBase64 :: B.ByteString -> B.ByteString
fromBase64 input = unsafePerformIO $
B.unsafeUseAsCStringLen input $ \(pIn, inLen) ->
F.alloca $ \pOut ->
F.alloca $ \pOutLen -> do
gsasl_base64_from pIn (fromIntegral inLen) pOut pOutLen >>= checkRC
outLen <- F.peek pOutLen
outPtr <- F.peek pOut
B.packCStringLen (outPtr, fromIntegral outLen)
md5 :: B.ByteString -> B.ByteString
md5 input = unsafePerformIO $
B.unsafeUseAsCStringLen input $ \(pIn, inLen) ->
F.alloca $ \pOut ->
F.allocaBytes 16 $ \outBuf -> do
F.poke pOut outBuf
gsasl_md5 pIn (fromIntegral inLen) pOut >>= checkRC
B.packCStringLen (outBuf, 16)
sha1 :: B.ByteString -> B.ByteString
sha1 input = unsafePerformIO $
B.unsafeUseAsCStringLen input $ \(pIn, inLen) ->
F.alloca $ \pOut ->
F.allocaBytes 20 $ \outBuf -> do
F.poke pOut outBuf
gsasl_sha1 pIn (fromIntegral inLen) pOut >>= checkRC
B.packCStringLen (outBuf, 20)
hmacMD5 :: B.ByteString
-> B.ByteString
-> B.ByteString
hmacMD5 key input = unsafePerformIO $
B.unsafeUseAsCStringLen key $ \(pKey, keyLen) ->
B.unsafeUseAsCStringLen input $ \(pIn, inLen) ->
F.alloca $ \pOut ->
F.allocaBytes 16 $ \outBuf -> do
F.poke pOut outBuf
gsasl_hmac_md5 pKey (fromIntegral keyLen) pIn (fromIntegral inLen) pOut >>= checkRC
B.packCStringLen (outBuf, 16)
hmacSHA1 :: B.ByteString
-> B.ByteString
-> B.ByteString
hmacSHA1 key input = unsafePerformIO $
B.unsafeUseAsCStringLen key $ \(pKey, keyLen) ->
B.unsafeUseAsCStringLen input $ \(pIn, inLen) ->
F.alloca $ \pOut ->
F.allocaBytes 20 $ \outBuf -> do
F.poke pOut outBuf
gsasl_hmac_sha1 pKey (fromIntegral keyLen) pIn (fromIntegral inLen) pOut >>= checkRC
B.packCStringLen (outBuf, 20)
nonce :: Integer -> IO B.ByteString
nonce size = F.allocaBytes (fromInteger size) $ \buf -> do
gsasl_nonce buf (fromIntegral size) >>= checkRC
B.packCStringLen (buf, fromIntegral size)
random :: Integer -> IO B.ByteString
random size = F.allocaBytes (fromInteger size) $ \buf -> do
gsasl_random buf (fromIntegral size) >>= checkRC
B.packCStringLen (buf, fromIntegral size)
checkRC :: F.CInt -> IO ()
checkRC x = case x of
0 -> return ()
_ -> E.throwIO (SASLException (cToError x))
unfoldrM :: Monad m => (b -> m (Maybe (a, b))) -> b -> m [a]
unfoldrM m b = m b >>= \x -> case x of
Just (a, new_b) -> do
as <- unfoldrM m new_b
return $ a : as
Nothing -> return []
foreign import ccall unsafe "hsgsasl_VERSION_MAJOR"
hsgsasl_VERSION_MAJOR :: F.CInt
foreign import ccall unsafe "hsgsasl_VERSION_MINOR"
hsgsasl_VERSION_MINOR :: F.CInt
foreign import ccall unsafe "hsgsasl_VERSION_PATCH"
hsgsasl_VERSION_PATCH :: F.CInt
foreign import ccall unsafe "hsgsasl_check_version"
hsgsasl_check_version :: IO F.CInt
foreign import ccall unsafe "gsasl.h gsasl_init"
gsasl_init :: F.Ptr (F.Ptr Context) -> IO F.CInt
foreign import ccall unsafe "gsasl.h gsasl_done"
gsasl_done :: F.Ptr Context -> IO ()
foreign import ccall unsafe "gsasl.h gsasl_check_version"
gsasl_check_version :: F.CString -> IO F.CString
foreign import ccall unsafe "gsasl.h gsasl_callback_set"
gsasl_callback_set :: F.Ptr Context -> F.FunPtr CallbackFn -> IO ()
foreign import ccall unsafe "gsasl.h gsasl_callback_hook_get"
gsasl_callback_hook_get :: F.Ptr Context -> IO (F.Ptr a)
foreign import ccall unsafe "gsasl.h gsasl_callback_hook_set"
gsasl_callback_hook_set :: F.Ptr Context -> F.Ptr a -> IO ()
foreign import ccall unsafe "gsasl.h gsasl_session_hook_get"
gsasl_session_hook_get :: F.Ptr SessionCtx -> IO (F.Ptr a)
foreign import ccall unsafe "gsasl.h gsasl_session_hook_set"
gsasl_session_hook_set :: F.Ptr SessionCtx -> F.Ptr a -> IO ()
foreign import ccall unsafe "gsasl.h gsasl_property_set"
gsasl_property_set :: F.Ptr SessionCtx -> F.CInt -> F.CString -> IO ()
foreign import ccall safe "gsasl.h gsasl_property_get"
gsasl_property_get :: F.Ptr SessionCtx -> F.CInt -> IO F.CString
foreign import ccall unsafe "gsasl.h gsasl_property_fast"
gsasl_property_fast :: F.Ptr SessionCtx -> F.CInt -> IO F.CString
foreign import ccall unsafe "gsasl.h gsasl_client_mechlist"
gsasl_client_mechlist :: F.Ptr Context -> F.Ptr F.CString -> IO F.CInt
foreign import ccall unsafe "gsasl.h gsasl_client_support_p"
gsasl_client_support_p :: F.Ptr Context -> F.CString -> IO F.CInt
foreign import ccall unsafe "gsasl.h gsasl_client_suggest_mechanism"
gsasl_client_suggest_mechanism :: F.Ptr Context -> F.CString -> IO F.CString
foreign import ccall unsafe "gsasl.h gsasl_server_mechlist"
gsasl_server_mechlist :: F.Ptr Context -> F.Ptr F.CString -> IO F.CInt
foreign import ccall unsafe "gsasl.h gsasl_server_support_p"
gsasl_server_support_p :: F.Ptr Context -> F.CString -> IO F.CInt
foreign import ccall safe "gsasl.h gsasl_client_start"
gsasl_client_start :: SessionProc
foreign import ccall safe "gsasl.h gsasl_server_start"
gsasl_server_start :: SessionProc
foreign import ccall safe "gsasl.h gsasl_step"
gsasl_step :: F.Ptr SessionCtx -> F.CString -> F.CSize -> F.Ptr F.CString -> F.Ptr F.CSize -> IO F.CInt
foreign import ccall safe "gsasl.h gsasl_step64"
gsasl_step64 :: F.Ptr SessionCtx -> F.CString -> F.Ptr F.CString -> IO F.CInt
foreign import ccall safe "gsasl.h gsasl_finish"
gsasl_finish :: F.Ptr SessionCtx -> IO ()
foreign import ccall safe "gsasl.h gsasl_encode"
gsasl_encode :: F.Ptr SessionCtx -> F.CString -> F.CSize -> F.Ptr F.CString -> F.Ptr F.CSize -> IO F.CInt
foreign import ccall safe "gsasl.h gsasl_decode"
gsasl_decode :: F.Ptr SessionCtx -> F.CString -> F.CSize -> F.Ptr F.CString -> F.Ptr F.CSize -> IO F.CInt
foreign import ccall unsafe "gsasl.h gsasl_mechanism_name"
gsasl_mechanism_name :: F.Ptr SessionCtx -> IO F.CString
foreign import ccall unsafe "gsasl.h gsasl_strerror"
gsasl_strerror :: F.CInt -> IO F.CString
foreign import ccall unsafe "gsasl.h gsasl_base64_to"
gsasl_base64_to :: F.CString -> F.CSize -> F.Ptr F.CString -> F.Ptr F.CSize -> IO F.CInt
foreign import ccall unsafe "gsasl.h gsasl_base64_from"
gsasl_base64_from :: F.CString -> F.CSize -> F.Ptr F.CString -> F.Ptr F.CSize -> IO F.CInt
foreign import ccall unsafe "gsasl.h gsasl_md5"
gsasl_md5 :: F.CString -> F.CSize -> F.Ptr F.CString -> IO F.CInt
foreign import ccall unsafe "gsasl.h gsasl_sha1"
gsasl_sha1 :: F.CString -> F.CSize -> F.Ptr F.CString -> IO F.CInt
foreign import ccall unsafe "gsasl.h gsasl_hmac_md5"
gsasl_hmac_md5 :: F.CString -> F.CSize -> F.CString -> F.CSize -> F.Ptr F.CString -> IO F.CInt
foreign import ccall unsafe "gsasl.h gsasl_hmac_sha1"
gsasl_hmac_sha1 :: F.CString -> F.CSize -> F.CString -> F.CSize -> F.Ptr F.CString -> IO F.CInt
foreign import ccall unsafe "gsasl.h gsasl_nonce"
gsasl_nonce :: F.CString -> F.CSize -> IO F.CInt
foreign import ccall unsafe "gsasl.h gsasl_random"
gsasl_random :: F.CString -> F.CSize -> IO F.CInt
foreign import ccall unsafe "gsasl.h gsasl_free"
gsasl_free :: F.Ptr a -> IO ()