Unixutils 1.53 → 1.54.1

raw patch · 3 files changed

+21/−18 lines, 3 filessetup-changedPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Setup.hs +1/−1
• System/Unix/Chroot.hs +18/−15
• Unixutils.cabal +2/−2

@@ -1,7 +1,7 @@ #!/usr/bin/runhaskell  import Distribution.Simple-import System.Cmd+import System.Process import System.Exit  main = defaultMainWithHooks simpleUserHooks

@@ -7,8 +7,9 @@     -- , forceList'     ) where -import Control.Exception (finally, evaluate)-+import Control.Exception (evaluate)+import Control.Monad.Catch (MonadMask, finally)+import Control.Monad.Trans (MonadIO, liftIO) import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as L import Foreign.C.Error@@ -41,13 +42,13 @@ -- chroot and working directory of all the threads in the process, -- so... -- NOTE: will throw IOError if internal chroot fails-fchroot :: FilePath -> IO a -> IO a+fchroot :: (MonadIO m, MonadMask m) => FilePath -> m a -> m a fchroot path action =-    do origWd <- getWorkingDirectory-       rootFd <- openFd "/" ReadOnly Nothing defaultFileFlags-       chroot path-       changeWorkingDirectory "/"-       action `finally` (breakFree origWd rootFd)+    do origWd <- liftIO $ getWorkingDirectory+       rootFd <- liftIO $ openFd "/" ReadOnly Nothing defaultFileFlags+       liftIO $ chroot path+       liftIO $ changeWorkingDirectory "/"+       action `finally` (liftIO $ breakFree origWd rootFd)     where       breakFree origWd rootFd =           do changeWorkingDirectoryFd rootFd@@ -58,15 +59,15 @@ -- |The ssh inside of the chroot needs to be able to talk to the -- running ssh-agent.  Therefore we mount --bind the ssh agent socket -- dir inside the chroot (and umount it when we exit the chroot.-useEnv :: FilePath -> (a -> IO a) -> IO a -> IO a+useEnv :: (MonadIO m, MonadMask m) => FilePath -> (a -> m a) -> m a -> m a useEnv rootPath force action =     do -- In order to minimize confusion, this QIO message is output        -- at default quietness.  If you want to suppress it while seeing        -- the output from your action, you need to say something like        -- quieter (+ 1) (useEnv (quieter (\x->x-1) action))-       sockPath <- getEnv "SSH_AUTH_SOCK"-       home <- getEnv "HOME"-       copySSH home+       sockPath <- liftIO $ getEnv "SSH_AUTH_SOCK"+       home <- liftIO $ getEnv "HOME"+       liftIO $ copySSH home        -- We need to force the output before we exit the changeroot.        -- Otherwise we lose our ability to communicate with the ssh        -- agent and we get errors.@@ -77,14 +78,16 @@           -- Do NOT preserve ownership, files must be owned by root.           createDirectoryIfMissing True (rootPath ++ "/root") >>           run "/usr/bin/rsync" ["-rlptgDHxS", "--delete", home ++ "/.ssh/", rootPath ++ "/root/.ssh"]+      withSock :: (MonadIO m, MonadMask m) => Maybe FilePath -> m a -> m a       withSock Nothing action = action       withSock (Just sockPath) action =           withMountBind dir (rootPath ++ dir) action           where dir = dropTrailingPathSeparator (dropFileName sockPath)+      withMountBind :: (MonadIO m, MonadMask m) => FilePath -> FilePath -> m a -> m a       withMountBind toMount mountPoint action =-          (do createDirectoryIfMissing True mountPoint-              run "/bin/mount" ["--bind", escapePathForMount toMount, escapePathForMount mountPoint]-              action) `finally` (run "/bin/umount" [escapePathForMount mountPoint])+          (do liftIO $ createDirectoryIfMissing True mountPoint+              liftIO $ run "/bin/mount" ["--bind", escapePathForMount toMount, escapePathForMount mountPoint]+              action) `finally` (liftIO $ run "/bin/umount" [escapePathForMount mountPoint])       escapePathForMount = id	-- FIXME - Path arguments should be escaped        run cmd args =

@@ -1,5 +1,5 @@ Name:           Unixutils-Version:        1.53+Version:        1.54.1 License:        BSD3 License-File:	COPYING Author:         Jeremy Shaw, David Fox@@ -22,7 +22,7 @@       filepath,       mtl,       process,-      process-extras,+      process-extras >= 0.3,       pureMD5,       regex-tdfa,       unix,