packages feed

pam (empty) → 0.1

raw patch · 7 files changed

+354/−0 lines, 7 filesdep +basesetup-changed

Dependencies added: base

Files

+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2011 Evgeny Tarasov.+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 the author 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 AUTHOR 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 AUTHOR 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.+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ pam.cabal view
@@ -0,0 +1,32 @@+Name:           pam+Version:        0.1+Cabal-Version:  >= 1.2.3+Build-type:     Simple+License:        BSD3+License-File:   LICENSE+Copyright:      Copyright (c) 2011 Evgeny Tarasov+Maintainer:     etarasov.ekb@gmail.com+Stability:      alpha+Synopsis:       Haskell binding for C PAM API+Description:    This package provides PAM interface for Haskell programs. It contains subset of C PAM API bindings. The bindings don't include functions for writing PAM modules.+Category:       System+Tested-with:    GHC==6.12.3+Extra-source-files: Setup.hs++Library+    exposed-modules: System.Posix.PAM+                     System.Posix.PAM.LowLevel+                     System.Posix.PAM.Types+                     System.Posix.PAM.Internals++    --other-modules:   System.Posix.PAM.Internals++    extensions: ForeignFunctionInterface++    Build-Depends:  base >= 4 && < 5+    Hs-Source-Dirs: src+    Ghc-options:    -Wall++    extra-libraries : pam++    build-tools: c2hs
+ src/System/Posix/PAM.hs view
@@ -0,0 +1,71 @@++module System.Posix.PAM where++import Foreign.Ptr+import System.Posix.PAM.LowLevel+import System.Posix.PAM.Types++authenticate :: String -> String -> String -> IO (Either Int ())+authenticate serviceName userName password = do+    let custConv :: String -> PamConv+        custConv pass _ messages = do+            let rs = map (\ _ -> PamResponse pass) messages+            return rs+    (pamH, r1) <- pamStart serviceName userName (custConv password, nullPtr)+    case r1 of+        PamRetCode code -> return $ Left $ fromInteger $ toInteger code+        PamSuccess -> do+            r2 <- pamAuthenticate pamH (PamFlag 0)+            case r2 of+                PamRetCode code -> return $ Left $ fromInteger $ toInteger code+                PamSuccess -> do+                    r3 <- pamEnd pamH r2+                    case r3 of+                        PamSuccess -> return $ Right ()+                        PamRetCode code -> return $ Left $ fromInteger $ toInteger code++checkAccount :: String -> String -> IO (Either Int ())+checkAccount = undefined+++pamCodeToMessage :: Int -> String+pamCodeToMessage = snd . pamCodeDetails++pamCodeToCDefine :: Int -> String+pamCodeToCDefine = fst . pamCodeDetails++pamCodeDetails :: Int -> (String, String)+pamCodeDetails code = case code of+    0 -> ("PAM_SUCCESS", "Successful function return")+    1 -> ("PAM_OPEN_ERR", "dlopen() failure when dynamically loading a service module")+    2 -> ("PAM_SYMBOL_ERR", "Symbol not found")+    3 -> ("PAM_SERVICE_ERR", "Error in service module")+    4 -> ("PAM_SYSTEM_ERR", "System error")+    5 -> ("PAM_BUF_ERR", "Memory buffer error")+    6 -> ("PAM_PERM_DENIED", "Permission denied")+    7 -> ("PAM_AUTH_ERR", "Authentication failure")+    8 -> ("PAM_CRED_INSUFFICIENT", "Can not access authentication data due to insufficient credentials")+    9 -> ("PAM_AUTHINFO_UNAVAIL", "Underlying authentication service can not retrieve authentication information")+    10 -> ("PAM_USER_UNKNOWN", "User not known to the underlying authenticaiton module")+    11 -> ("PAM_MAXTRIES", "An authentication service has maintained a retry count which has been reached.  No further retries should be attempted")+    12 -> ("PAM_NEW_AUTHTOK_REQD", "New authentication token required. This is normally returned if the machine security policies require that the password should be changed beccause the password is NULL or it has aged")+    13 -> ("PAM_ACCT_EXPIRED", "User account has expired")+    14 -> ("PAM_SESSION_ERR", "Can not make/remove an entry for the specified session")+    15 -> ("PAM_CRED_UNAVAIL", "Underlying authentication service can not retrieve user credentials unavailable")+    16 -> ("PAM_CRED_EXPIRED", "User credentials expired")+    17 -> ("PAM_CRED_ERR", "Failure setting user credentials")+    18 -> ("PAM_NO_MODULE_DATA", "No module specific data is present")+    19 -> ("PAM_CONV_ERR", "Conversation error")+    20 -> ("PAM_AUTHTOK_ERR", "Authentication token manipulation error")+    21 -> ("PAM_AUTHTOK_RECOVERY_ERR", "Authentication information cannot be recovered")+    22 -> ("PAM_AUTHTOK_LOCK_BUSY", "Authentication token lock busy")+    23 -> ("PAM_AUTHTOK_DISABLE_AGING", "Authentication token aging disabled")+    24 -> ("PAM_TRY_AGAIN", "Preliminary check by password service")+    25 -> ("PAM_IGNORE", "Ignore underlying account module regardless of whether the control flag is required, optional, or sufficient")+    26 -> ("PAM_ABORT", "Critical error (?module fail now request)")+    27 -> ("PAM_AUTHTOK_EXPIRED", "user's authentication token has expired")+    28 -> ("PAM_MODULE_UNKNOWN", "module is not known")+    29 -> ("PAM_BAD_ITEM", "Bad item passed to pam_*_item()")+    30 -> ("PAM_CONV_AGAIN", "conversation function is event driven and data is not available yet")+    31 -> ("PAM_INCOMPLETE", "please call this function again to complete authentication stack. Before calling again, verify that conversation is completed")+    a -> ("PAM_UNKNOWN", "There is no code description in haskell pam library: " ++ show a)
+ src/System/Posix/PAM/Internals.chs view
@@ -0,0 +1,61 @@+{-# LANGUAGE CPP, ForeignFunctionInterface #-}+module System.Posix.PAM.Internals where++import Control.Applicative+import Foreign.C+import Foreign.Ptr+import Foreign.Storable++#include <security/pam_appl.h>++data CPamMessage = CPamMessage { msg_style :: CInt+                               , msg :: CString+                               }+                               deriving (Show,Eq)++instance Storable CPamMessage where+    alignment _ = alignment (undefined :: CDouble)+    sizeOf _ = sizeOf (undefined :: CInt) + sizeOf (undefined :: CString)+    peek p = CPamMessage <$> ({#get pam_message.msg_style #} p)+                         <*> ({#get pam_message.msg #} p)+    poke p (CPamMessage ms m) = do+        {#set pam_message.msg_style #} p ms+        {#set pam_message.msg #} p m++data CPamResponse = CPamResponse { resp :: CString+                                 , resp_retcode :: CInt+                                 }+                                 deriving (Show,Eq)++instance Storable CPamResponse where+    alignment _ = alignment (undefined :: CDouble)+    sizeOf _ = sizeOf (undefined :: CString) + sizeOf (undefined :: CInt)+    peek p = CPamResponse <$> ({#get pam_response.resp #} p)+                          <*> ({#get pam_response.resp_retcode #} p)+    poke p (CPamResponse r rc) = do+        {#set pam_response.resp #} p r+        {#set pam_response.resp_retcode #} p rc++data CPamConv = CPamConv { conv :: FunPtr (CInt -> Ptr (Ptr ()) -> Ptr (Ptr ()) -> Ptr () -> IO CInt)+                         , appdata_ptr :: Ptr ()+                         }+                         deriving (Show, Eq)++type ConvFunc = CInt -> Ptr (Ptr ()) -> Ptr (Ptr ()) -> Ptr () -> IO CInt+foreign import ccall "wrapper" mkconvFunc :: ConvFunc -> IO (FunPtr ConvFunc)++instance Storable CPamConv where+    alignment _ = alignment (undefined :: CDouble)+    sizeOf _ = sizeOf (undefined :: FunPtr ()) + sizeOf (undefined :: Ptr ())+    peek p = CPamConv <$> ({#get pam_conv.conv #} p)+                      <*> ({#get pam_conv.appdata_ptr #} p)+    poke p (CPamConv c ap) = do+        {#set pam_conv.conv #} p c+        {#set pam_conv.appdata_ptr #} p ap++type CPamHandleT = ()++foreign import ccall "security/pam_appl.h pam_start" c_pam_start :: CString -> CString -> Ptr CPamConv -> Ptr (Ptr CPamHandleT) -> IO CInt+foreign import ccall "security/pam_appl.h pam_end" c_pam_end :: Ptr CPamHandleT -> CInt -> IO CInt+foreign import ccall "security/pam_appl.h pam_authenticate" c_pam_authenticate :: Ptr CPamHandleT -> CInt -> IO CInt+foreign import ccall "security/pam_appl.h pam_acct_mgmt" c_pam_acct_mgmt :: Ptr CPamHandleT -> CInt -> IO CInt
+ src/System/Posix/PAM/LowLevel.hs view
@@ -0,0 +1,125 @@++module System.Posix.PAM.LowLevel where++import Foreign.C+import Foreign.Marshal.Array+import Foreign.Marshal.Alloc+import Foreign.Ptr+import Foreign.Storable+import System.Posix.PAM.Types+import System.Posix.PAM.Internals hiding (resp, conv)++retCodeFromC :: CInt -> PamRetCode+retCodeFromC rc = case rc of+            0 -> PamSuccess+            a -> PamRetCode $ fromInteger $ toInteger a++retCodeToC :: PamRetCode -> CInt+retCodeToC PamSuccess = 0+retCodeToC (PamRetCode a) = fromInteger $ toInteger a++responseToC :: PamResponse -> IO CPamResponse+responseToC (PamResponse resp) = do+    resp' <- newCString resp+    return $ CPamResponse resp' 0++messageFromC :: CPamMessage -> IO PamMessage+messageFromC cmes =+    let style = case msg_style cmes of+            1 -> PamPromptEchoOff+            2 -> PamPromptEchoOn+            3 -> PamErrorMsg+            4 -> PamTextInfo+            a -> error $ "unknown style value: " ++ show a+    in do+        str <- peekCString $ msg cmes+        return $ PamMessage str style++cConv :: (Ptr () -> [PamMessage] -> IO [PamResponse]) -> CInt -> Ptr (Ptr ()) -> Ptr (Ptr ()) -> Ptr () -> IO CInt+cConv customConv num mesArrPtr respArrPtr appData =+    if num <= 0+        then return 19+        else do+            -- get array pointer (pointer to first element)+            voidArr <- peek mesArrPtr++            -- cast pointer type from ()+            let mesArr = castPtr voidArr :: Ptr CPamMessage++            -- peek message list from array+            cMessages <- peekArray (fromInteger $ toInteger num) mesArr++            -- convert messages into high-level types+            messages <- mapM messageFromC cMessages++            -- create response list+            responses <- customConv appData messages++            -- convert responses into low-level types+            cResponses <- mapM responseToC responses++            -- alloc memory for response array+            respArr <- mallocArray (fromInteger $ toInteger num)++            -- poke resonse list into array+            pokeArray respArr cResponses++            -- poke array pointer into respArrPtr+            poke respArrPtr $ castPtr respArr++            -- return PAM_SUCCESS+            return 0+++pamStart :: String -> String -> (PamConv, Ptr ()) -> IO (PamHandle, PamRetCode)+pamStart serviceName userName (pamConv, appData) = do+    cServiceName <- newCString serviceName+    cUserName <- newCString userName++    -- create FunPtr pointer to function and embedd PamConv function into cConv+    pamConvPtr <- mkconvFunc $ cConv pamConv+    let conv = CPamConv pamConvPtr appData++    convPtr <- malloc+    poke convPtr conv++    pamhPtr <- malloc+    poke pamhPtr nullPtr++    r1 <- c_pam_start cServiceName cUserName convPtr pamhPtr++    cPamHandle_ <- peek pamhPtr++    let retCode = case r1 of+            0 -> PamSuccess+            a -> PamRetCode $ fromInteger $ toInteger a++    free cServiceName+    free cUserName+    free convPtr++    free pamhPtr++    return (PamHandle cPamHandle_ pamConvPtr, retCode)++pamEnd :: PamHandle -> PamRetCode -> IO PamRetCode+pamEnd pamHandle inRetCode = do+    let cRetCode = case inRetCode of+            PamSuccess -> 0+            PamRetCode a -> fromInteger $ toInteger a+    r <- c_pam_end (cPamHandle pamHandle) cRetCode+    freeHaskellFunPtr $ cPamCallback pamHandle++    return $ retCodeFromC r++pamAuthenticate :: PamHandle -> PamFlag -> IO PamRetCode+pamAuthenticate pamHandle (PamFlag flag) = do+    let cFlag = fromInteger $ toInteger flag+    r <- c_pam_authenticate (cPamHandle pamHandle) cFlag+    return $ retCodeFromC r++pamAcctMgmt :: PamHandle -> PamFlag -> IO PamRetCode+pamAcctMgmt pamHandle (PamFlag flag) = do+    let cFlag = fromInteger $ toInteger flag+    r <- c_pam_acct_mgmt (cPamHandle pamHandle) cFlag+    return $ retCodeFromC r
+ src/System/Posix/PAM/Types.hs view
@@ -0,0 +1,36 @@++module System.Posix.PAM.Types where++import Foreign.C+import Foreign.Ptr++data PamMessage = PamMessage { pmString :: String+                             , pmStyle :: PamStyle+                             }+                             deriving (Show, Eq)++data PamStyle = PamPromptEchoOff+              | PamPromptEchoOn+              | PamErrorMsg+              | PamTextInfo+              deriving (Show, Eq)++{- | http://www.kernel.org/pub/linux/libs/pam/Linux-PAM-html/adg-interface-of-app-expected.html#adg-pam_conv+ - resp_code member in C sturct is unused and should be set to zero, that's why there is no code field in the haskell data type+ -}+data PamResponse = PamResponse String+                 deriving (Show, Eq)++data PamRetCode = PamSuccess+                | PamRetCode Int+                deriving (Show, Eq)++data PamFlag = PamFlag Int++type PamConv = Ptr () -> [PamMessage] -> IO [PamResponse]+++data PamHandle = PamHandle { cPamHandle :: Ptr ()+                           , cPamCallback :: FunPtr (CInt -> Ptr (Ptr ()) -> Ptr (Ptr ()) -> Ptr () -> IO CInt)+                           }+                           deriving (Show, Eq)