diff options
author | Joey Hess <joeyh@joeyh.name> | 2016-12-24 14:46:31 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2016-12-24 14:46:31 -0400 |
commit | 3b9d9a267b7c9247d36d9b622e1b836724ca5fb0 (patch) | |
tree | 7c57f49555835e462e0f69ba133bbfdaaf215368 /Utility | |
parent | 2aba1975e8192e7c60ef85118b40654b60cad027 (diff) |
Always use filesystem encoding for all file and handle reads and writes.
This is a big scary change. I have convinced myself it should be safe. I
hope!
Diffstat (limited to 'Utility')
-rw-r--r-- | Utility/CoProcess.hs | 6 | ||||
-rw-r--r-- | Utility/ExternalSHA.hs | 2 | ||||
-rw-r--r-- | Utility/FileSystemEncoding.hs | 41 | ||||
-rw-r--r-- | Utility/Lsof.hs | 5 | ||||
-rw-r--r-- | Utility/MagicWormhole.hs | 4 | ||||
-rw-r--r-- | Utility/Misc.hs | 17 | ||||
-rw-r--r-- | Utility/Quvi.hs | 3 | ||||
-rw-r--r-- | Utility/Shell.hs | 5 |
8 files changed, 30 insertions, 53 deletions
diff --git a/Utility/CoProcess.hs b/Utility/CoProcess.hs index 94d5ac3bc..2bae40fba 100644 --- a/Utility/CoProcess.hs +++ b/Utility/CoProcess.hs @@ -47,10 +47,10 @@ start' s = do rawMode to return $ CoProcessState pid to from s where - rawMode h = do - fileEncoding h #ifdef mingw32_HOST_OS - hSetNewlineMode h noNewlineTranslation + rawMode h = hSetNewlineMode h noNewlineTranslation +#else + rawMode _ = return () #endif stop :: CoProcessHandle -> IO () diff --git a/Utility/ExternalSHA.hs b/Utility/ExternalSHA.hs index e581697ae..7b0882004 100644 --- a/Utility/ExternalSHA.hs +++ b/Utility/ExternalSHA.hs @@ -14,7 +14,6 @@ module Utility.ExternalSHA (externalSHA) where import Utility.SafeCommand import Utility.Process -import Utility.FileSystemEncoding import Utility.Misc import Utility.Exception @@ -30,7 +29,6 @@ externalSHA command shasize file = do Left _ -> Left (command ++ " failed") where readsha args = withHandle StdoutHandle createProcessSuccess p $ \h -> do - fileEncoding h output <- hGetContentsStrict h hClose h return output diff --git a/Utility/FileSystemEncoding.hs b/Utility/FileSystemEncoding.hs index eab98337a..be43ace95 100644 --- a/Utility/FileSystemEncoding.hs +++ b/Utility/FileSystemEncoding.hs @@ -1,6 +1,6 @@ {- GHC File system encoding handling. - - - Copyright 2012-2014 Joey Hess <id@joeyh.name> + - Copyright 2012-2016 Joey Hess <id@joeyh.name> - - License: BSD-2-clause -} @@ -9,7 +9,7 @@ {-# OPTIONS_GHC -fno-warn-tabs #-} module Utility.FileSystemEncoding ( - fileEncoding, + useFileSystemEncoding, withFilePath, md5FilePath, decodeBS, @@ -19,7 +19,6 @@ module Utility.FileSystemEncoding ( encodeW8NUL, decodeW8NUL, truncateFilePath, - setConsoleEncoding, ) where import qualified GHC.Foreign as GHC @@ -39,19 +38,30 @@ import qualified Data.ByteString.Lazy.UTF8 as L8 import Utility.Exception -{- Sets a Handle to use the filesystem encoding. This causes data - - written or read from it to be encoded/decoded the same - - as ghc 7.4 does to filenames etc. This special encoding - - allows "arbitrary undecodable bytes to be round-tripped through it". +{- Makes all subsequent Handles that are opened, as well as stdio Handles, + - use the filesystem encoding, instead of the encoding of the current + - locale. + - + - The filesystem encoding allows "arbitrary undecodable bytes to be + - round-tripped through it". This avoids encoded failures when data is not + - encoded matching the current locale. + - + - Note that code can still use hSetEncoding to change the encoding of a + - Handle. This only affects the default encoding. -} -fileEncoding :: Handle -> IO () +useFileSystemEncoding :: IO () +useFileSystemEncoding = do #ifndef mingw32_HOST_OS -fileEncoding h = hSetEncoding h =<< Encoding.getFileSystemEncoding + e <- Encoding.getFileSystemEncoding #else -{- The file system encoding does not work well on Windows, - - and Windows only has utf FilePaths anyway. -} -fileEncoding h = hSetEncoding h Encoding.utf8 + {- The file system encoding does not work well on Windows, + - and Windows only has utf FilePaths anyway. -} + let e = Encoding.utf8 #endif + hSetEncoding stdin e + hSetEncoding stdout e + hSetEncoding stderr e + Encoding.setLocaleEncoding e {- Marshal a Haskell FilePath into a NUL terminated C string using temporary - storage. The FilePath is encoded using the filesystem encoding, @@ -165,10 +175,3 @@ truncateFilePath n = reverse . go [] n . L8.fromString else go (c:coll) (cnt - x') (L8.drop 1 bs) _ -> coll #endif - -{- This avoids ghc's output layer crashing on invalid encoded characters in - - filenames when printing them out. -} -setConsoleEncoding :: IO () -setConsoleEncoding = do - fileEncoding stdout - fileEncoding stderr diff --git a/Utility/Lsof.hs b/Utility/Lsof.hs index 433b7c679..27d34b592 100644 --- a/Utility/Lsof.hs +++ b/Utility/Lsof.hs @@ -47,9 +47,8 @@ queryDir path = query ["+d", path] -} query :: [String] -> IO [(FilePath, LsofOpenMode, ProcessInfo)] query opts = - withHandle StdoutHandle (createProcessChecked checkSuccessProcess) p $ \h -> do - fileEncoding h - parse <$> hGetContentsStrict h + withHandle StdoutHandle (createProcessChecked checkSuccessProcess) p $ + parse <$$> hGetContentsStrict where p = proc "lsof" ("-F0can" : opts) diff --git a/Utility/MagicWormhole.hs b/Utility/MagicWormhole.hs index 9a99cba33..e217dcdca 100644 --- a/Utility/MagicWormhole.hs +++ b/Utility/MagicWormhole.hs @@ -27,7 +27,6 @@ import Utility.Process import Utility.SafeCommand import Utility.Monad import Utility.Misc -import Utility.FileSystemEncoding import Utility.Env import Utility.Path @@ -105,8 +104,7 @@ sendFile f (CodeObserver observer) ps = do -- Work around stupid stdout buffering behavior of python. -- See https://github.com/warner/magic-wormhole/issues/108 environ <- addEntry "PYTHONUNBUFFERED" "1" <$> getEnvironment - runWormHoleProcess p { env = Just environ} $ \_hin hout -> do - fileEncoding hout + runWormHoleProcess p { env = Just environ} $ \_hin hout -> findcode =<< words <$> hGetContents hout where p = wormHoleProcess (Param "send" : ps ++ [File f]) diff --git a/Utility/Misc.hs b/Utility/Misc.hs index ebb42576b..4498c0a03 100644 --- a/Utility/Misc.hs +++ b/Utility/Misc.hs @@ -10,9 +10,6 @@ module Utility.Misc where -import Utility.FileSystemEncoding -import Utility.Monad - import System.IO import Control.Monad import Foreign @@ -35,20 +32,6 @@ hGetContentsStrict = hGetContents >=> \s -> length s `seq` return s readFileStrict :: FilePath -> IO String readFileStrict = readFile >=> \s -> length s `seq` return s -{- Reads a file strictly, and using the FileSystemEncoding, so it will - - never crash on a badly encoded file. -} -readFileStrictAnyEncoding :: FilePath -> IO String -readFileStrictAnyEncoding f = withFile f ReadMode $ \h -> do - fileEncoding h - hClose h `after` hGetContentsStrict h - -{- Writes a file, using the FileSystemEncoding so it will never crash - - on a badly encoded content string. -} -writeFileAnyEncoding :: FilePath -> String -> IO () -writeFileAnyEncoding f content = withFile f WriteMode $ \h -> do - fileEncoding h - hPutStr h content - {- Like break, but the item matching the condition is not included - in the second result list. - diff --git a/Utility/Quvi.hs b/Utility/Quvi.hs index 417ab7041..d33d79bb8 100644 --- a/Utility/Quvi.hs +++ b/Utility/Quvi.hs @@ -153,11 +153,8 @@ httponly :: QuviParams httponly Quvi04 = [Param "-c", Param "http"] httponly _ = [] -- No way to do it with 0.9? -{- Both versions of quvi will output utf-8 encoded data even when - - the locale doesn't support it. -} readQuvi :: [String] -> IO String readQuvi ps = withHandle StdoutHandle createProcessSuccess p $ \h -> do - fileEncoding h r <- hGetContentsStrict h hClose h return r diff --git a/Utility/Shell.hs b/Utility/Shell.hs index 860ee11dd..7adb65128 100644 --- a/Utility/Shell.hs +++ b/Utility/Shell.hs @@ -48,9 +48,8 @@ findShellCommand f = do #ifndef mingw32_HOST_OS defcmd #else - l <- catchDefaultIO Nothing $ withFile f ReadMode $ \h -> do - fileEncoding h - headMaybe . lines <$> hGetContents h + l <- catchDefaultIO Nothing $ withFile f ReadMode $ + headMaybe . lines <$$> hGetContents h case l of Just ('#':'!':rest) -> case words rest of [] -> defcmd |