Unixutils 1.28 → 1.29

raw patch · 3 files changed

+147/−3 lines, 3 files

Files

System/Unix/Crypt.hs +35/−0
System/Unix/Shadow.hsc +108/−0
Unixutils.cabal +4/−3

+ System/Unix/Crypt.hs view

@@ -0,0 +1,35 @@+{-# LANGUAGE ForeignFunctionInterface #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  System.Unix.Crypt+-- Copyright   :  (c) 2010+-- License     :  BSD3+-- +-- Maintainer  :  jeremy@seereason.com+-- Stability   :  provisional+-- Portability :  non-portable (requires POSIX)+--+-- support for crypt() and /etc/shadow+--+-----------------------------------------------------------------------------++module System.Unix.Crypt +    ( crypt+    )+    where++import Foreign.C++foreign import ccall unsafe "unistd.h crypt"+  c_crypt :: CString -> CString -> IO CString++-- | calls crypt(3) +crypt :: String -- ^ key+      -> String -- ^ salt+      -> IO String -- ^ encrypted password+crypt key salt =+    withCString key $ \ckey ->+        withCString salt $ \csalt ->+            do cpassword <- throwErrnoIfNull "crypt" (c_crypt ckey csalt)+               peekCString cpassword+

+ System/Unix/Shadow.hsc view

@@ -0,0 +1,108 @@+{-# LANGUAGE ForeignFunctionInterface #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  System.Unix.Shadow+-- Copyright   :  (c) 2010 Jeremy Shaw, The University of Glasgow+-- License     :  BSD3+-- +-- Maintainer  :  jeremy@seereason.com+-- Stability   :  provisional+-- Portability :  non-portable (requires POSIX)+--+-- support for /etc/shadow+--+-- TODO: This module is modelled after System.Posix.User but lacks many +-- of the #ifdefs. Those are probably important.+-----------------------------------------------------------------------------+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++#include "shadow.h"++type CSpwd = ()++-- | Entry returned by 'getSUserEntryForName'+--+-- TODO: add other fields+data SUserEntry =+ SUserEntry {+   sUserName      :: String,     -- ^ Textual name of this user (pw_name)+   sUserPassword  :: String      -- ^ Password -- may be empty or fake if shadow is in use (pw_passwd)+ } deriving (Show, Read, Eq)++++-- | @getSUserEntryForName name@ calls @getspnam@ to obtain+--   the @SUserEntry@ information associated with the user login+--   @name@.p+getSUserEntryForName :: String -> IO SUserEntry+-- #if HAVE_GETPWNAM_R+getSUserEntryForName name = do+  allocaBytes (#const sizeof(struct spwd)) $ \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+{-+#elif HAVE_GETPWNAM+getUserEntryForName name = do+  withCString name $ \ pstr -> do+    withMVar lock $ \_ -> do+      ppw <- throwErrnoIfNull "getUserEntryForName" $ c_getpwnam pstr+      unpackUserEntry ppw++foreign import ccall unsafe "getpwnam" +  c_getpwnam :: CString -> IO (Ptr CPasswd)+#else+getUserEntryForName = error "System.Posix.User.getUserEntryForName: not supported"+#endif+-}++unpackSUserEntry :: Ptr CSpwd -> IO SUserEntry+unpackSUserEntry ptr = do+   name   <- (#peek struct spwd, sp_namp)   ptr >>= peekCString+   passwd <- (#peek struct spwd, sp_pwdp)   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++-- Used when calling re-entrant system calls that signal their 'errno' +-- directly through the return value.+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)

Unixutils.cabal view

@@ -1,5 +1,5 @@ Name:           Unixutils-Version:        1.28+Version:        1.29 License:        BSD3 License-File:	COPYING Author:         Jeremy Shaw@@ -14,9 +14,10 @@ Build-type:	Simple ghc-options:	-O2 Exposed-modules:-        System.Unix.Directory, System.Unix.FilePath, System.Unix.List,+        System.Unix.Crypt, System.Unix.Directory, System.Unix.FilePath, System.Unix.List, 	System.Unix.Misc, System.Unix.Mount, System.Unix.Process, System.Unix.ProcessExtra,-	System.Unix.Progress, System.Unix.SpecialDevice, System.Unix.Files+	System.Unix.Progress, System.Unix.Shadow, System.Unix.SpecialDevice, System.Unix.Files+Extra-libraries: crypt  -- For more complex build options see: -- http://www.haskell.org/ghc/docs/latest/html/Cabal/