module System.Unix.Shadow
( SUserEntry(..)
, getSUserEntryForName
) where
import Control.Exception
import Control.Monad
import Foreign
import Foreign.C
import System.Posix.Types
import System.IO.Error
type CSpwd = ()
data SUserEntry =
SUserEntry {
sUserName :: String,
sUserPassword :: String
} deriving (Show, Read, Eq)
getSUserEntryForName :: String -> IO SUserEntry
getSUserEntryForName name = do
allocaBytes (36) $ \ppw ->
alloca $ \ pppw ->
withCString name $ \ pstr -> do
throwErrorIfNonZero_ "getsUserEntryForName" $
doubleAllocWhile isERANGE pwBufSize $ \s b ->
c_getspnam_r pstr ppw b (fromIntegral s) pppw
r <- peekElemOff pppw 0
when (r == nullPtr) $
ioError $ flip ioeSetErrorString "no user name"
$ mkIOError doesNotExistErrorType
"getUserEntryForName"
Nothing
(Just name)
unpackSUserEntry ppw
foreign import ccall unsafe "getspnam_r"
c_getspnam_r :: CString -> Ptr CSpwd
-> CString -> CSize -> Ptr (Ptr CSpwd) -> IO CInt
unpackSUserEntry :: Ptr CSpwd -> IO SUserEntry
unpackSUserEntry ptr = do
name <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr >>= peekCString
passwd <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr >>= peekCString
return (SUserEntry name passwd)
isERANGE :: Integral a => a -> Bool
isERANGE = (== eRANGE) . Errno . fromIntegral
doubleAllocWhile :: (a -> Bool) -> Int -> (Int -> Ptr b -> IO a) -> IO a
doubleAllocWhile p s m = do
r <- allocaBytes s (m s)
if p r then doubleAllocWhile p (2 * s) m else return r
pwBufSize :: Int
pwBufSize = 1024
throwErrorIfNonZero_ :: String -> IO CInt -> IO ()
throwErrorIfNonZero_ loc act = do
rc <- act
if (rc == 0)
then return ()
else ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)