From 47a2b72bed3770d3dfb26c4142479c436a11ce55 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 15 Dec 2015 21:08:22 -0400 Subject: Merged Utility changes from git-annex. --- src/Propellor/Property/File.hs | 1 - src/Utility/Directory.hs | 31 +++++++++++++++++++++---------- src/Utility/FileMode.hs | 29 +++++++++++++++++++++++------ src/Utility/FileSystemEncoding.hs | 5 +++-- src/Utility/Path.hs | 12 ++++++------ src/Utility/SafeCommand.hs | 11 ++++++----- 6 files changed, 59 insertions(+), 30 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs index 56066b5b..3021617c 100644 --- a/src/Propellor/Property/File.hs +++ b/src/Propellor/Property/File.hs @@ -4,7 +4,6 @@ import Propellor.Base import Utility.FileMode import System.Posix.Files -import System.PosixCompat.Types import System.Exit type Line = String diff --git a/src/Utility/Directory.hs b/src/Utility/Directory.hs index 7322cd85..fae33b5c 100644 --- a/src/Utility/Directory.hs +++ b/src/Utility/Directory.hs @@ -13,7 +13,6 @@ module Utility.Directory where import System.IO.Error import System.Directory import Control.Monad -import Control.Monad.IfElse import System.FilePath import Control.Applicative import Control.Concurrent @@ -25,10 +24,11 @@ import Prelude import qualified System.Win32 as Win32 #else import qualified System.Posix as Posix +import Utility.SafeCommand +import Control.Monad.IfElse #endif import Utility.PosixFiles -import Utility.SafeCommand import Utility.Tmp import Utility.Exception import Utility.Monad @@ -107,21 +107,32 @@ moveFile src dest = tryIO (rename src dest) >>= onrename onrename (Left e) | isPermissionError e = rethrow | isDoesNotExistError e = rethrow - | otherwise = do - -- copyFile is likely not as optimised as - -- the mv command, so we'll use the latter. - -- But, mv will move into a directory if - -- dest is one, which is not desired. - whenM (isdir dest) rethrow - viaTmp mv dest "" + | otherwise = viaTmp mv dest "" where rethrow = throwM e + mv tmp _ = do + -- copyFile is likely not as optimised as + -- the mv command, so we'll use the command. + -- + -- But, while Windows has a "mv", it does not seem very + -- reliable, so use copyFile there. +#ifndef mingw32_HOST_OS + -- If dest is a directory, mv would move the file + -- into it, which is not desired. + whenM (isdir dest) rethrow ok <- boolSystem "mv" [Param "-f", Param src, Param tmp] + let e' = e +#else + r <- tryIO $ copyFile src tmp + let (ok, e') = case r of + Left err -> (False, err) + Right _ -> (True, e) +#endif unless ok $ do -- delete any partial _ <- tryIO $ removeFile tmp - rethrow + throwM e' isdir f = do r <- tryIO $ getFileStatus f diff --git a/src/Utility/FileMode.hs b/src/Utility/FileMode.hs index fdf1b56b..efef5fa2 100644 --- a/src/Utility/FileMode.hs +++ b/src/Utility/FileMode.hs @@ -7,7 +7,10 @@ {-# LANGUAGE CPP #-} -module Utility.FileMode where +module Utility.FileMode ( + module Utility.FileMode, + FileMode, +) where import System.IO import Control.Monad @@ -17,17 +20,31 @@ import Utility.PosixFiles import System.Posix.Files #endif import Foreign (complement) +import Control.Monad.IO.Class (liftIO, MonadIO) +import Control.Monad.Catch import Utility.Exception {- Applies a conversion function to a file's mode. -} modifyFileMode :: FilePath -> (FileMode -> FileMode) -> IO () -modifyFileMode f convert = do +modifyFileMode f convert = void $ modifyFileMode' f convert + +modifyFileMode' :: FilePath -> (FileMode -> FileMode) -> IO FileMode +modifyFileMode' f convert = do s <- getFileStatus f let old = fileMode s let new = convert old when (new /= old) $ setFileMode f new + return old + +{- Runs an action after changing a file's mode, then restores the old mode. -} +withModifiedFileMode :: FilePath -> (FileMode -> FileMode) -> IO a -> IO a +withModifiedFileMode file convert a = bracket setup cleanup go + where + setup = modifyFileMode' file convert + cleanup oldmode = modifyFileMode file (const oldmode) + go _ = a {- Adds the specified FileModes to the input mode, leaving the rest - unchanged. -} @@ -92,7 +109,7 @@ isExecutable mode = combineModes executeModes `intersectFileModes` mode /= 0 {- Runs an action without that pesky umask influencing it, unless the - passed FileMode is the standard one. -} -noUmask :: FileMode -> IO a -> IO a +noUmask :: (MonadIO m, MonadMask m) => FileMode -> m a -> m a #ifndef mingw32_HOST_OS noUmask mode a | mode == stdFileMode = a @@ -101,12 +118,12 @@ noUmask mode a noUmask _ a = a #endif -withUmask :: FileMode -> IO a -> IO a +withUmask :: (MonadIO m, MonadMask m) => FileMode -> m a -> m a #ifndef mingw32_HOST_OS withUmask umask a = bracket setup cleanup go where - setup = setFileCreationMask umask - cleanup = setFileCreationMask + setup = liftIO $ setFileCreationMask umask + cleanup = liftIO . setFileCreationMask go _ = a #else withUmask _ a = a diff --git a/src/Utility/FileSystemEncoding.hs b/src/Utility/FileSystemEncoding.hs index 2d9691d5..67341d37 100644 --- a/src/Utility/FileSystemEncoding.hs +++ b/src/Utility/FileSystemEncoding.hs @@ -29,6 +29,7 @@ import System.IO.Unsafe import qualified Data.Hash.MD5 as MD5 import Data.Word import Data.Bits.Utils +import Data.List import Data.List.Utils import qualified Data.ByteString.Lazy as L #ifdef mingw32_HOST_OS @@ -125,12 +126,12 @@ decodeW8 = s2w8 . _encodeFilePath {- Like encodeW8 and decodeW8, but NULs are passed through unchanged. -} encodeW8NUL :: [Word8] -> FilePath -encodeW8NUL = join nul . map encodeW8 . split (s2w8 nul) +encodeW8NUL = intercalate nul . map encodeW8 . split (s2w8 nul) where nul = ['\NUL'] decodeW8NUL :: FilePath -> [Word8] -decodeW8NUL = join (s2w8 nul) . map decodeW8 . split nul +decodeW8NUL = intercalate (s2w8 nul) . map decodeW8 . split nul where nul = ['\NUL'] diff --git a/src/Utility/Path.hs b/src/Utility/Path.hs index 8e3c2bdd..f3290d8d 100644 --- a/src/Utility/Path.hs +++ b/src/Utility/Path.hs @@ -30,8 +30,8 @@ import qualified "MissingH" System.Path as MissingH import Utility.Monad import Utility.UserInfo -{- Simplifies a path, removing any ".." or ".", and removing the trailing - - path separator. +{- Simplifies a path, removing any "." component, collapsing "dir/..", + - and removing the trailing path separator. - - On Windows, preserves whichever style of path separator might be used in - the input FilePaths. This is done because some programs in Windows @@ -50,7 +50,8 @@ simplifyPath path = dropTrailingPathSeparator $ norm c [] = reverse c norm c (p:ps) - | p' == ".." = norm (drop 1 c) ps + | p' == ".." && not (null c) && dropTrailingPathSeparator (c !! 0) /= ".." = + norm (drop 1 c) ps | p' == "." = norm c ps | otherwise = norm (p:c) ps where @@ -88,7 +89,7 @@ parentDir = takeDirectory . dropTrailingPathSeparator upFrom :: FilePath -> Maybe FilePath upFrom dir | length dirs < 2 = Nothing - | otherwise = Just $ joinDrive drive (join s $ init dirs) + | otherwise = Just $ joinDrive drive (intercalate s $ init dirs) where -- on Unix, the drive will be "/" when the dir is absolute, otherwise "" (drive, path) = splitDrive dir @@ -148,7 +149,7 @@ relPathDirToFile from to = relPathDirToFileAbs <$> absPath from <*> absPath to relPathDirToFileAbs :: FilePath -> FilePath -> FilePath relPathDirToFileAbs from to | takeDrive from /= takeDrive to = to - | otherwise = join s $ dotdots ++ uncommon + | otherwise = intercalate s $ dotdots ++ uncommon where s = [pathSeparator] pfrom = split s from @@ -287,7 +288,6 @@ fileNameLengthLimit dir = do if l <= 0 then return 255 else return $ minimum [l, 255] - where #endif {- Given a string that we'd like to use as the basis for FilePath, but that diff --git a/src/Utility/SafeCommand.hs b/src/Utility/SafeCommand.hs index 9102b726..5ce17a84 100644 --- a/src/Utility/SafeCommand.hs +++ b/src/Utility/SafeCommand.hs @@ -14,6 +14,7 @@ import Utility.Process import Data.String.Utils import System.FilePath import Data.Char +import Data.List import Control.Applicative import Prelude @@ -85,7 +86,7 @@ shellEscape :: String -> String shellEscape f = "'" ++ escaped ++ "'" where -- replace ' with '"'"' - escaped = join "'\"'\"'" $ split "'" f + escaped = intercalate "'\"'\"'" $ split "'" f -- | Unescapes a set of shellEscaped words or filenames. shellUnEscape :: String -> [String] @@ -105,10 +106,10 @@ shellUnEscape s = word : shellUnEscape rest | otherwise = inquote q (w++[c]) cs -- | For quickcheck. -prop_idempotent_shellEscape :: String -> Bool -prop_idempotent_shellEscape s = [s] == (shellUnEscape . shellEscape) s -prop_idempotent_shellEscape_multiword :: [String] -> Bool -prop_idempotent_shellEscape_multiword s = s == (shellUnEscape . unwords . map shellEscape) s +prop_isomorphic_shellEscape :: String -> Bool +prop_isomorphic_shellEscape s = [s] == (shellUnEscape . shellEscape) s +prop_isomorphic_shellEscape_multiword :: [String] -> Bool +prop_isomorphic_shellEscape_multiword s = s == (shellUnEscape . unwords . map shellEscape) s -- | Segments a list of filenames into groups that are all below the maximum -- command-line length limit. -- cgit v1.2.3