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
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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'
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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]
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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")
|
||||||
|
|
|
@ -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.
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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.
|
||||||
|
|
|
@ -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.
|
||||||
--
|
--
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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"
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 ()
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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.
|
||||||
|
|
|
@ -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"]
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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. -}
|
||||||
|
|
|
@ -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.
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
4
Test.hs
4
Test.hs
|
@ -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"
|
||||||
|
|
|
@ -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 ()
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
|
||||||
|
|
|
@ -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)
|
||||||
|
|
||||||
|
|
|
@ -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])
|
||||||
|
|
|
@ -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.
|
||||||
-
|
-
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue