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

@ -61,6 +61,7 @@ import qualified Annex.Queue
import Annex.Branch.Transitions import Annex.Branch.Transitions
import qualified Annex import qualified Annex
import Annex.Hook import Annex.Hook
import Utility.FileSystemEncoding
{- Name of the branch that is used to store git-annex's information. -} {- Name of the branch that is used to store git-annex's information. -}
name :: Git.Ref name :: Git.Ref
@ -436,7 +437,6 @@ stageJournal jl = withIndex $ do
g <- gitRepo g <- gitRepo
let dir = gitAnnexJournalDir g let dir = gitAnnexJournalDir g
(jlogf, jlogh) <- openjlog (jlogf, jlogh) <- openjlog
liftIO $ fileEncoding jlogh
h <- hashObjectHandle h <- hashObjectHandle
withJournalHandle $ \jh -> withJournalHandle $ \jh ->
Git.UpdateIndex.streamUpdateIndex g Git.UpdateIndex.streamUpdateIndex g

View file

@ -33,6 +33,7 @@ import Git.FilePath
import Git.Index import Git.Index
import qualified Git.Ref import qualified Git.Ref
import Annex.Link import Annex.Link
import Utility.FileSystemEncoding
catFile :: Git.Branch -> FilePath -> Annex L.ByteString catFile :: Git.Branch -> FilePath -> Annex L.ByteString
catFile branch file = do catFile branch file = do

View file

@ -52,8 +52,7 @@ associatedFiles key = do
associatedFilesRelative :: Key -> Annex [FilePath] associatedFilesRelative :: Key -> Annex [FilePath]
associatedFilesRelative key = do associatedFilesRelative key = do
mapping <- calcRepo $ gitAnnexMapping key mapping <- calcRepo $ gitAnnexMapping key
liftIO $ catchDefaultIO [] $ withFile mapping ReadMode $ \h -> do liftIO $ catchDefaultIO [] $ withFile mapping ReadMode $ \h ->
fileEncoding h
-- Read strictly to ensure the file is closed -- Read strictly to ensure the file is closed
-- before changeAssociatedFiles tries to write to it. -- before changeAssociatedFiles tries to write to it.
-- (Especially needed on Windows.) -- (Especially needed on Windows.)
@ -68,8 +67,7 @@ changeAssociatedFiles key transform = do
let files' = transform files let files' = transform files
when (files /= files') $ when (files /= files') $
modifyContent mapping $ modifyContent mapping $
liftIO $ viaTmp writeFileAnyEncoding mapping $ liftIO $ viaTmp writeFile mapping $ unlines files'
unlines files'
top <- fromRepo Git.repoPath top <- fromRepo Git.repoPath
return $ map (top </>) files' return $ map (top </>) files'

View file

@ -26,6 +26,7 @@ import Common
import Types.Key import Types.Key
import Types.GitConfig import Types.GitConfig
import Types.Difference import Types.Difference
import Utility.FileSystemEncoding
type Hasher = Key -> FilePath type Hasher = Key -> FilePath

View file

@ -37,7 +37,6 @@ setJournalFile _jl file content = do
let tmpfile = tmp </> takeFileName jfile let tmpfile = tmp </> takeFileName jfile
liftIO $ do liftIO $ do
withFile tmpfile WriteMode $ \h -> do withFile tmpfile WriteMode $ \h -> do
fileEncoding h
#ifdef mingw32_HOST_OS #ifdef mingw32_HOST_OS
hSetNewlineMode h noNewlineTranslation hSetNewlineMode h noNewlineTranslation
#endif #endif
@ -53,7 +52,7 @@ getJournalFile _jl = getJournalFileStale
- changes. -} - changes. -}
getJournalFileStale :: FilePath -> Annex (Maybe String) getJournalFileStale :: FilePath -> Annex (Maybe String)
getJournalFileStale file = inRepo $ \g -> catchMaybeIO $ getJournalFileStale file = inRepo $ \g -> catchMaybeIO $
readFileStrictAnyEncoding $ journalFile file g readFileStrict $ journalFile file g
{- List of files that have updated content in the journal. -} {- List of files that have updated content in the journal. -}
getJournalledFiles :: JournalLocked -> Annex [FilePath] getJournalledFiles :: JournalLocked -> Annex [FilePath]

View file

@ -24,6 +24,7 @@ import Git.Types
import Git.FilePath import Git.FilePath
import Annex.HashObject import Annex.HashObject
import Utility.FileMode import Utility.FileMode
import Utility.FileSystemEncoding
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
@ -63,7 +64,6 @@ getAnnexLinkTarget' file coresymlinks = if coresymlinks
Nothing -> fallback Nothing -> fallback
probefilecontent f = withFile f ReadMode $ \h -> do probefilecontent f = withFile f ReadMode $ \h -> do
fileEncoding h
-- The first 8k is more than enough to read; link -- The first 8k is more than enough to read; link
-- files are small. -- files are small.
s <- take 8192 <$> hGetContents h s <- take 8192 <$> hGetContents h

View file

@ -33,6 +33,7 @@ import qualified Git.Url
import Config import Config
import Annex.Path import Annex.Path
import Utility.Env import Utility.Env
import Utility.FileSystemEncoding
import Types.CleanupActions import Types.CleanupActions
import Git.Env import Git.Env
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS

View file

@ -8,6 +8,7 @@
module Annex.VariantFile where module Annex.VariantFile where
import Annex.Common import Annex.Common
import Utility.FileSystemEncoding
import Data.Hash.MD5 import Data.Hash.MD5

View file

@ -74,8 +74,6 @@ mkTransferrer program batchmaker = do
, std_in = CreatePipe , std_in = CreatePipe
, std_out = CreatePipe , std_out = CreatePipe
} }
fileEncoding readh
fileEncoding writeh
return $ Transferrer return $ Transferrer
{ transferrerRead = readh { transferrerRead = readh
, transferrerWrite = writeh , transferrerWrite = writeh

View file

@ -74,5 +74,5 @@ getLogR :: Handler Html
getLogR = page "Logs" Nothing $ do getLogR = page "Logs" Nothing $ do
logfile <- liftAnnex $ fromRepo gitAnnexLogFile logfile <- liftAnnex $ fromRepo gitAnnexLogFile
logs <- liftIO $ listLogs logfile logs <- liftIO $ listLogs logfile
logcontent <- liftIO $ concat <$> mapM readFileStrictAnyEncoding logs logcontent <- liftIO $ concat <$> mapM readFile logs
$(widgetFile "control/log") $(widgetFile "control/log")

View file

@ -10,6 +10,7 @@ module Backend.Utilities where
import Data.Hash.MD5 import Data.Hash.MD5
import Annex.Common import Annex.Common
import Utility.FileSystemEncoding
{- Generates a keyName from an input string. Takes care of sanitizing it. {- Generates a keyName from an input string. Takes care of sanitizing it.
- If it's not too long, the full string is used as the keyName. - If it's not too long, the full string is used as the keyName.

View file

@ -14,6 +14,7 @@ import Build.Version (getChangelogVersion, Version)
import Utility.UserInfo import Utility.UserInfo
import Utility.Url import Utility.Url
import Utility.Tmp import Utility.Tmp
import Utility.FileSystemEncoding
import qualified Git.Construct import qualified Git.Construct
import qualified Annex import qualified Annex
import Annex.Content import Annex.Content
@ -50,6 +51,7 @@ autobuilds =
main :: IO () main :: IO ()
main = do main = do
useFileSystemEncoding
version <- liftIO getChangelogVersion version <- liftIO getChangelogVersion
repodir <- getRepoDir repodir <- getRepoDir
changeWorkingDirectory repodir changeWorkingDirectory repodir

View file

@ -210,7 +210,6 @@ applySplices destdir imports splices@(first:_) = do
when (oldcontent /= Just newcontent) $ do when (oldcontent /= Just newcontent) $ do
putStrLn $ "splicing " ++ f putStrLn $ "splicing " ++ f
withFile dest WriteMode $ \h -> do withFile dest WriteMode $ \h -> do
fileEncoding h
hPutStr h newcontent hPutStr h newcontent
hClose h hClose h
where where
@ -721,7 +720,9 @@ parsecAndReplace p s = case parse find "" s of
find = many $ try (Right <$> p) <|> (Left <$> anyChar) find = many $ try (Right <$> p) <|> (Left <$> anyChar)
main :: IO () main :: IO ()
main = go =<< getArgs main = do
useFileSystemEncoding
go =<< getArgs
where where
go (destdir:log:header:[]) = run destdir log (Just header) go (destdir:log:header:[]) = run destdir log (Just header)
go (destdir:log:[]) = run destdir log Nothing go (destdir:log:[]) = run destdir log Nothing

View file

@ -24,6 +24,8 @@ git-annex (6.20161211) UNRELEASED; urgency=medium
* enable-tor: No longer needs to be run as root. * enable-tor: No longer needs to be run as root.
* enable-tor: When run as a regular user, test a connection back to * enable-tor: When run as a regular user, test a connection back to
the hidden service over tor. the hidden service over tor.
* Always use filesystem encoding for all file and handle reads and
writes.
* Fix build with directory-1.3. * Fix build with directory-1.3.
* Debian: Suggest tor and magic-wormhole. * Debian: Suggest tor and magic-wormhole.
* Debian: Build webapp on armel. * Debian: Build webapp on armel.

View file

@ -57,9 +57,7 @@ batchInput parser a = go =<< batchLines
parseerr s = giveup $ "Batch input parse failure: " ++ s parseerr s = giveup $ "Batch input parse failure: " ++ s
batchLines :: Annex [String] batchLines :: Annex [String]
batchLines = liftIO $ do batchLines = liftIO $ lines <$> getContents
fileEncoding stdin
lines <$> getContents
-- Runs a CommandStart in batch mode. -- Runs a CommandStart in batch mode.
-- --

View file

@ -27,6 +27,7 @@ import Types.UrlContents
import Annex.FileMatcher import Annex.FileMatcher
import Logs.Location import Logs.Location
import Utility.Metered import Utility.Metered
import Utility.FileSystemEncoding
import qualified Annex.Transfer as Transfer import qualified Annex.Transfer as Transfer
import Annex.Quvi import Annex.Quvi
import qualified Utility.Quvi as Quvi import qualified Utility.Quvi as Quvi

View file

@ -156,7 +156,7 @@ downloadFeed url
liftIO $ withTmpFile "feed" $ \f h -> do liftIO $ withTmpFile "feed" $ \f h -> do
hClose h hClose h
ifM (Url.download url f uo) ifM (Url.download url f uo)
( parseFeedString <$> readFileStrictAnyEncoding f ( parseFeedString <$> readFileStrict f
, return Nothing , return Nothing
) )

View file

@ -161,7 +161,6 @@ performPairing remotename addrs = do
getcode ourcode = do getcode ourcode = do
putStr "Enter the other repository's pairing code: " putStr "Enter the other repository's pairing code: "
hFlush stdout hFlush stdout
fileEncoding stdin
l <- getLine l <- getLine
case Wormhole.toCode l of case Wormhole.toCode l of
Just code Just code
@ -236,7 +235,7 @@ wormholePairing remotename ouraddrs ui = do
then return ReceiveFailed then return ReceiveFailed
else do else do
r <- liftIO $ tryIO $ r <- liftIO $ tryIO $
readFileStrictAnyEncoding recvf readFileStrict recvf
case r of case r of
Left _e -> return ReceiveFailed Left _e -> return ReceiveFailed
Right s -> maybe Right s -> maybe

View file

@ -56,10 +56,7 @@ runRequests
-> (TransferRequest -> Annex Bool) -> (TransferRequest -> Annex Bool)
-> Annex () -> Annex ()
runRequests readh writeh a = do runRequests readh writeh a = do
liftIO $ do liftIO $ hSetBuffering readh NoBuffering
hSetBuffering readh NoBuffering
fileEncoding readh
fileEncoding writeh
go =<< readrequests go =<< readrequests
where where
go (d:rn:k:f:rest) = do go (d:rn:k:f:rest) = do

View file

@ -41,7 +41,7 @@ start = do
createAnnexDirectory $ parentDir f createAnnexDirectory $ parentDir f
cfg <- getCfg cfg <- getCfg
descs <- uuidDescriptions descs <- uuidDescriptions
liftIO $ writeFileAnyEncoding f $ genCfg cfg descs liftIO $ writeFile f $ genCfg cfg descs
vicfg cfg f vicfg cfg f
stop stop
@ -51,11 +51,11 @@ vicfg curcfg f = do
-- Allow EDITOR to be processed by the shell, so it can contain options. -- Allow EDITOR to be processed by the shell, so it can contain options.
unlessM (liftIO $ boolSystem "sh" [Param "-c", Param $ unwords [vi, shellEscape f]]) $ unlessM (liftIO $ boolSystem "sh" [Param "-c", Param $ unwords [vi, shellEscape f]]) $
giveup $ vi ++ " exited nonzero; aborting" giveup $ vi ++ " exited nonzero; aborting"
r <- parseCfg (defCfg curcfg) <$> liftIO (readFileStrictAnyEncoding f) r <- parseCfg (defCfg curcfg) <$> liftIO (readFileStrict f)
liftIO $ nukeFile f liftIO $ nukeFile f
case r of case r of
Left s -> do Left s -> do
liftIO $ writeFileAnyEncoding f s liftIO $ writeFile f s
vicfg curcfg f vicfg curcfg f
Right newcfg -> setCfg curcfg newcfg Right newcfg -> setCfg curcfg newcfg

View file

@ -29,7 +29,6 @@ import Utility.Directory as X
import Utility.Monad as X import Utility.Monad as X
import Utility.Data as X import Utility.Data as X
import Utility.Applicative as X import Utility.Applicative as X
import Utility.FileSystemEncoding as X
import Utility.PosixFiles as X hiding (fileSize) import Utility.PosixFiles as X hiding (fileSize)
import Utility.FileSize as X import Utility.FileSize as X
import Utility.Network as X import Utility.Network as X

View file

@ -112,7 +112,7 @@ configureSmudgeFilter = do
createDirectoryIfMissing True (takeDirectory lf) createDirectoryIfMissing True (takeDirectory lf)
writeFile lf (lfs ++ "\n" ++ stdattr) writeFile lf (lfs ++ "\n" ++ stdattr)
where where
readattr = liftIO . catchDefaultIO "" . readFileStrictAnyEncoding readattr = liftIO . catchDefaultIO "" . readFileStrict
stdattr = unlines stdattr = unlines
[ "* filter=annex" [ "* filter=annex"
, ".* !filter" , ".* !filter"

View file

@ -69,7 +69,7 @@ openDb db tablename = do
worker <- async (workerThread (T.pack db) tablename jobs) worker <- async (workerThread (T.pack db) tablename jobs)
-- work around https://github.com/yesodweb/persistent/issues/474 -- work around https://github.com/yesodweb/persistent/issues/474
liftIO setConsoleEncoding liftIO useFileSystemEncoding
return $ DbHandle worker jobs return $ DbHandle worker jobs

View file

@ -37,6 +37,7 @@ import Git.Command
import Git.Types import Git.Types
import Git.FilePath import Git.FilePath
import qualified Utility.CoProcess as CoProcess import qualified Utility.CoProcess as CoProcess
import Utility.FileSystemEncoding
data CatFileHandle = CatFileHandle data CatFileHandle = CatFileHandle
{ catFileProcess :: CoProcess.CoProcessHandle { catFileProcess :: CoProcess.CoProcessHandle

View file

@ -53,7 +53,6 @@ runQuiet params repo = withQuietOutput createProcessSuccess $
pipeReadLazy :: [CommandParam] -> Repo -> IO (String, IO Bool) pipeReadLazy :: [CommandParam] -> Repo -> IO (String, IO Bool)
pipeReadLazy params repo = assertLocal repo $ do pipeReadLazy params repo = assertLocal repo $ do
(_, Just h, _, pid) <- createProcess p { std_out = CreatePipe } (_, Just h, _, pid) <- createProcess p { std_out = CreatePipe }
fileEncoding h
c <- hGetContents h c <- hGetContents h
return (c, checkSuccessProcess pid) return (c, checkSuccessProcess pid)
where where
@ -66,7 +65,6 @@ pipeReadLazy params repo = assertLocal repo $ do
pipeReadStrict :: [CommandParam] -> Repo -> IO String pipeReadStrict :: [CommandParam] -> Repo -> IO String
pipeReadStrict params repo = assertLocal repo $ pipeReadStrict params repo = assertLocal repo $
withHandle StdoutHandle (createProcessChecked ignoreFailureProcess) p $ \h -> do withHandle StdoutHandle (createProcessChecked ignoreFailureProcess) p $ \h -> do
fileEncoding h
output <- hGetContentsStrict h output <- hGetContentsStrict h
hClose h hClose h
return output return output
@ -81,9 +79,7 @@ pipeWriteRead params writer repo = assertLocal repo $
writeReadProcessEnv "git" (toCommand $ gitCommandLine params repo) writeReadProcessEnv "git" (toCommand $ gitCommandLine params repo)
(gitEnv repo) writer (Just adjusthandle) (gitEnv repo) writer (Just adjusthandle)
where where
adjusthandle h = do adjusthandle h = hSetNewlineMode h noNewlineTranslation
fileEncoding h
hSetNewlineMode h noNewlineTranslation
{- Runs a git command, feeding it input on a handle with an action. -} {- Runs a git command, feeding it input on a handle with an action. -}
pipeWrite :: [CommandParam] -> Repo -> (Handle -> IO ()) -> IO () pipeWrite :: [CommandParam] -> Repo -> (Handle -> IO ()) -> IO ()

View file

@ -79,10 +79,6 @@ global = do
{- Reads git config from a handle and populates a repo with it. -} {- Reads git config from a handle and populates a repo with it. -}
hRead :: Repo -> Handle -> IO Repo hRead :: Repo -> Handle -> IO Repo
hRead repo h = do hRead repo h = do
-- We use the FileSystemEncoding when reading from git-config,
-- because it can contain arbitrary filepaths (and other strings)
-- in any encoding.
fileEncoding h
val <- hGetContentsStrict h val <- hGetContentsStrict h
store val repo store val repo
@ -167,7 +163,6 @@ coreBare = "core.bare"
fromPipe :: Repo -> String -> [CommandParam] -> IO (Either SomeException (Repo, String)) fromPipe :: Repo -> String -> [CommandParam] -> IO (Either SomeException (Repo, String))
fromPipe r cmd params = try $ fromPipe r cmd params = try $
withHandle StdoutHandle createProcessSuccess p $ \h -> do withHandle StdoutHandle createProcessSuccess p $ \h -> do
fileEncoding h
val <- hGetContentsStrict h val <- hGetContentsStrict h
r' <- store val r r' <- store val r
return (r', val) return (r', val)

View file

@ -41,7 +41,6 @@ hashFile h file = CoProcess.query h send receive
- interface does not allow batch hashing without using temp files. -} - interface does not allow batch hashing without using temp files. -}
hashBlob :: HashObjectHandle -> String -> IO Sha hashBlob :: HashObjectHandle -> String -> IO Sha
hashBlob h s = withTmpFile "hash" $ \tmp tmph -> do hashBlob h s = withTmpFile "hash" $ \tmp tmph -> do
fileEncoding tmph
#ifdef mingw32_HOST_OS #ifdef mingw32_HOST_OS
hSetNewlineMode tmph noNewlineTranslation hSetNewlineMode tmph noNewlineTranslation
#endif #endif

View file

@ -159,7 +159,6 @@ runAction repo action@(CommandAction {}) = do
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS
let p = (proc "xargs" $ "-0":"git":toCommand gitparams) { env = gitEnv repo } let p = (proc "xargs" $ "-0":"git":toCommand gitparams) { env = gitEnv repo }
withHandle StdinHandle createProcessSuccess p $ \h -> do withHandle StdinHandle createProcessSuccess p $ \h -> do
fileEncoding h
hPutStr h $ intercalate "\0" $ toCommand $ getFiles action hPutStr h $ intercalate "\0" $ toCommand $ getFiles action
hClose h hClose h
#else #else

View file

@ -614,4 +614,4 @@ successfulRepair = fst
safeReadFile :: FilePath -> IO String safeReadFile :: FilePath -> IO String
safeReadFile f = do safeReadFile f = do
allowRead f allowRead f
readFileStrictAnyEncoding f readFileStrict f

View file

@ -22,6 +22,7 @@ import Git.UpdateIndex
import Git.HashObject import Git.HashObject
import Git.Types import Git.Types
import Git.FilePath import Git.FilePath
import Utility.FileSystemEncoding
{- Performs a union merge between two branches, staging it in the index. {- Performs a union merge between two branches, staging it in the index.
- Any previously staged changes in the index will be lost. - Any previously staged changes in the index will be lost.
@ -94,8 +95,7 @@ mergeFile info file hashhandle h = case filter (/= nullSha) [Ref asha, Ref bsha]
-- We don't know how the file is encoded, but need to -- We don't know how the file is encoded, but need to
-- split it into lines to union merge. Using the -- split it into lines to union merge. Using the
-- FileSystemEncoding for this is a hack, but ensures there -- FileSystemEncoding for this is a hack, but ensures there
-- are no decoding errors. Note that this works because -- are no decoding errors.
-- hashObject sets fileEncoding on its write handle.
getcontents s = lines . encodeW8NUL . L.unpack <$> catObject h s getcontents s = lines . encodeW8NUL . L.unpack <$> catObject h s
{- Calculates a union merge between a list of refs, with contents. {- Calculates a union merge between a list of refs, with contents.

View file

@ -55,7 +55,6 @@ startUpdateIndex :: Repo -> IO UpdateIndexHandle
startUpdateIndex repo = do startUpdateIndex repo = do
(Just h, _, _, p) <- createProcess (gitCreateProcess params repo) (Just h, _, _, p) <- createProcess (gitCreateProcess params repo)
{ std_in = CreatePipe } { std_in = CreatePipe }
fileEncoding h
return $ UpdateIndexHandle p h return $ UpdateIndexHandle p h
where where
params = map Param ["update-index", "-z", "--index-info"] params = map Param ["update-index", "-z", "--index-info"]

View file

@ -220,8 +220,7 @@ parseTransferFile file
bits = splitDirectories file bits = splitDirectories file
writeTransferInfoFile :: TransferInfo -> FilePath -> IO () writeTransferInfoFile :: TransferInfo -> FilePath -> IO ()
writeTransferInfoFile info tfile = writeFileAnyEncoding tfile $ writeTransferInfoFile info tfile = writeFile tfile $ writeTransferInfo info
writeTransferInfo info
{- File format is a header line containing the startedTime and any {- File format is a header line containing the startedTime and any
- bytesComplete value. Followed by a newline and the associatedFile. - bytesComplete value. Followed by a newline and the associatedFile.
@ -243,7 +242,7 @@ writeTransferInfo info = unlines
readTransferInfoFile :: Maybe PID -> FilePath -> IO (Maybe TransferInfo) readTransferInfoFile :: Maybe PID -> FilePath -> IO (Maybe TransferInfo)
readTransferInfoFile mpid tfile = catchDefaultIO Nothing $ readTransferInfoFile mpid tfile = catchDefaultIO Nothing $
readTransferInfo mpid <$> readFileStrictAnyEncoding tfile readTransferInfo mpid <$> readFileStrict tfile
readTransferInfo :: Maybe PID -> String -> Maybe TransferInfo readTransferInfo :: Maybe PID -> String -> Maybe TransferInfo
readTransferInfo mpid s = TransferInfo readTransferInfo mpid s = TransferInfo

View file

@ -66,7 +66,7 @@ updateUnusedLog prefix m = do
writeUnusedLog :: FilePath -> UnusedLog -> Annex () writeUnusedLog :: FilePath -> UnusedLog -> Annex ()
writeUnusedLog prefix l = do writeUnusedLog prefix l = do
logfile <- fromRepo $ gitAnnexUnusedLog prefix logfile <- fromRepo $ gitAnnexUnusedLog prefix
liftIO $ viaTmp writeFileAnyEncoding logfile $ unlines $ map format $ M.toList l liftIO $ viaTmp writeFile logfile $ unlines $ map format $ M.toList l
where where
format (k, (i, Just t)) = show i ++ " " ++ key2file k ++ " " ++ show t format (k, (i, Just t)) = show i ++ " " ++ key2file k ++ " " ++ show t
format (k, (i, Nothing)) = show i ++ " " ++ key2file k format (k, (i, Nothing)) = show i ++ " " ++ key2file k
@ -76,7 +76,7 @@ readUnusedLog prefix = do
f <- fromRepo $ gitAnnexUnusedLog prefix f <- fromRepo $ gitAnnexUnusedLog prefix
ifM (liftIO $ doesFileExist f) ifM (liftIO $ doesFileExist f)
( M.fromList . mapMaybe parse . lines ( M.fromList . mapMaybe parse . lines
<$> liftIO (readFileStrictAnyEncoding f) <$> liftIO (readFileStrict f)
, return M.empty , return M.empty
) )
where where

View file

@ -183,7 +183,6 @@ setupConsole = do
<$> streamHandler stderr DEBUG <$> streamHandler stderr DEBUG
<*> pure preciseLogFormatter <*> pure preciseLogFormatter
updateGlobalLogger rootLoggerName (setLevel NOTICE . setHandlers [s]) updateGlobalLogger rootLoggerName (setLevel NOTICE . setHandlers [s])
setConsoleEncoding
{- Force output to be line buffered. This is normally the case when {- Force output to be line buffered. This is normally the case when
- it's connected to a terminal, but may not be when redirected to - it's connected to a terminal, but may not be when redirected to
- a file or a pipe. -} - a file or a pipe. -}

View file

@ -99,7 +99,6 @@ setupHandle s = do
h <- socketToHandle s ReadWriteMode h <- socketToHandle s ReadWriteMode
hSetBuffering h LineBuffering hSetBuffering h LineBuffering
hSetBinaryMode h False hSetBinaryMode h False
fileEncoding h
return h return h
-- Purposefully incomplete interpreter of Proto. -- Purposefully incomplete interpreter of Proto.

View file

@ -21,6 +21,7 @@ import Types.CleanupActions
import Messages.Progress import Messages.Progress
import Utility.Metered import Utility.Metered
import Utility.Tmp import Utility.Tmp
import Utility.FileSystemEncoding
import Backend.URL import Backend.URL
import Annex.Perms import Annex.Perms
import Annex.UUID import Annex.UUID

View file

@ -384,9 +384,6 @@ startExternal external = do
p <- propgit g basep p <- propgit g basep
(Just hin, Just hout, Just herr, ph) <- (Just hin, Just hout, Just herr, ph) <-
createProcess p `catchIO` runerr createProcess p `catchIO` runerr
fileEncoding hin
fileEncoding hout
fileEncoding herr
stderrelay <- async $ errrelayer herr stderrelay <- async $ errrelayer herr
checkearlytermination =<< getProcessExitCode ph checkearlytermination =<< getProcessExitCode ph
cv <- newTVarIO $ externalDefaultConfig external cv <- newTVarIO $ externalDefaultConfig external

View file

@ -95,6 +95,7 @@ import qualified Utility.HumanTime
import qualified Utility.ThreadScheduler import qualified Utility.ThreadScheduler
import qualified Utility.Base64 import qualified Utility.Base64
import qualified Utility.Tmp import qualified Utility.Tmp
import qualified Utility.FileSystemEncoding
import qualified Command.Uninit import qualified Command.Uninit
import qualified CmdLine.GitAnnex as GitAnnex import qualified CmdLine.GitAnnex as GitAnnex
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS
@ -1675,7 +1676,8 @@ test_add_subdirs = intmpclonerepo $ do
- calculated correctly for files in subdirs. -} - calculated correctly for files in subdirs. -}
unlessM (unlockedFiles <$> getTestMode) $ do unlessM (unlockedFiles <$> getTestMode) $ do
git_annex "sync" [] @? "sync failed" git_annex "sync" [] @? "sync failed"
l <- annexeval $ decodeBS <$> Annex.CatFile.catObject (Git.Types.Ref "HEAD:dir/foo") l <- annexeval $ Utility.FileSystemEncoding.decodeBS
<$> Annex.CatFile.catObject (Git.Types.Ref "HEAD:dir/foo")
"../.git/annex/" `isPrefixOf` l @? ("symlink from subdir to .git/annex is wrong: " ++ l) "../.git/annex/" `isPrefixOf` l @? ("symlink from subdir to .git/annex is wrong: " ++ l)
createDirectory "dir2" createDirectory "dir2"

View file

@ -47,10 +47,10 @@ start' s = do
rawMode to rawMode to
return $ CoProcessState pid to from s return $ CoProcessState pid to from s
where where
rawMode h = do
fileEncoding h
#ifdef mingw32_HOST_OS #ifdef mingw32_HOST_OS
hSetNewlineMode h noNewlineTranslation rawMode h = hSetNewlineMode h noNewlineTranslation
#else
rawMode _ = return ()
#endif #endif
stop :: CoProcessHandle -> IO () stop :: CoProcessHandle -> IO ()

View file

@ -14,7 +14,6 @@ module Utility.ExternalSHA (externalSHA) where
import Utility.SafeCommand import Utility.SafeCommand
import Utility.Process import Utility.Process
import Utility.FileSystemEncoding
import Utility.Misc import Utility.Misc
import Utility.Exception import Utility.Exception
@ -30,7 +29,6 @@ externalSHA command shasize file = do
Left _ -> Left (command ++ " failed") Left _ -> Left (command ++ " failed")
where where
readsha args = withHandle StdoutHandle createProcessSuccess p $ \h -> do readsha args = withHandle StdoutHandle createProcessSuccess p $ \h -> do
fileEncoding h
output <- hGetContentsStrict h output <- hGetContentsStrict h
hClose h hClose h
return output return output

View file

@ -1,6 +1,6 @@
{- GHC File system encoding handling. {- 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 - License: BSD-2-clause
-} -}
@ -9,7 +9,7 @@
{-# OPTIONS_GHC -fno-warn-tabs #-} {-# OPTIONS_GHC -fno-warn-tabs #-}
module Utility.FileSystemEncoding ( module Utility.FileSystemEncoding (
fileEncoding, useFileSystemEncoding,
withFilePath, withFilePath,
md5FilePath, md5FilePath,
decodeBS, decodeBS,
@ -19,7 +19,6 @@ module Utility.FileSystemEncoding (
encodeW8NUL, encodeW8NUL,
decodeW8NUL, decodeW8NUL,
truncateFilePath, truncateFilePath,
setConsoleEncoding,
) where ) where
import qualified GHC.Foreign as GHC import qualified GHC.Foreign as GHC
@ -39,19 +38,30 @@ import qualified Data.ByteString.Lazy.UTF8 as L8
import Utility.Exception import Utility.Exception
{- Sets a Handle to use the filesystem encoding. This causes data {- Makes all subsequent Handles that are opened, as well as stdio Handles,
- written or read from it to be encoded/decoded the same - use the filesystem encoding, instead of the encoding of the current
- as ghc 7.4 does to filenames etc. This special encoding - locale.
- allows "arbitrary undecodable bytes to be round-tripped through it". -
- 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 #ifndef mingw32_HOST_OS
fileEncoding h = hSetEncoding h =<< Encoding.getFileSystemEncoding e <- Encoding.getFileSystemEncoding
#else #else
{- The file system encoding does not work well on Windows, {- The file system encoding does not work well on Windows,
- and Windows only has utf FilePaths anyway. -} - and Windows only has utf FilePaths anyway. -}
fileEncoding h = hSetEncoding h Encoding.utf8 let e = Encoding.utf8
#endif #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 {- Marshal a Haskell FilePath into a NUL terminated C string using temporary
- storage. The FilePath is encoded using the filesystem encoding, - 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) else go (c:coll) (cnt - x') (L8.drop 1 bs)
_ -> coll _ -> coll
#endif #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 :: [String] -> IO [(FilePath, LsofOpenMode, ProcessInfo)]
query opts = query opts =
withHandle StdoutHandle (createProcessChecked checkSuccessProcess) p $ \h -> do withHandle StdoutHandle (createProcessChecked checkSuccessProcess) p $
fileEncoding h parse <$$> hGetContentsStrict
parse <$> hGetContentsStrict h
where where
p = proc "lsof" ("-F0can" : opts) p = proc "lsof" ("-F0can" : opts)

View file

@ -27,7 +27,6 @@ import Utility.Process
import Utility.SafeCommand import Utility.SafeCommand
import Utility.Monad import Utility.Monad
import Utility.Misc import Utility.Misc
import Utility.FileSystemEncoding
import Utility.Env import Utility.Env
import Utility.Path import Utility.Path
@ -105,8 +104,7 @@ sendFile f (CodeObserver observer) ps = do
-- Work around stupid stdout buffering behavior of python. -- Work around stupid stdout buffering behavior of python.
-- See https://github.com/warner/magic-wormhole/issues/108 -- See https://github.com/warner/magic-wormhole/issues/108
environ <- addEntry "PYTHONUNBUFFERED" "1" <$> getEnvironment environ <- addEntry "PYTHONUNBUFFERED" "1" <$> getEnvironment
runWormHoleProcess p { env = Just environ} $ \_hin hout -> do runWormHoleProcess p { env = Just environ} $ \_hin hout ->
fileEncoding hout
findcode =<< words <$> hGetContents hout findcode =<< words <$> hGetContents hout
where where
p = wormHoleProcess (Param "send" : ps ++ [File f]) p = wormHoleProcess (Param "send" : ps ++ [File f])

View file

@ -10,9 +10,6 @@
module Utility.Misc where module Utility.Misc where
import Utility.FileSystemEncoding
import Utility.Monad
import System.IO import System.IO
import Control.Monad import Control.Monad
import Foreign import Foreign
@ -35,20 +32,6 @@ hGetContentsStrict = hGetContents >=> \s -> length s `seq` return s
readFileStrict :: FilePath -> IO String readFileStrict :: FilePath -> IO String
readFileStrict = readFile >=> \s -> length s `seq` return s 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 {- Like break, but the item matching the condition is not included
- in the second result list. - in the second result list.
- -

View file

@ -153,11 +153,8 @@ httponly :: QuviParams
httponly Quvi04 = [Param "-c", Param "http"] httponly Quvi04 = [Param "-c", Param "http"]
httponly _ = [] -- No way to do it with 0.9? 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 :: [String] -> IO String
readQuvi ps = withHandle StdoutHandle createProcessSuccess p $ \h -> do readQuvi ps = withHandle StdoutHandle createProcessSuccess p $ \h -> do
fileEncoding h
r <- hGetContentsStrict h r <- hGetContentsStrict h
hClose h hClose h
return r return r

View file

@ -48,9 +48,8 @@ findShellCommand f = do
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS
defcmd defcmd
#else #else
l <- catchDefaultIO Nothing $ withFile f ReadMode $ \h -> do l <- catchDefaultIO Nothing $ withFile f ReadMode $
fileEncoding h headMaybe . lines <$$> hGetContents h
headMaybe . lines <$> hGetContents h
case l of case l of
Just ('#':'!':rest) -> case words rest of Just ('#':'!':rest) -> case words rest of
[] -> defcmd [] -> defcmd

View file

@ -15,6 +15,7 @@ import qualified CmdLine.GitAnnex
import qualified CmdLine.GitAnnexShell import qualified CmdLine.GitAnnexShell
import qualified CmdLine.GitRemoteTorAnnex import qualified CmdLine.GitRemoteTorAnnex
import qualified Test import qualified Test
import Utility.FileSystemEncoding
#ifdef mingw32_HOST_OS #ifdef mingw32_HOST_OS
import Utility.UserInfo import Utility.UserInfo
@ -23,6 +24,7 @@ import Utility.Env
main :: IO () main :: IO ()
main = withSocketsDo $ do main = withSocketsDo $ do
useFileSystemEncoding
ps <- getArgs ps <- getArgs
#ifdef mingw32_HOST_OS #ifdef mingw32_HOST_OS
winEnv winEnv

View file

@ -14,6 +14,7 @@ import qualified Git.CurrentRepo
import qualified Git.Branch import qualified Git.Branch
import qualified Git.Index import qualified Git.Index
import qualified Git import qualified Git
import Utility.FileSystemEncoding
header :: String header :: String
header = "Usage: git-union-merge ref ref newref" header = "Usage: git-union-merge ref ref newref"
@ -39,6 +40,7 @@ parseArgs = do
main :: IO () main :: IO ()
main = do main = do
useFileSystemEncoding
[aref, bref, newref] <- map Git.Ref <$> parseArgs [aref, bref, newref] <- map Git.Ref <$> parseArgs
g <- Git.Config.read =<< Git.CurrentRepo.get g <- Git.Config.read =<< Git.CurrentRepo.get
_ <- Git.Index.override (tmpIndex g) g _ <- Git.Index.override (tmpIndex g) g