Unixutils 1.17 → 1.22

raw patch · 7 files changed

+43/−99 lines, 7 filesdep +filepathdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: filepath

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• COPYING +1/−0
• System/Unix/Directory.hs +4/−3
• System/Unix/FilePath.hsc +9/−82
• System/Unix/Mount.hs +7/−2
• System/Unix/Process.hs +17/−8
• System/Unix/SpecialDevice.hs +2/−1
• Unixutils.cabal +3/−3

@@ -0,0 +1,1 @@+BSD

@@ -15,6 +15,7 @@ import System.Cmd import System.Directory import System.Exit+import System.FilePath import System.IO import System.Posix.Files import System.Posix.Types@@ -30,7 +31,7 @@         True ->              do               subs <- getDirectoryContents path >>=-                      return . map ((path ++ "/") ++) . filter (not . flip elem [".", ".."]) >>=+                      return . map (path </>) . filter (not . flip elem [".", ".."]) >>=                       mapM find >>=                       return . concat               return $ (path, status) : subs@@ -64,7 +65,7 @@           error ("Couldn't unmount file system on " ++ path)       doDirectoryFile tries status path name =           do-            let child = path ++ "/" ++ name+            let child = path </> name             childStatus <- getSymbolicLinkStatus child             if deviceID status == deviceID childStatus then                 doPath child childStatus else@@ -144,7 +145,7 @@ withTemporaryDirectory :: FilePath -> (FilePath -> IO a) -> IO a withTemporaryDirectory fp f =      do sysTmpDir <- getTemporaryDirectory-        bracket (mkdtemp (sysTmpDir ++ "/" ++ fp))+        bracket (mkdtemp (sysTmpDir </> fp))                 removeRecursiveSafely                 f 

