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!
This commit is contained in:
parent
c89a9e6ca5
commit
8484c0c197
48 changed files with 75 additions and 109 deletions
|
@ -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 ()
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
||||
|
|
|
@ -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])
|
||||
|
|
|
@ -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.
|
||||
-
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue