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:
Joey Hess 2016-12-24 14:46:31 -04:00
parent c89a9e6ca5
commit 8484c0c197
No known key found for this signature in database
GPG key ID: C910D9222512E3C7
48 changed files with 75 additions and 109 deletions

View file

@ -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 ()

View file

@ -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

View file

@ -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

View file

@ -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)

View file

@ -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])

View file

@ -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.
-

View file

@ -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

View file

@ -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