@@ -1,17 +1,17 @@ {-# LANGUAGE ForeignFunctionInterface #-}+ -- | The function splitFileName is taken from missingh, at the moment -- missingh will not build under sid.  module System.Unix.FilePath      (dirName,      baseName,-     (+/+),      realpath,-     -- * From MissingH-     splitFileName)+     (<++>))     where  import Data.List+import System.FilePath (makeRelative, (</>), takeFileName, dropFileName) import Text.Regex import Foreign.C import Foreign.Marshal.Array@@ -19,89 +19,16 @@ #include <limits.h> #include <stdlib.h> -(+/+) :: FilePath -> FilePath -> FilePath-(+/+) path1 "" = path1-(+/+) "" path2 = path2-(+/+) path1 path2 =-    case (head (reverse path1), head path2) of-      ('/', '/') -> path1 ++ drop 1 path2-      (_, '/') -> path1 ++ path2-      ('/', _) -> path1 ++ path2-      (_, _) -> path1 ++ "/" ++ path2+-- |Concatenate two paths, making sure there is exactly one path separator.+a <++> b = a </> (makeRelative "" b) +-- |Use dropFileName dirName :: FilePath -> FilePath-dirName path = fst (splitFileName path)+dirName = dropFileName +-- |Use takeFileName baseName :: FilePath -> String-baseName path = snd (splitFileName path)--canon :: FilePath -> FilePath--- ^ Weak attempt at canonicalizing a file path.-canon path =-    let re = mkRegex "/" in-    let names = splitRegex re path in-    concat (intersperse "/" (merge names))-    where-      merge (".." : xs) = ".." : (merge xs)-      merge ("." : xs) = "." : (merge xs)-      merge (_ : ".." : xs) = (merge xs)-      merge (x : "." : xs) = (merge (x : xs))-      merge (x : xs) = x : merge xs-      merge [] = []---------------- From MissingH ------------------- | Split the path into directory and file name------ Examples:------ \[Posix\]------ > splitFileName "/"            == ("/",    ".")--- > splitFileName "/foo/bar.ext" == ("/foo", "bar.ext")--- > splitFileName "bar.ext"      == (".",    "bar.ext")--- > splitFileName "/foo/."       == ("/foo", ".")--- > splitFileName "/foo/.."      == ("/foo", "..")------ \[Windows\]------ > splitFileName "\\"               == ("\\",      "")--- > splitFileName "c:\\foo\\bar.ext" == ("c:\\foo", "bar.ext")--- > splitFileName "bar.ext"          == (".",       "bar.ext")--- > splitFileName "c:\\foo\\."       == ("c:\\foo", ".")--- > splitFileName "c:\\foo\\.."      == ("c:\\foo", "..")------ The first case in the Windows examples returns an empty file name.--- This is a special case because the \"\\\\\" path doesn\'t refer to--- an object (file or directory) which resides within a directory.-splitFileName :: FilePath -> (String, String)-splitFileName p = (reverse path1, reverse fname1)-  where-    (fname,path) = break isPathSeparator (reverse p)-    path1 = case path of-      "" -> "."-      _  -> case dropWhile isPathSeparator path of-	"" -> [pathSeparator]-	p  -> p-    fname1 = case fname of-      "" -> "."-      _  -> fname---- | Checks whether the character is a valid path separator for the host--- platform. The valid character is a 'pathSeparator' but since the Windows--- operating system also accepts a slash (\"\/\") since DOS 2, the function--- checks for it on this platform, too.-isPathSeparator :: Char -> Bool-isPathSeparator ch =-  ch == '/'---- | Provides a platform-specific character used to separate directory levels in--- a path string that reflects a hierarchical file system organization. The--- separator is a slash (@\"\/\"@) on Unix and Macintosh, and a backslash--- (@\"\\\"@) on the Windows operating system.-pathSeparator :: Char-pathSeparator = '/'+baseName = takeFileName  -- |resolve all references to /./, /../, extra slashes, and symlinks realpath :: FilePath -> IO FilePath

@@ -8,15 +8,20 @@ -- Standard GHC modules  import Control.Monad+import Data.ByteString.Lazy.Char8 (empty) import Data.List import System.Directory import System.Exit import System.Posix.Files+import System.Unix.Process  -- Local Modules  import System.Unix.Process +-- In ghc610 readFile "/proc/mounts" hangs.  Use this instead.+rf path = lazyCommand ("cat '" ++ path ++ "'") empty >>= return . (\ (o, _, _) -> o) . collectOutputUnpacked+ -- |'umountBelow' - unmounts all mount points below /belowPath/ -- \/proc\/mounts must be present and readable.  Because of the way -- linux handles changeroots, we can't trust everything we see in@@ -42,14 +47,14 @@ umountBelow :: FilePath -- ^ canonicalised, absolute path             -> IO [(FilePath, (String, String, ExitCode))] -- ^ paths that we attempted to umount, and the responding output from the umount command umountBelow belowPath =-    do procMount <- readFile "/proc/mounts"+    do procMount <- rf "/proc/mounts"        let mountPoints = map (unescape . (!! 1) . words) (lines procMount)            maybeMounts = filter (isPrefixOf belowPath) (concat (map tails mountPoints))        needsUmount <- filterM isMountPoint maybeMounts        result <- mapM (\path -> umount [path,"-f","-l"] >>= return . ((,) path)) needsUmount        -- Did /proc/mounts change?  If so we should try again because        -- nested mounts might have been revealed.-       procMount' <- readFile "/proc/mounts"+       procMount' <- rf "/proc/mounts"        result' <- if procMount /= procMount' then                       umountBelow belowPath else                       return []

@@ -1,3 +1,4 @@+{-# LANGUAGE ScopedTypeVariables #-} -- |functions for killing processes, running processes, etc module System.Unix.Process     (@@ -233,6 +234,13 @@             etc <- unsafeInterleaveIO (elements (input, inh, outh, errh, []))             return $ elems ++ etc +-- A quick fix for the issue where hWaitForInput has actually started+-- raising the isEOFError exception in ghc 6.10.+data Readyness = Ready | Unready | EndOfFile++hReady' :: Handle -> IO Readyness+hReady' h = (hReady h >>= (\ flag -> return (if flag then Ready else Unready))) `catch` (\ e -> return EndOfFile)+ -- | Wait until at least one handle is ready and then write input or -- read output.  Note that there is no way to check whether the input -- handle is ready except to try to write to it and see if any bytes@@ -243,21 +251,21 @@       -> IO ([B.ByteString], Maybe Handle, Maybe Handle, Maybe Handle, [Output]) ready waitUSecs (input, inh, outh, errh, elems) =     do-      outReady <- maybe (return False) hReady outh-      errReady <- maybe (return False) hReady errh+      outReady <- maybe (return Unready) hReady' outh+      errReady <- maybe (return Unready) hReady' errh       case (input, inh, outReady, errReady) of         -- Input exhausted, close the input handle.-        ([], Just handle, False, False) ->+        ([], Just handle, Unready, Unready) ->             do hClose handle                ready  waitUSecs ([], Nothing, outh, errh, elems)         -- Input handle closed and there are no ready output handles,         -- wait a bit-        ([], Nothing, False, False) ->+        ([], Nothing, Unready, Unready) ->             do usleep uSecs                --ePut0 ("Slept " ++ show uSecs ++ " microseconds\n")                ready (min maxUSecs (2 * waitUSecs)) (input, inh, outh, errh, elems)         -- Input is available and there are no ready output handles-        (input : etc, Just handle, False, False)+        (input : etc, Just handle, Unready, Unready)             -- Discard a zero byte input             | input == B.empty -> ready waitUSecs (etc, inh, outh, errh, elems)             -- Send some input to the process@@ -278,10 +286,11 @@  -- | Return the next output element and the updated handle -- from a handle which is assumed ready.-nextOut :: (Maybe Handle) -> Bool -> (B.ByteString -> Output) -> IO ([Output], Maybe Handle)+nextOut :: (Maybe Handle) -> Readyness -> (B.ByteString -> Output) -> IO ([Output], Maybe Handle) nextOut Nothing _ _ = return ([], Nothing)	-- Handle is closed-nextOut handle False _ = return ([], handle)	-- Handle is not ready-nextOut (Just handle) True constructor =	-- Perform a read +nextOut _ EndOfFile _ = return ([], Nothing)	-- Handle is closed+nextOut handle Unready _ = return ([], handle)	-- Handle is not ready+nextOut (Just handle) Ready constructor =	-- Perform a read      do       a <- B.hGetNonBlocking handle bufSize       case B.length a of

@@ -42,6 +42,7 @@ import Data.Char import Data.List import Data.Maybe+import System.FilePath import System.Posix.Types import System.Posix.Files import System.Posix.User@@ -217,7 +218,7 @@                     -- Catch the exception thrown if we lack read permission                     subs <- (try $ getDirectoryContents path) >>=                             return . either (const []) id >>=-                            return . map ((path ++ "/") ++) . filter (not . flip elem [".", ".."]) >>=+                            return . map (path </>) . filter (not . flip elem [".", ".."]) >>=                             mapM (directory_find follow) >>=                             return . concat                     return $ (path, status) : subs

@@ -1,11 +1,11 @@ Name:           Unixutils-Version:        1.17+Version:        1.22 License:        BSD3--- License-File:	debian/copyright+License-File:	COPYING Author:         Jeremy Shaw Homepage:       http://src.seereason.com/haskell-unixutils Category:	System-Build-Depends:  base, unix, regex-compat, process, bytestring, directory, old-time, parallel+Build-Depends:  base >= 3 && < 4, unix, regex-compat, process, bytestring, directory, old-time, parallel, filepath Synopsis:       A crude interface between Haskell and Unix-like operating systems Maintainer:     jeremy@n-heptane.com Description: