convert all readFile, writeFile, and appendFile to close-on-exec safe versions
Even in the Build system. This allows grepping to make sure that there are none left un-converted: git grep "writeFile" |grep -v F\\.| grep -v doc/|grep -v writeFileString | grep -v writeFileProtected |grep -v Utility/FileIO git grep "readFile" |grep -v F\\.| grep -v doc/|grep -v readFileString |grep -v Utility/FileIO git grep "appendFile" |grep -v F\\.| grep -v doc/|grep -v appendFileString |grep -v Utility/FileIO Might be nice to automate that to prevent future mistakes... Sponsored-by: the NIH-funded NICEMAN (ReproNim TR&D3) project
This commit is contained in:
parent
867110e9ee
commit
6f9a9c81f6
58 changed files with 150 additions and 152 deletions
|
@ -276,8 +276,7 @@ winLocker :: (LockFile -> IO (Maybe LockHandle)) -> ContentLocker
|
|||
winLocker takelock _ (Just lockfile) =
|
||||
let lck = do
|
||||
modifyContentDir lockfile $
|
||||
void $ liftIO $ tryIO $
|
||||
writeFile (fromOsPath lockfile) ""
|
||||
void $ liftIO $ tryIO $ writeFileString lockfile ""
|
||||
liftIO $ takelock lockfile
|
||||
in (lck, Nothing)
|
||||
-- never reached; windows always uses a separate lock file
|
||||
|
@ -991,7 +990,7 @@ withTmpWorkDir key action = do
|
|||
-- clean up gitAnnexTmpWorkDir for those it finds.
|
||||
obj <- prepTmp key
|
||||
unlessM (liftIO $ doesFileExist obj) $ do
|
||||
liftIO $ writeFile (fromOsPath obj) ""
|
||||
liftIO $ writeFileString obj ""
|
||||
setAnnexFilePerm obj
|
||||
let tmpdir = gitAnnexTmpWorkDir obj
|
||||
createAnnexDirectory tmpdir
|
||||
|
@ -1083,7 +1082,7 @@ writeContentRetentionTimestamp key rt t = do
|
|||
readContentRetentionTimestamp rt >>= \case
|
||||
Just ts | ts >= t -> return ()
|
||||
_ -> replaceFile (const noop) rt $ \tmp ->
|
||||
liftIO $ writeFile (fromOsPath tmp) $ show t
|
||||
liftIO $ writeFileString tmp $ show t
|
||||
where
|
||||
lock = takeExclusiveLock
|
||||
unlock = liftIO . dropLock
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
{- git-annex repository fixups
|
||||
-
|
||||
- Copyright 2013-2020 Joey Hess <id@joeyh.name>
|
||||
- Copyright 2013-2025 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
@ -9,29 +9,14 @@
|
|||
|
||||
module Annex.Fixup where
|
||||
|
||||
import Common
|
||||
import Git.Types
|
||||
import Git.Config
|
||||
import Types.GitConfig
|
||||
import Utility.Path
|
||||
import Utility.Path.AbsRel
|
||||
import Utility.SafeCommand
|
||||
import Utility.Directory
|
||||
import Utility.Exception
|
||||
import Utility.Monad
|
||||
import Utility.SystemDirectory
|
||||
import Utility.OsPath
|
||||
import qualified Utility.RawFilePath as R
|
||||
import Utility.PartialPrelude
|
||||
import qualified Utility.OsString as OS
|
||||
|
||||
import System.IO
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import Control.Monad
|
||||
import Control.Monad.IfElse
|
||||
import qualified Data.Map as M
|
||||
import Control.Applicative
|
||||
import Prelude
|
||||
|
||||
fixupRepo :: Repo -> GitConfig -> IO Repo
|
||||
fixupRepo r c = do
|
||||
|
@ -132,11 +117,11 @@ fixupUnusualRepos r@(Repo { location = Local { worktree = Just w, gitdir = d } }
|
|||
-- git-worktree sets up a "commondir" file that contains
|
||||
-- the path to the main git directory.
|
||||
-- Using --separate-git-dir does not.
|
||||
commondirfile = fromOsPath (d </> literalOsPath "commondir")
|
||||
commondirfile = d </> literalOsPath "commondir"
|
||||
|
||||
readcommondirfile = catchDefaultIO Nothing $
|
||||
fmap toOsPath . headMaybe . lines
|
||||
<$> readFile commondirfile
|
||||
<$> readFileString commondirfile
|
||||
|
||||
setworktreepath r' = readcommondirfile >>= \case
|
||||
Just gd -> return $ r'
|
||||
|
|
|
@ -65,7 +65,7 @@ programPath = go =<< getEnv "GIT_ANNEX_DIR"
|
|||
readProgramFile :: IO (Maybe OsPath)
|
||||
readProgramFile = catchDefaultIO Nothing $ do
|
||||
programfile <- programFile
|
||||
fmap toOsPath . headMaybe . lines <$> readFile (fromOsPath programfile)
|
||||
fmap toOsPath . headMaybe . lines <$> readFileString programfile
|
||||
|
||||
cannotFindProgram :: IO a
|
||||
cannotFindProgram = do
|
||||
|
|
|
@ -1356,16 +1356,15 @@ suspendSim st = do
|
|||
let st'' = st'
|
||||
{ simRepoState = M.map freeze (simRepoState st')
|
||||
}
|
||||
let statefile = fromOsPath $
|
||||
toOsPath (simRootDirectory st'') </> literalOsPath "state"
|
||||
writeFile statefile (show st'')
|
||||
let statefile = toOsPath (simRootDirectory st'') </> literalOsPath "state"
|
||||
writeFileString statefile (show st'')
|
||||
where
|
||||
freeze :: SimRepoState SimRepo -> SimRepoState ()
|
||||
freeze rst = rst { simRepo = Nothing }
|
||||
|
||||
restoreSim :: OsPath -> IO (Either String (SimState SimRepo))
|
||||
restoreSim rootdir =
|
||||
tryIO (readFile statefile) >>= \case
|
||||
tryIO (readFileString statefile) >>= \case
|
||||
Left err -> return (Left (show err))
|
||||
Right c -> case readMaybe c :: Maybe (SimState ()) of
|
||||
Nothing -> return (Left "unable to parse sim state file")
|
||||
|
@ -1379,7 +1378,7 @@ restoreSim rootdir =
|
|||
}
|
||||
return (Right st'')
|
||||
where
|
||||
statefile = fromOsPath $ rootdir </> literalOsPath "state"
|
||||
statefile = rootdir </> literalOsPath "state"
|
||||
thaw st (u, rst) = tryNonAsync (thaw' st u) >>= return . \case
|
||||
Left _ -> (u, rst { simRepo = Nothing })
|
||||
Right r -> (u, rst { simRepo = Just r })
|
||||
|
|
|
@ -484,4 +484,4 @@ sshAskPassEnv :: String
|
|||
sshAskPassEnv = "GIT_ANNEX_SSHASKPASS"
|
||||
|
||||
runSshAskPass :: FilePath -> IO ()
|
||||
runSshAskPass passfile = putStrLn =<< readFile passfile
|
||||
runSshAskPass passfile = putStrLn =<< readFileString (toOsPath passfile)
|
||||
|
|
|
@ -94,7 +94,7 @@ youtubeDl' url workdir p uo
|
|||
nofiles = Left $ youtubeDlCommand ++ " did not put any media in its work directory, perhaps it's been configured to store files somewhere else?"
|
||||
toomanyfiles fs = Left $ youtubeDlCommand ++ " downloaded multiple media files; git-annex is only able to deal with one per url: " ++ show fs
|
||||
downloadedfiles = liftIO $
|
||||
(nub . lines <$> readFile (fromOsPath filelistfile))
|
||||
(nub . lines <$> readFileString filelistfile)
|
||||
`catchIO` (pure . const [])
|
||||
workdirfiles = liftIO $ filter (/= filelistfile)
|
||||
<$> (filterM doesFileExist =<< dirContents workdir)
|
||||
|
|
|
@ -132,7 +132,7 @@ writeDaemonStatusFile file status =
|
|||
]
|
||||
|
||||
readDaemonStatusFile :: FilePath -> IO DaemonStatus
|
||||
readDaemonStatusFile file = parse <$> newDaemonStatus <*> readFile file
|
||||
readDaemonStatusFile file = parse <$> newDaemonStatus <*> readFileString (toOsPath file)
|
||||
where
|
||||
parse status = foldr parseline status . lines
|
||||
parseline line status
|
||||
|
|
|
@ -57,7 +57,7 @@ ensureInstalled = ifM (isJust <$> getEnv "GIT_ANNEX_PACKAGE_INSTALL")
|
|||
let program = base </> literalOsPath "git-annex"
|
||||
programfile <- programFile
|
||||
createDirectoryIfMissing True (parentDir programfile)
|
||||
writeFile (fromOsPath programfile) (fromOsPath program)
|
||||
writeFileString programfile (fromOsPath program)
|
||||
|
||||
#ifdef darwin_HOST_OS
|
||||
autostartfile <- userAutoStart osxAutoStartLabel
|
||||
|
@ -70,7 +70,7 @@ ensureInstalled = ifM (isJust <$> getEnv "GIT_ANNEX_PACKAGE_INSTALL")
|
|||
let bootfile = toOsPath home </> literalOsPath ".termux" </> literalOsPath "boot" </> literalOsPath "git-annex"
|
||||
unlessM (doesFileExist bootfile) $ do
|
||||
createDirectoryIfMissing True (takeDirectory bootfile)
|
||||
writeFile (fromOsPath bootfile) "git-annex assistant --autostart"
|
||||
writeFileString bootfile "git-annex assistant --autostart"
|
||||
, do
|
||||
menufile <- desktopMenuFilePath "git-annex" <$> userDataDir
|
||||
icondir <- iconDir <$> userDataDir
|
||||
|
@ -125,7 +125,7 @@ installFileManagerHooks program = unlessM osAndroid $ do
|
|||
userdata <- userDataDir
|
||||
let kdeServiceMenusdir = userdata </> literalOsPath "kservices5" </> literalOsPath "ServiceMenus"
|
||||
createDirectoryIfMissing True kdeServiceMenusdir
|
||||
writeFile (fromOsPath (kdeServiceMenusdir </> literalOsPath "git-annex.desktop"))
|
||||
writeFileString (kdeServiceMenusdir </> literalOsPath "git-annex.desktop")
|
||||
(kdeDesktopFile actions)
|
||||
where
|
||||
genNautilusScript scriptdir action =
|
||||
|
@ -136,7 +136,7 @@ installFileManagerHooks program = unlessM osAndroid $ do
|
|||
]
|
||||
scriptname action = "git-annex " ++ action
|
||||
installscript f c = whenM (safetoinstallscript f) $ do
|
||||
writeFile (fromOsPath f) c
|
||||
writeFileString f c
|
||||
modifyFileMode f $ addModes [ownerExecuteMode]
|
||||
safetoinstallscript f = catchDefaultIO True $
|
||||
elem (encodeBS autoaddedcomment) . fileLines'
|
||||
|
|
|
@ -23,7 +23,7 @@ installAutoStart :: String -> OsPath -> IO ()
|
|||
installAutoStart command file = do
|
||||
#ifdef darwin_HOST_OS
|
||||
createDirectoryIfMissing True (parentDir file)
|
||||
writeFile (fromOsPath file) $ genOSXAutoStartFile osxAutoStartLabel command
|
||||
writeFileString file $ genOSXAutoStartFile osxAutoStartLabel command
|
||||
["assistant", "--autostart"]
|
||||
#else
|
||||
writeDesktopMenuFile (fdoAutostart command) file
|
||||
|
|
|
@ -79,7 +79,7 @@ newAssistantUrl repo = do
|
|||
r <- Git.Config.read =<< Git.Construct.fromPath repo
|
||||
waiturl $ gitAnnexUrlFile r
|
||||
waiturl urlfile = do
|
||||
v <- tryIO $ readFile (fromOsPath urlfile)
|
||||
v <- tryIO $ readFileString urlfile
|
||||
case v of
|
||||
Left _ -> delayed $ waiturl urlfile
|
||||
Right url -> ifM (assistantListening url)
|
||||
|
|
|
@ -224,8 +224,8 @@ genSshKeyPair = withTmpDir (literalOsPath "git-annex-keygen") $ \dir -> do
|
|||
unless ok $
|
||||
giveup "ssh-keygen failed"
|
||||
SshKeyPair
|
||||
<$> readFile (fromOsPath (dir </> literalOsPath "key.pub"))
|
||||
<*> readFile (fromOsPath (dir </> literalOsPath "key"))
|
||||
<$> readFileString (dir </> literalOsPath "key.pub")
|
||||
<*> readFileString (dir </> literalOsPath "key")
|
||||
|
||||
{- Installs a ssh key pair, and sets up ssh config with a mangled hostname
|
||||
- that will enable use of the key. This way we avoid changing the user's
|
||||
|
@ -255,7 +255,7 @@ installSshKeyPair sshkeypair sshdata = do
|
|||
writeFileProtected (sshdir </> sshPrivKeyFile sshdata)
|
||||
(sshPrivKey sshkeypair)
|
||||
unlessM (doesFileExist $ sshdir </> sshPubKeyFile sshdata) $
|
||||
writeFile (fromOsPath (sshdir </> sshPubKeyFile sshdata))
|
||||
writeFileString (sshdir </> sshPubKeyFile sshdata)
|
||||
(sshPubKey sshkeypair)
|
||||
|
||||
setSshConfig sshdata
|
||||
|
@ -277,8 +277,10 @@ sshPubKeyFile sshdata = sshPrivKeyFile sshdata <> literalOsPath ".pub"
|
|||
setupSshKeyPair :: SshData -> IO (SshData, SshKeyPair)
|
||||
setupSshKeyPair sshdata = do
|
||||
sshdir <- sshDir
|
||||
mprivkey <- catchMaybeIO $ readFile (fromOsPath (sshdir </> sshPrivKeyFile sshdata))
|
||||
mpubkey <- catchMaybeIO $ readFile (fromOsPath (sshdir </> sshPubKeyFile sshdata))
|
||||
mprivkey <- catchMaybeIO $ readFileString
|
||||
(sshdir </> sshPrivKeyFile sshdata)
|
||||
mpubkey <- catchMaybeIO $ readFileString
|
||||
(sshdir </> sshPubKeyFile sshdata)
|
||||
keypair <- case (mprivkey, mpubkey) of
|
||||
(Just privkey, Just pubkey) -> return $ SshKeyPair
|
||||
{ sshPubKey = pubkey
|
||||
|
@ -330,15 +332,15 @@ setSshConfig :: SshData -> [(String, String)] -> IO SshData
|
|||
setSshConfig sshdata config = do
|
||||
sshdir <- sshDir
|
||||
createDirectoryIfMissing True sshdir
|
||||
let configfile = fromOsPath (sshdir </> literalOsPath "config")
|
||||
unlessM (catchBoolIO $ isInfixOf mangledhost <$> readFile configfile) $ do
|
||||
appendFile configfile $ unlines $
|
||||
let configfile = sshdir </> literalOsPath "config"
|
||||
unlessM (catchBoolIO $ isInfixOf mangledhost <$> readFileString configfile) $ do
|
||||
appendFileString configfile $ unlines $
|
||||
[ ""
|
||||
, "# Added automatically by git-annex"
|
||||
, "Host " ++ mangledhost
|
||||
] ++ map (\(k, v) -> "\t" ++ k ++ " " ++ v)
|
||||
(settings ++ config)
|
||||
setSshConfigMode (toOsPath configfile)
|
||||
setSshConfigMode configfile
|
||||
|
||||
return $ sshdata
|
||||
{ sshHostName = T.pack mangledhost
|
||||
|
|
|
@ -160,7 +160,7 @@ upgradeToDistribution newdir cleanup distributionfile = do
|
|||
unlessM (boolSystem (fromOsPath program) [Param "version"]) $
|
||||
giveup "New git-annex program failed to run! Not using."
|
||||
pf <- programFile
|
||||
liftIO $ writeFile (fromOsPath pf) (fromOsPath program)
|
||||
liftIO $ writeFileString pf (fromOsPath program)
|
||||
|
||||
#ifdef darwin_HOST_OS
|
||||
{- OS X uses a dmg, so mount it, and copy the contents into place. -}
|
||||
|
@ -281,7 +281,7 @@ installBase = "git-annex." ++
|
|||
deleteFromManifest :: OsPath -> IO ()
|
||||
deleteFromManifest dir = do
|
||||
fs <- map (\f -> dir </> toOsPath f) . lines
|
||||
<$> catchDefaultIO "" (readFile (fromOsPath manifest))
|
||||
<$> catchDefaultIO "" (readFileString manifest)
|
||||
mapM_ (removeWhenExistsWith removeFile) fs
|
||||
removeWhenExistsWith removeFile manifest
|
||||
removeEmptyRecursive dir
|
||||
|
|
|
@ -185,7 +185,7 @@ getAndroidCameraRepositoryR = do
|
|||
where
|
||||
addignore = do
|
||||
liftIO $ unlessM (doesFileExist $ literalOsPath ".gitignore") $
|
||||
writeFile ".gitignore" ".thumbnails"
|
||||
writeFileString (literalOsPath ".gitignore") ".thumbnails"
|
||||
void $ inRepo $
|
||||
Git.Command.runBool [Param "add", File ".gitignore"]
|
||||
|
||||
|
|
|
@ -74,5 +74,5 @@ getLogR :: Handler Html
|
|||
getLogR = page "Logs" Nothing $ do
|
||||
logfile <- liftAnnex $ fromRepo gitAnnexDaemonLogFile
|
||||
logs <- liftIO $ listLogs (fromOsPath logfile)
|
||||
logcontent <- liftIO $ concat <$> mapM readFile logs
|
||||
logcontent <- liftIO $ concat <$> mapM (readFileString . toOsPath) logs
|
||||
$(widgetFile "control/log")
|
||||
|
|
|
@ -34,7 +34,7 @@ getLicenseR = do
|
|||
Just f -> customPage (Just About) $ do
|
||||
-- no sidebar, just pages of legalese..
|
||||
setTitle "License"
|
||||
license <- liftIO $ readFile (fromOsPath f)
|
||||
license <- liftIO $ readFileString f
|
||||
$(widgetFile "documentation/license")
|
||||
|
||||
getRepoGroupR :: Handler Html
|
||||
|
|
|
@ -12,6 +12,7 @@ import Utility.Env.Basic
|
|||
import qualified Git.Version
|
||||
import Utility.SystemDirectory
|
||||
import Utility.OsPath
|
||||
import qualified Utility.FileIO as F
|
||||
|
||||
import Control.Monad
|
||||
import Control.Applicative
|
||||
|
@ -93,7 +94,7 @@ getSshConnectionCaching = Config "sshconnectioncaching" . BoolConfig <$>
|
|||
setup :: IO ()
|
||||
setup = do
|
||||
createDirectoryIfMissing True (toOsPath tmpDir)
|
||||
writeFile testFile "test file contents"
|
||||
F.writeFileString (toOsPath testFile) "test file contents"
|
||||
|
||||
cleanup :: IO ()
|
||||
cleanup = removeDirectoryRecursive (toOsPath tmpDir)
|
||||
|
|
|
@ -74,7 +74,7 @@ install command = do
|
|||
, do
|
||||
programfile <- inDestDir =<< programFile
|
||||
createDirectoryIfMissing True (parentDir programfile)
|
||||
writeFile (fromOsPath programfile) command
|
||||
writeFileString programfile command
|
||||
)
|
||||
|
||||
installUser :: FilePath -> IO ()
|
||||
|
|
|
@ -148,7 +148,7 @@ makeinfos updated changelogversion = do
|
|||
, distributionReleasedate = now
|
||||
, distributionUrgentUpgrade = Just "6.20180626"
|
||||
}
|
||||
liftIO $ writeFile (fromOsPath infofile) $ formatInfoFile d
|
||||
liftIO $ writeFileString infofile $ formatInfoFile d
|
||||
void $ inRepo $ runBool [Param "add", File (fromOsPath infofile)]
|
||||
signFile infofile
|
||||
signFile f
|
||||
|
@ -173,7 +173,7 @@ makeinfos updated changelogversion = do
|
|||
-- Check for out of date info files.
|
||||
infos <- liftIO $ filter (literalOsPath ".info" `OS.isSuffixOf`)
|
||||
<$> emptyWhenDoesNotExist (dirContentsRecursive $ literalOsPath "git-annex")
|
||||
ds <- liftIO $ forM infos (readish <$$> readFile . fromOsPath)
|
||||
ds <- liftIO $ forM infos (readish <$$> readFileString)
|
||||
let dis = zip infos ds
|
||||
let ood = filter outofdate dis
|
||||
return ood
|
||||
|
|
|
@ -29,6 +29,7 @@ import Utility.FileMode
|
|||
import Utility.CopyFile
|
||||
import Utility.SystemDirectory
|
||||
import qualified Utility.OsString as OS
|
||||
import qualified Utility.FileIO as F
|
||||
|
||||
mklibs :: OsPath -> a -> IO Bool
|
||||
mklibs top _installedbins = do
|
||||
|
@ -47,9 +48,9 @@ mklibs top _installedbins = do
|
|||
|
||||
-- Various files used by runshell to set up env vars used by the
|
||||
-- linker shims.
|
||||
writeFile (fromOsPath (top </> literalOsPath "libdirs"))
|
||||
F.writeFileString (top </> literalOsPath "libdirs")
|
||||
(unlines (map fromOsPath libdirs'))
|
||||
writeFile (fromOsPath (top </> literalOsPath "gconvdir")) $
|
||||
F.writeFileString (top </> literalOsPath "gconvdir") $
|
||||
case gconvlibs of
|
||||
[] -> ""
|
||||
(p:_) -> fromOsPath (parentDir p)
|
||||
|
@ -171,7 +172,7 @@ installLinkerShim top linker exe = do
|
|||
link <- relPathDirToFile (top </> exedir) (top <> linker)
|
||||
unlessM (doesFileExist (top </> exelink)) $
|
||||
createSymbolicLink (fromOsPath link) (fromOsPath (top </> exelink))
|
||||
writeFile (fromOsPath exe) $ unlines
|
||||
F.writeFileString exe $ unlines
|
||||
[ "#!/bin/sh"
|
||||
, "exec \"$GIT_ANNEX_DIR/" ++ fromOsPath exelink ++ "\" --library-path \"$GIT_ANNEX_LD_LIBRARY_PATH\" \"$GIT_ANNEX_DIR/shimmed/" ++ fromOsPath base ++ "/" ++ fromOsPath base ++ "\" \"$@\""
|
||||
]
|
||||
|
|
|
@ -43,6 +43,7 @@ import Utility.Exception
|
|||
import Utility.Directory
|
||||
import Utility.SystemDirectory
|
||||
import Utility.OsPath
|
||||
import qualified Utility.FileIO as F
|
||||
import Build.BundledPrograms
|
||||
|
||||
main = do
|
||||
|
@ -55,11 +56,11 @@ main = do
|
|||
mustSucceed "sh" [Param "-c", Param $ "zcat standalone/licences.gz > '" ++ license ++ "'"]
|
||||
webappscript <- vbsLauncher tmpdir "git-annex-webapp" "git annex webapp"
|
||||
autostartscript <- vbsLauncher tmpdir "git-annex-autostart" "git annex assistant --autostart"
|
||||
let htmlhelp = fromOsPath $ tmpdir </> literalOsPath "git-annex.html"
|
||||
writeFile htmlhelp htmlHelpText
|
||||
let gitannexcmd = fromOsPath $ tmpdir </> literalOsPath "git-annex.cmd"
|
||||
writeFile gitannexcmd "git annex %*"
|
||||
writeFile nsifile $ makeInstaller
|
||||
let htmlhelp = tmpdir </> literalOsPath "git-annex.html"
|
||||
F.writeFileString htmlhelp htmlHelpText
|
||||
let gitannexcmd = tmpdir </> literalOsPath "git-annex.cmd"
|
||||
F.writeFileString gitannexcmd "git annex %*"
|
||||
F.writeFileString (toOsPath nsifile) $ makeInstaller
|
||||
gitannex gitannexcmd license htmlhelp (winPrograms ++ magicDLLs') magicShare'
|
||||
[ webappscript, autostartscript ]
|
||||
mustSucceed "makensis" [File nsifile]
|
||||
|
@ -85,13 +86,13 @@ main = do
|
|||
- box. It expects to be passed the directory where git-annex is installed. -}
|
||||
vbsLauncher :: OsPath -> String -> String -> IO String
|
||||
vbsLauncher tmpdir basename cmd = do
|
||||
let f = fromOsPath $ tmpdir </> toOsPath (basename ++ ".vbs")
|
||||
writeFile f $ unlines
|
||||
let f = tmpdir </> toOsPath (basename ++ ".vbs")
|
||||
F.writeFileString f $ unlines
|
||||
[ "Set objshell=CreateObject(\"Wscript.Shell\")"
|
||||
, "objShell.CurrentDirectory = Wscript.Arguments.item(0)"
|
||||
, "objShell.Run(\"" ++ cmd ++ "\"), 0, False"
|
||||
]
|
||||
return f
|
||||
return (fromOsPath f)
|
||||
|
||||
gitannexprogram :: FilePath
|
||||
gitannexprogram = "git-annex.exe"
|
||||
|
|
|
@ -180,19 +180,19 @@ installSkel topdir _basedir = do
|
|||
installSkelRest :: OsPath -> OsPath -> Bool -> IO ()
|
||||
#ifdef darwin_HOST_OS
|
||||
installSkelRest _topdir basedir _hwcaplibs = do
|
||||
plist <- lines <$> readFile "standalone/osx/Info.plist.template"
|
||||
plist <- lines <$> F.readFileString (literalOsPath "standalone/osx/Info.plist.template")
|
||||
version <- getVersion
|
||||
writeFile (fromOsPath (basedir </> literalOsPath "Contents" </> literalOsPath "Info.plist"))
|
||||
F.writeFileString (basedir </> literalOsPath "Contents" </> literalOsPath "Info.plist")
|
||||
(unlines (map (expandversion version) plist))
|
||||
where
|
||||
expandversion v l = replace "GIT_ANNEX_VERSION" v l
|
||||
#else
|
||||
installSkelRest topdir _basedir hwcaplibs = do
|
||||
runshell <- lines <$> readFile "standalone/linux/skel/runshell"
|
||||
runshell <- lines <$> F.readFileString (literalOsPath "standalone/linux/skel/runshell")
|
||||
-- GIT_ANNEX_PACKAGE_INSTALL can be set by a distributor and
|
||||
-- runshell will be modified
|
||||
gapi <- getEnv "GIT_ANNEX_PACKAGE_INSTALL"
|
||||
writeFile (fromOsPath (topdir </> literalOsPath "runshell"))
|
||||
F.writeFileString (topdir </> literalOsPath "runshell")
|
||||
(unlines (map (expandrunshell gapi) runshell))
|
||||
modifyFileMode
|
||||
(topdir </> literalOsPath "runshell")
|
||||
|
|
|
@ -1,6 +1,7 @@
|
|||
{- Tests the system and generates SysConfig. -}
|
||||
|
||||
{-# OPTIONS_GHC -fno-warn-tabs #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Build.TestConfig where
|
||||
|
||||
|
@ -9,6 +10,7 @@ import Utility.Monad
|
|||
import Utility.SafeCommand
|
||||
import Utility.SystemDirectory
|
||||
import Utility.OsPath
|
||||
import qualified Utility.FileIO as F
|
||||
|
||||
import System.IO
|
||||
|
||||
|
@ -42,7 +44,7 @@ instance Show Config where
|
|||
valuetype (MaybeBoolConfig _) = "Maybe Bool"
|
||||
|
||||
writeSysConfig :: [Config] -> IO ()
|
||||
writeSysConfig config = writeFile "Build/SysConfig" body
|
||||
writeSysConfig config = F.writeFileString (literalOsPath "Build/SysConfig") body
|
||||
where
|
||||
body = unlines $ header ++ map show config ++ footer
|
||||
header = [
|
||||
|
@ -100,12 +102,16 @@ findCmdPath k command = do
|
|||
ifM (inSearchPath command)
|
||||
( return $ Config k $ MaybeStringConfig $ Just command
|
||||
, do
|
||||
r <- getM find ["/usr/sbin", "/sbin", "/usr/local/sbin"]
|
||||
r <- getM find
|
||||
[ literalOsPath "/usr/sbin"
|
||||
, literalOsPath "/sbin"
|
||||
, literalOsPath "/usr/local/sbin"
|
||||
]
|
||||
return $ Config k $ MaybeStringConfig r
|
||||
)
|
||||
where
|
||||
find d =
|
||||
let f = toOsPath d </> toOsPath command
|
||||
let f = d </> toOsPath command
|
||||
in ifM (doesFileExist f)
|
||||
( return (Just (fromOsPath f))
|
||||
, return Nothing
|
||||
|
|
|
@ -51,7 +51,7 @@ getVersion = do
|
|||
|
||||
getChangelogVersion :: IO Version
|
||||
getChangelogVersion = do
|
||||
changelog <- readFile "CHANGELOG"
|
||||
changelog <- F.readFileString (literalOsPath "CHANGELOG")
|
||||
let verline = takeWhile (/= '\n') changelog
|
||||
return $ middle (words verline !! 1)
|
||||
where
|
||||
|
|
|
@ -178,7 +178,7 @@ runFuzzAction :: FuzzAction -> Annex ()
|
|||
runFuzzAction (FuzzAdd (FuzzFile f)) = do
|
||||
createWorkTreeDirectory (parentDir (toOsPath f))
|
||||
n <- liftIO (getStdRandom random :: IO Int)
|
||||
liftIO $ writeFile f $ show n ++ "\n"
|
||||
liftIO $ writeFileString (toOsPath f) $ show n ++ "\n"
|
||||
runFuzzAction (FuzzDelete (FuzzFile f)) = liftIO $
|
||||
removeWhenExistsWith removeFile (toOsPath f)
|
||||
runFuzzAction (FuzzMove (FuzzFile src) (FuzzFile dest)) = liftIO $
|
||||
|
|
|
@ -183,7 +183,7 @@ getFeed o url st =
|
|||
next $ return True
|
||||
|
||||
debugfeedcontent tmpf msg = do
|
||||
feedcontent <- liftIO $ readFile tmpf
|
||||
feedcontent <- liftIO $ readFileString (toOsPath tmpf)
|
||||
fastDebug "Command.ImportFeed" $ unlines
|
||||
[ "start of feed content"
|
||||
, feedcontent
|
||||
|
@ -611,7 +611,7 @@ checkFeedBroken url = checkFeedBroken' url =<< feedState url
|
|||
checkFeedBroken' :: URLString -> OsPath -> Annex Bool
|
||||
checkFeedBroken' url f = do
|
||||
prev <- maybe Nothing readish
|
||||
<$> liftIO (catchMaybeIO $ readFile (fromOsPath f))
|
||||
<$> liftIO (catchMaybeIO $ readFileString f)
|
||||
now <- liftIO getCurrentTime
|
||||
case prev of
|
||||
Nothing -> do
|
||||
|
|
|
@ -55,7 +55,7 @@ start = startingNoMessage (ActionItemOther Nothing) $ do
|
|||
<$> fromRepo gitAnnexDir
|
||||
<*> pure (literalOsPath "map.dot")
|
||||
|
||||
liftIO $ writeFile (fromOsPath file) (drawMap rs trustmap umap)
|
||||
liftIO $ writeFileString file (drawMap rs trustmap umap)
|
||||
next $
|
||||
ifM (Annex.getRead Annex.fast)
|
||||
( runViewer file []
|
||||
|
|
|
@ -70,7 +70,7 @@ startsim' simfile = do
|
|||
let st = emptySimState rng (fromOsPath simdir)
|
||||
case simfile of
|
||||
Nothing -> startup simdir st []
|
||||
Just f -> liftIO (readFile f) >>= \c ->
|
||||
Just f -> liftIO (readFileString (toOsPath f)) >>= \c ->
|
||||
case parseSimFile c of
|
||||
Left err -> giveup err
|
||||
Right cs -> startup simdir st cs
|
||||
|
|
|
@ -49,7 +49,7 @@ start = do
|
|||
createAnnexDirectory $ parentDir f
|
||||
cfg <- getCfg
|
||||
descs <- uuidDescriptions
|
||||
liftIO $ writeFile (fromOsPath f) $ genCfg cfg descs
|
||||
liftIO $ writeFileString f $ genCfg cfg descs
|
||||
vicfg cfg f
|
||||
stop
|
||||
|
||||
|
@ -65,7 +65,7 @@ vicfg curcfg f = do
|
|||
liftIO $ removeWhenExistsWith removeFile f
|
||||
case r of
|
||||
Left s -> do
|
||||
liftIO $ writeFile (fromOsPath f) s
|
||||
liftIO $ writeFileString f s
|
||||
vicfg curcfg f
|
||||
Right newcfg -> setCfg curcfg newcfg
|
||||
where
|
||||
|
|
|
@ -90,7 +90,7 @@ start' allowauto o = do
|
|||
( if isJust (listenAddress o) || isJust (listenPort o)
|
||||
then giveup "The assistant is already running, so --listen and --port cannot be used."
|
||||
else do
|
||||
url <- liftIO . readFile . fromOsPath
|
||||
url <- liftIO . readFileString
|
||||
=<< fromRepo gitAnnexUrlFile
|
||||
liftIO $ if isJust listenAddress'
|
||||
then putStrLn url
|
||||
|
|
|
@ -32,4 +32,4 @@ programFile = userConfigFile (literalOsPath "program")
|
|||
noAnnexFileContent :: Maybe OsPath -> IO (Maybe String)
|
||||
noAnnexFileContent repoworktree = case repoworktree of
|
||||
Nothing -> return Nothing
|
||||
Just wt -> catchMaybeIO (readFile (fromOsPath (wt </> literalOsPath ".noannex")))
|
||||
Just wt -> catchMaybeIO (readFileString (wt </> literalOsPath ".noannex"))
|
||||
|
|
|
@ -18,7 +18,7 @@ readAutoStartFile :: IO [OsPath]
|
|||
readAutoStartFile = do
|
||||
f <- autoStartFile
|
||||
filter valid . nub . map (dropTrailingPathSeparator . toOsPath) . lines
|
||||
<$> catchDefaultIO "" (readFile (fromOsPath f))
|
||||
<$> catchDefaultIO "" (readFileString f)
|
||||
where
|
||||
-- Ignore any relative paths; some old buggy versions added eg "."
|
||||
valid = isAbsolute
|
||||
|
@ -30,7 +30,7 @@ modifyAutoStartFile func = do
|
|||
when (dirs' /= dirs) $ do
|
||||
f <- autoStartFile
|
||||
createDirectoryIfMissing True (parentDir f)
|
||||
viaTmp (writeFile . fromRawFilePath . fromOsPath) f
|
||||
viaTmp writeFileString f
|
||||
(unlines (map fromOsPath dirs'))
|
||||
|
||||
{- Adds a directory to the autostart file. If the directory is already
|
||||
|
|
|
@ -70,7 +70,7 @@ deconfigureSmudgeFilter = do
|
|||
lf <- Annex.fromRepo Git.attributesLocal
|
||||
ls <- liftIO $ catchDefaultIO [] $
|
||||
map decodeBS . fileLines' <$> F.readFile' lf
|
||||
liftIO $ writeFile (fromOsPath lf) $ unlines $
|
||||
liftIO $ writeFileString lf $ unlines $
|
||||
filter (\l -> l `notElem` stdattr && not (null l)) ls
|
||||
unsetConfig (ConfigKey "filter.annex.smudge")
|
||||
unsetConfig (ConfigKey "filter.annex.clean")
|
||||
|
|
|
@ -264,7 +264,7 @@ reconcileStaged dbisnew qh = ifM isBareRepo
|
|||
( return mempty
|
||||
, do
|
||||
gitindex <- inRepo currentIndexFile
|
||||
indexcache <- fromOsPath <$> calcRepo' gitAnnexKeysDbIndexCache
|
||||
indexcache <- calcRepo' gitAnnexKeysDbIndexCache
|
||||
withTSDelta (liftIO . genInodeCache gitindex) >>= \case
|
||||
Just cur -> readindexcache indexcache >>= \case
|
||||
Nothing -> go cur indexcache =<< getindextree
|
||||
|
@ -278,7 +278,7 @@ reconcileStaged dbisnew qh = ifM isBareRepo
|
|||
lastindexref = Ref "refs/annex/last-index"
|
||||
|
||||
readindexcache indexcache = liftIO $ maybe Nothing readInodeCache
|
||||
<$> catchMaybeIO (readFile indexcache)
|
||||
<$> catchMaybeIO (readFileString indexcache)
|
||||
|
||||
getoldtree = fromMaybe emptyTree <$> inRepo (Git.Ref.sha lastindexref)
|
||||
|
||||
|
@ -292,7 +292,7 @@ reconcileStaged dbisnew qh = ifM isBareRepo
|
|||
(Just (fromRef oldtree))
|
||||
(fromRef newtree)
|
||||
(procdiff mdfeeder)
|
||||
liftIO $ writeFile indexcache $ showInodeCache cur
|
||||
liftIO $ writeFileString indexcache $ showInodeCache cur
|
||||
-- Storing the tree in a ref makes sure it does not
|
||||
-- get garbage collected, and is available to diff
|
||||
-- against next time.
|
||||
|
|
|
@ -280,7 +280,7 @@ adjustGitDirFile loc = fromMaybe loc <$> adjustGitDirFile' loc
|
|||
adjustGitDirFile' :: RepoLocation -> IO (Maybe RepoLocation)
|
||||
adjustGitDirFile' loc@(Local {}) = do
|
||||
let gd = gitdir loc
|
||||
c <- firstLine <$> catchDefaultIO "" (readFile (fromOsPath gd))
|
||||
c <- firstLine <$> catchDefaultIO "" (readFileString gd)
|
||||
if gitdirprefix `isPrefixOf` c
|
||||
then do
|
||||
top <- takeDirectory <$> absPath gd
|
||||
|
|
|
@ -59,7 +59,7 @@ hookWrite h r = ifM (doesFileExist f)
|
|||
f = hookFile h r
|
||||
go = do
|
||||
-- On Windows, using a ByteString as the file content
|
||||
-- avoids the newline translation done by writeFile.
|
||||
-- avoids the newline translation done by writeFileString.
|
||||
-- Hook scripts on Windows could use CRLF endings, but
|
||||
-- they typically use unix newlines, which does work there
|
||||
-- and makes the repository more portable.
|
||||
|
@ -85,11 +85,11 @@ data ExpectedContent = UnexpectedContent | ExpectedContent | OldExpectedContent
|
|||
|
||||
expectedContent :: Hook -> Repo -> IO ExpectedContent
|
||||
expectedContent h r = do
|
||||
-- Note that on windows, this readFile does newline translation,
|
||||
-- Note that on windows, this readFileString does newline translation,
|
||||
-- and so a hook file that has CRLF will be treated the same as one
|
||||
-- that has LF. That is intentional, since users may have a reason
|
||||
-- to prefer one or the other.
|
||||
content <- readFile $ fromOsPath $ hookFile h r
|
||||
content <- readFileString $ hookFile h r
|
||||
return $ if content == hookScript h
|
||||
then ExpectedContent
|
||||
else if any (content ==) (hookOldScripts h)
|
||||
|
|
|
@ -50,7 +50,7 @@ looseObjectFile r sha = objectsDir r </> toOsPath prefix </> toOsPath rest
|
|||
|
||||
listAlternates :: Repo -> IO [FilePath]
|
||||
listAlternates r = catchDefaultIO [] $
|
||||
lines <$> readFile (fromOsPath alternatesfile)
|
||||
lines <$> readFileString alternatesfile
|
||||
where
|
||||
alternatesfile = objectsDir r </> literalOsPath "info" </> literalOsPath "alternates"
|
||||
|
||||
|
|
|
@ -269,7 +269,7 @@ explodePackedRefsFile r = do
|
|||
let dest = gitd </> toOsPath (fromRef' ref)
|
||||
createDirectoryUnder [gitd] (parentDir dest)
|
||||
unlessM (doesFileExist dest) $
|
||||
writeFile (fromOsPath dest) (fromRef sha)
|
||||
writeFileString dest (fromRef sha)
|
||||
|
||||
packedRefsFile :: Repo -> OsPath
|
||||
packedRefsFile r = localGitDir r </> literalOsPath "packed-refs"
|
||||
|
@ -472,7 +472,7 @@ preRepair :: Repo -> IO ()
|
|||
preRepair g = do
|
||||
unlessM (validhead <$> catchDefaultIO "" (decodeBS <$> safeReadFile headfile)) $ do
|
||||
removeWhenExistsWith removeFile headfile
|
||||
writeFile (fromOsPath headfile) "ref: refs/heads/master"
|
||||
writeFileString headfile "ref: refs/heads/master"
|
||||
explodePackedRefsFile g
|
||||
unless (repoIsLocalBare g) $
|
||||
void $ tryIO $ allowWrite $ indexFile g
|
||||
|
|
|
@ -38,7 +38,7 @@ writeLogFile :: OsPath -> String -> Annex ()
|
|||
writeLogFile f c = createDirWhenNeeded f $ viaTmp writelog f c
|
||||
where
|
||||
writelog tmp c' = do
|
||||
liftIO $ writeFile (fromOsPath tmp) c'
|
||||
liftIO $ writeFileString tmp c'
|
||||
setAnnexFilePerm tmp
|
||||
|
||||
-- | Runs the action with a handle connected to a temp file.
|
||||
|
|
|
@ -45,7 +45,7 @@ readFsckResults :: UUID -> Annex FsckResults
|
|||
readFsckResults u = do
|
||||
logfile <- fromRepo $ gitAnnexFsckResultsLog u
|
||||
liftIO $ catchDefaultIO (FsckFoundMissing S.empty False) $
|
||||
deserializeFsckResults <$> readFile (fromOsPath logfile)
|
||||
deserializeFsckResults <$> readFileString logfile
|
||||
|
||||
deserializeFsckResults :: String -> FsckResults
|
||||
deserializeFsckResults = deserialize . lines
|
||||
|
|
|
@ -55,7 +55,7 @@ streamRestageLog finalizer processor = do
|
|||
ifM (doesPathExist oldf)
|
||||
( do
|
||||
h <- F.openFile oldf AppendMode
|
||||
hPutStr h =<< readFile (fromOsPath logf)
|
||||
hPutStr h =<< readFileString logf
|
||||
hClose h
|
||||
liftIO $ removeWhenExistsWith removeFile logf
|
||||
, moveFile logf oldf
|
||||
|
|
|
@ -63,9 +63,9 @@ scheduleChange u a = scheduleSet u . S.toList . a =<< scheduleGet u
|
|||
|
||||
getLastRunTimes :: Annex (M.Map ScheduledActivity LocalTime)
|
||||
getLastRunTimes = do
|
||||
f <- fromOsPath <$> fromRepo gitAnnexScheduleState
|
||||
f <- fromRepo gitAnnexScheduleState
|
||||
liftIO $ fromMaybe M.empty
|
||||
<$> catchDefaultIO Nothing (readish <$> readFile f)
|
||||
<$> catchDefaultIO Nothing (readish <$> readFileString f)
|
||||
|
||||
setLastRunTime :: ScheduledActivity -> LocalTime -> Annex ()
|
||||
setLastRunTime activity lastrun = do
|
||||
|
|
|
@ -263,7 +263,7 @@ writeTransferInfoFile info tfile = writeLogFile tfile $ writeTransferInfo info
|
|||
-- after it's been created with the right perms by writeTransferInfoFile.
|
||||
updateTransferInfoFile :: TransferInfo -> OsPath -> IO ()
|
||||
updateTransferInfoFile info tfile =
|
||||
writeFile (fromOsPath tfile) $ writeTransferInfo info
|
||||
writeFileString tfile $ writeTransferInfo info
|
||||
|
||||
{- File format is a header line containing the startedTime and any
|
||||
- bytesComplete value. Followed by a newline and the associatedFile.
|
||||
|
|
|
@ -54,8 +54,8 @@ removeView v = writeViews =<< filter (/= v) <$> recentViews
|
|||
|
||||
recentViews :: Annex [View]
|
||||
recentViews = do
|
||||
f <- fromOsPath <$> fromRepo gitAnnexViewLog
|
||||
liftIO $ mapMaybe readish . lines <$> catchDefaultIO [] (readFile f)
|
||||
f <- fromRepo gitAnnexViewLog
|
||||
liftIO $ mapMaybe readish . lines <$> catchDefaultIO [] (readFileString f)
|
||||
|
||||
{- Gets the currently checked out view, if there is one.
|
||||
-
|
||||
|
|
|
@ -33,7 +33,7 @@ withCheckedFiles check d locations k a = go $ locations d k
|
|||
let chunkcount = f ++ Legacy.chunkCount
|
||||
ifM (check chunkcount)
|
||||
( do
|
||||
chunks <- Legacy.listChunks f <$> readFile chunkcount
|
||||
chunks <- Legacy.listChunks f <$> readFileString (toOsPath chunkcount)
|
||||
ifM (allM check chunks)
|
||||
( a chunks , return False )
|
||||
, do
|
||||
|
@ -85,7 +85,7 @@ storeHelper repotop finalizer key storer tmpdir destdir = do
|
|||
recorder f s = do
|
||||
let f' = toOsPath f
|
||||
void $ tryIO $ allowWrite f'
|
||||
writeFile f s
|
||||
writeFileString f' s
|
||||
void $ tryIO $ preventWrite f'
|
||||
|
||||
store :: FilePath -> ChunkSize -> (OsPath -> OsPath -> IO ()) -> Key -> L.ByteString -> MeterUpdate -> FilePath -> FilePath -> IO ()
|
||||
|
|
|
@ -213,7 +213,7 @@ createClient configdir furl = do
|
|||
|
||||
writeSharedConvergenceSecret :: TahoeConfigDir -> SharedConvergenceSecret -> IO ()
|
||||
writeSharedConvergenceSecret configdir scs =
|
||||
writeFile (fromOsPath (convergenceFile configdir))
|
||||
writeFileString (convergenceFile configdir)
|
||||
(unlines [scs])
|
||||
|
||||
{- The tahoe daemon writes the convergenceFile shortly after it starts
|
||||
|
@ -223,11 +223,11 @@ writeSharedConvergenceSecret configdir scs =
|
|||
getSharedConvergenceSecret :: TahoeConfigDir -> IO SharedConvergenceSecret
|
||||
getSharedConvergenceSecret configdir = go (60 :: Int)
|
||||
where
|
||||
f = fromOsPath $ convergenceFile configdir
|
||||
f = convergenceFile configdir
|
||||
go n
|
||||
| n == 0 = giveup $ "tahoe did not write " ++ f ++ " after 1 minute. Perhaps the daemon failed to start?"
|
||||
| n == 0 = giveup $ "tahoe did not write " ++ fromOsPath f ++ " after 1 minute. Perhaps the daemon failed to start?"
|
||||
| otherwise = do
|
||||
v <- catchMaybeIO (readFile f)
|
||||
v <- catchMaybeIO (readFileString f)
|
||||
case v of
|
||||
Just s | "\n" `isSuffixOf` s || "\r" `isSuffixOf` s ->
|
||||
return $ takeWhile (`notElem` ("\n\r" :: String)) s
|
||||
|
|
30
Test.hs
30
Test.hs
|
@ -556,8 +556,8 @@ test_magic = intmpclonerepo $ do
|
|||
#ifdef WITH_MAGICMIME
|
||||
git "config" ["annex.largefiles", "mimeencoding=binary"]
|
||||
"git config annex.largefiles"
|
||||
writeFile "binary" "\127"
|
||||
writeFile "text" "test\n"
|
||||
writeFileString (literalOsPath "binary") "\127"
|
||||
writeFileString (literalOsPath "text") "test\n"
|
||||
git_annex "add" ["binary", "text"]
|
||||
"git-annex add with mimeencoding in largefiles"
|
||||
git_annex "sync" ["--no-content"]
|
||||
|
@ -879,7 +879,7 @@ test_lock = intmpclonerepo $ do
|
|||
changecontent annexedfile
|
||||
git "add" [annexedfile] "add of modified file"
|
||||
runchecks [checkregularfile, checkwritable] annexedfile
|
||||
c <- readFile annexedfile
|
||||
c <- readFileString (toOsPath annexedfile)
|
||||
assertEqual "content of modified file" c (changedcontent annexedfile)
|
||||
git_annex_shouldfail "drop" [annexedfile]
|
||||
"drop with no known copy of modified file should not be allowed"
|
||||
|
@ -921,7 +921,7 @@ test_edit' precommit = intmpclonerepo $ do
|
|||
then git_annex "pre-commit" [] "pre-commit"
|
||||
else git "commit" ["-q", "-m", "contentchanged"] "git commit of edited file"
|
||||
runchecks [checkregularfile, checkwritable] annexedfile
|
||||
c <- readFile annexedfile
|
||||
c <- readFileString (toOsPath annexedfile)
|
||||
assertEqual "content of modified file" c (changedcontent annexedfile)
|
||||
git_annex_shouldfail "drop" [annexedfile] "drop no known copy of modified file should not be allowed"
|
||||
|
||||
|
@ -947,7 +947,7 @@ test_fix = intmpclonerepo $ unlessM (hasUnlockedFiles <$> getTestMode) $ do
|
|||
git "mv" [annexedfile, subdir] "git mv"
|
||||
git_annex "fix" [newfile] "fix of moved file"
|
||||
runchecks [checklink, checkunwritable] newfile
|
||||
c <- readFile newfile
|
||||
c <- readFileString (toOsPath newfile)
|
||||
assertEqual "content of moved file" c (content annexedfile)
|
||||
where
|
||||
subdir = "s"
|
||||
|
@ -1069,7 +1069,8 @@ test_migrate' usegitattributes = intmpclonerepo $ do
|
|||
annexed_present sha1annexedfile
|
||||
if usegitattributes
|
||||
then do
|
||||
writeFile ".gitattributes" "* annex.backend=SHA1"
|
||||
writeFileString (literalOsPath ".gitattributes")
|
||||
"* annex.backend=SHA1"
|
||||
git_annex "migrate" [sha1annexedfile]
|
||||
"migrate sha1annexedfile"
|
||||
git_annex "migrate" [annexedfile]
|
||||
|
@ -1085,7 +1086,8 @@ test_migrate' usegitattributes = intmpclonerepo $ do
|
|||
checkbackend sha1annexedfile backendSHA1
|
||||
|
||||
-- check that reversing a migration works
|
||||
writeFile ".gitattributes" "* annex.backend=SHA256"
|
||||
writeFileString (literalOsPath ".gitattributes")
|
||||
"* annex.backend=SHA256"
|
||||
git_annex "migrate" [sha1annexedfile] "migrate sha1annexedfile"
|
||||
git_annex "migrate" [annexedfile] "migrate annexedfile"
|
||||
annexed_present annexedfile
|
||||
|
@ -1531,7 +1533,7 @@ test_nonannexed_file_conflict_resolution = do
|
|||
length v == 1
|
||||
@? (what ++ " too many variant files in: " ++ show v)
|
||||
conflictor `elem` l @? (what ++ " conflictor file missing in: " ++ show l)
|
||||
s <- catchMaybeIO $ readFile $ fromOsPath $
|
||||
s <- catchMaybeIO $ readFileString $
|
||||
toOsPath d </> toOsPath conflictor
|
||||
s == Just nonannexed_content
|
||||
@? (what ++ " wrong content for nonannexed file: " ++ show s)
|
||||
|
@ -2074,9 +2076,9 @@ test_export_import = intmpclonerepo $ do
|
|||
dircontains "import" (content "newimport3")
|
||||
where
|
||||
dircontains f v = do
|
||||
let df = fromOsPath (literalOsPath "dir" </> stringToOsPath f)
|
||||
((v==) <$> readFile df)
|
||||
@? ("did not find expected content of " ++ df)
|
||||
let df = literalOsPath "dir" </> stringToOsPath f
|
||||
((v==) <$> readFileString df)
|
||||
@? ("did not find expected content of " ++ fromOsPath df)
|
||||
writedir f = writecontent (fromOsPath (literalOsPath "dir" </> stringToOsPath f))
|
||||
-- When on an adjusted branch, this updates the master branch
|
||||
-- to match it, which is necessary since the master branch is going
|
||||
|
@ -2111,9 +2113,9 @@ test_export_import_subdir = intmpclonerepo $ do
|
|||
testexport
|
||||
where
|
||||
dircontains f v = do
|
||||
let df = fromOsPath (literalOsPath "dir" </> toOsPath f)
|
||||
((v==) <$> readFile df)
|
||||
@? ("did not find expected content of " ++ df)
|
||||
let df = literalOsPath "dir" </> toOsPath f
|
||||
((v==) <$> readFileString df)
|
||||
@? ("did not find expected content of " ++ fromOsPath df)
|
||||
|
||||
subdir = "subdir"
|
||||
subannexedfile = fromOsPath $
|
||||
|
|
|
@ -391,7 +391,7 @@ checkexists f =
|
|||
|
||||
checkcontent :: FilePath -> Assertion
|
||||
checkcontent f = do
|
||||
c <- Utility.Exception.catchDefaultIO "could not read file" $ readFile f
|
||||
c <- Utility.Exception.catchDefaultIO "could not read file" $ readFileString (toOsPath f)
|
||||
assertEqual ("checkcontent " ++ f) (content f) c
|
||||
|
||||
checkunwritable :: FilePath -> Assertion
|
||||
|
@ -415,7 +415,7 @@ checkdangling :: FilePath -> Assertion
|
|||
checkdangling f = ifM (annexeval Config.crippledFileSystem)
|
||||
( return () -- probably no real symlinks to test
|
||||
, do
|
||||
r <- tryIO $ readFile f
|
||||
r <- tryIO $ readFileString (toOsPath f)
|
||||
case r of
|
||||
Left _ -> return () -- expected; dangling link
|
||||
Right _ -> assertFailure $ f ++ " was not a dangling link as expected"
|
||||
|
@ -675,9 +675,10 @@ writecontent :: FilePath -> String -> IO ()
|
|||
writecontent f c = go (10000000 :: Integer)
|
||||
where
|
||||
go ticsleft = do
|
||||
oldmtime <- catchMaybeIO $ getModificationTime (toOsPath f)
|
||||
writeFile f c
|
||||
newmtime <- getModificationTime (toOsPath f)
|
||||
let f' = toOsPath f
|
||||
oldmtime <- catchMaybeIO $ getModificationTime f'
|
||||
writeFileString f' c
|
||||
newmtime <- getModificationTime f'
|
||||
if Just newmtime == oldmtime
|
||||
then do
|
||||
threadDelay 100000
|
||||
|
|
|
@ -87,7 +87,7 @@ locationLogs = do
|
|||
inject :: OsPath -> OsPath -> Annex ()
|
||||
inject source dest = do
|
||||
old <- fromRepo olddir
|
||||
new <- liftIO (readFile $ fromOsPath $ old </> source)
|
||||
new <- liftIO $ readFileString (old </> source)
|
||||
Annex.Branch.change (Annex.Branch.RegardingUUID []) dest $ \prev ->
|
||||
encodeBL $ unlines $ nub $ lines (decodeBL prev) ++ lines new
|
||||
|
||||
|
@ -141,7 +141,7 @@ gitAttributesUnWrite repo = do
|
|||
whenM (doesFileExist attributes) $ do
|
||||
c <- map decodeBS . fileLines'
|
||||
<$> F.readFile' attributes
|
||||
liftIO $ viaTmp (writeFile . fromOsPath) attributes
|
||||
liftIO $ viaTmp writeFileString attributes
|
||||
(unlines $ filter (`notElem` attrLines) c)
|
||||
Git.Command.run [Param "add", File (fromOsPath attributes)] repo
|
||||
|
||||
|
|
|
@ -136,7 +136,7 @@ updateSmudgeFilter = do
|
|||
<$> catchDefaultIO "" (F.readFile' lf)
|
||||
let ls' = removedotfilter ls
|
||||
when (ls /= ls') $
|
||||
liftIO $ writeFile (fromOsPath lf) (unlines ls')
|
||||
liftIO $ writeFileString lf (unlines ls')
|
||||
where
|
||||
removedotfilter ("* filter=annex":".* !filter":rest) =
|
||||
"* filter=annex" : removedotfilter rest
|
||||
|
|
|
@ -121,9 +121,9 @@ lockPidFile pidfile = do
|
|||
unlessM (isNothing <$> checkDaemon pidfile)
|
||||
alreadyRunning
|
||||
pid <- getPID
|
||||
writeFile (fromOsPath pidfile) (show pid)
|
||||
writeFileString pidfile (show pid)
|
||||
lckfile <- winLockFile pid pidfile
|
||||
writeFile (fromOsPath lckfile) ""
|
||||
writeFileString lckfile ""
|
||||
void $ lockExclusive lckfile
|
||||
#endif
|
||||
|
||||
|
@ -147,7 +147,7 @@ checkDaemon pidfile = bracket setup cleanup go
|
|||
cleanup Nothing = return ()
|
||||
go (Just fd) = catchDefaultIO Nothing $ do
|
||||
locked <- getLock fd (ReadLock, AbsoluteSeek, 0, 0)
|
||||
p <- readish <$> readFile (fromOsPath pidfile)
|
||||
p <- readish <$> readFileString pidfile
|
||||
return (check locked p)
|
||||
go Nothing = return Nothing
|
||||
|
||||
|
@ -161,7 +161,7 @@ checkDaemon pidfile = bracket setup cleanup go
|
|||
"; expected " ++ show pid ++ " )"
|
||||
#else
|
||||
checkDaemon pidfile = maybe (return Nothing) (check . readish)
|
||||
=<< catchMaybeIO (readFile (fromOsPath pidfile))
|
||||
=<< catchMaybeIO (readFileString pidfile)
|
||||
where
|
||||
check Nothing = return Nothing
|
||||
check (Just pid) = do
|
||||
|
|
|
@ -171,7 +171,7 @@ setSticky f = modifyFileMode f $ addModes [stickyMode]
|
|||
- When possible, this is done using the umask.
|
||||
-
|
||||
- On a filesystem that does not support file permissions, this is the same
|
||||
- as writeFile.
|
||||
- as writeFileString.
|
||||
-}
|
||||
writeFileProtected :: OsPath -> String -> IO ()
|
||||
writeFileProtected file content = writeFileProtected' file
|
||||
|
|
|
@ -75,7 +75,7 @@ buildDesktopMenuFile d = unlines ("[Desktop Entry]" : map keyvalue d) ++ "\n"
|
|||
writeDesktopMenuFile :: DesktopEntry -> OsPath -> IO ()
|
||||
writeDesktopMenuFile d file = do
|
||||
createDirectoryIfMissing True (takeDirectory file)
|
||||
writeFile (fromOsPath file) $ buildDesktopMenuFile d
|
||||
writeFileString file $ buildDesktopMenuFile d
|
||||
|
||||
{- Path to use for a desktop menu file, in either the systemDataDir or
|
||||
- the userDataDir -}
|
||||
|
|
|
@ -234,7 +234,7 @@ noTSDelta = TSDelta (pure 0)
|
|||
writeSentinalFile :: SentinalFile -> IO ()
|
||||
writeSentinalFile s = do
|
||||
F.writeFile' (sentinalFile s) mempty
|
||||
maybe noop (writeFile (fromOsPath (sentinalCacheFile s)) . showInodeCache)
|
||||
maybe noop (writeFileString (sentinalCacheFile s) . showInodeCache)
|
||||
=<< genInodeCache (sentinalFile s) noTSDelta
|
||||
|
||||
data SentinalStatus = SentinalStatus
|
||||
|
@ -263,7 +263,7 @@ checkSentinalFile s = do
|
|||
Just new -> return $ calc old new
|
||||
where
|
||||
loadoldcache = catchDefaultIO Nothing $
|
||||
readInodeCache <$> readFile (fromOsPath (sentinalCacheFile s))
|
||||
readInodeCache <$> readFileString (sentinalCacheFile s)
|
||||
gennewcache = genInodeCache (sentinalFile s) noTSDelta
|
||||
calc (InodeCache (InodeCachePrim oldinode oldsize oldmtime)) (InodeCache (InodeCachePrim newinode newsize newmtime)) =
|
||||
SentinalStatus (not unchanged) tsdelta
|
||||
|
|
|
@ -41,6 +41,7 @@ import Utility.Env.Set
|
|||
import Utility.Tmp
|
||||
import Utility.RawFilePath
|
||||
import Utility.OsPath
|
||||
import qualified Utility.FileIO as F
|
||||
import qualified Utility.LockFile.Posix as Posix
|
||||
|
||||
import System.IO
|
||||
|
@ -77,7 +78,7 @@ mkPidLock = PidLock
|
|||
|
||||
readPidLock :: PidLockFile -> IO (Maybe PidLock)
|
||||
readPidLock lockfile = (readish =<<)
|
||||
<$> catchMaybeIO (readFile (fromOsPath lockfile))
|
||||
<$> catchMaybeIO (F.readFileString lockfile)
|
||||
|
||||
-- To avoid races when taking over a stale pid lock, a side lock is used.
|
||||
-- This is a regular posix exclusive lock.
|
||||
|
@ -214,7 +215,7 @@ linkToLock (Just _) src dest = do
|
|||
(CloseOnExecFlag True)
|
||||
fdToHandle fd
|
||||
let cleanup = hClose
|
||||
let go h = readFile (fromOsPath src) >>= hPutStr h
|
||||
let go h = F.readFileString src >>= hPutStr h
|
||||
bracket setup cleanup go
|
||||
getFileStatus dest'
|
||||
where
|
||||
|
|
|
@ -110,7 +110,7 @@ fileLines' = map stripCR . S8.lines
|
|||
fileLines' = S8.lines
|
||||
#endif
|
||||
|
||||
-- One windows, writeFile does NewlineMode translation,
|
||||
-- On windows, writeFile does NewlineMode translation,
|
||||
-- adding CR before LF. When converting to ByteString, use this to emulate that.
|
||||
linesFile :: L.ByteString -> L.ByteString
|
||||
#ifndef mingw32_HOST_OS
|
||||
|
|
|
@ -37,7 +37,7 @@ findShellCommand f = do
|
|||
#ifndef mingw32_HOST_OS
|
||||
defcmd
|
||||
#else
|
||||
l <- catchDefaultIO Nothing $ headMaybe . lines <$> readFile (fromOsPath f)
|
||||
l <- catchDefaultIO Nothing $ headMaybe . lines <$> readFileString f
|
||||
case l of
|
||||
Just ('#':'!':rest) -> case words rest of
|
||||
[] -> defcmd
|
||||
|
|
|
@ -49,13 +49,13 @@ openTmpFileIn dir template = F.openTempFile dir template
|
|||
let loc = ioeGetLocation e ++ " template " ++ decodeBS (fromOsPath template)
|
||||
in annotateIOError e loc Nothing Nothing
|
||||
|
||||
{- Runs an action like writeFile, writing to a temp file first and
|
||||
{- Runs an action like writeFileString, writing to a temp file first and
|
||||
- then moving it into place. The temp file is stored in the same
|
||||
- directory as the final file to avoid cross-device renames.
|
||||
-
|
||||
- While this uses a temp file, the file will end up with the same
|
||||
- mode as it would when using writeFile, unless the writer action changes
|
||||
- it.
|
||||
- mode as it would when using writeFileString, unless the writer action
|
||||
- changes it.
|
||||
-}
|
||||
viaTmp :: (MonadMask m, MonadIO m) => (OsPath -> v -> m ()) -> OsPath -> v -> m ()
|
||||
viaTmp a file content = bracketIO setup cleanup use
|
||||
|
|
|
@ -71,7 +71,7 @@ connectHiddenService (OnionAddress address) port = do
|
|||
addHiddenService :: AppName -> UserID -> UniqueIdent -> IO (OnionAddress, OnionPort)
|
||||
addHiddenService appname uid ident = do
|
||||
prepHiddenServiceSocketDir appname uid ident
|
||||
ls <- lines <$> (readFile . fromOsPath =<< findTorrc)
|
||||
ls <- lines <$> (readFileString =<< findTorrc)
|
||||
let portssocks = mapMaybe (parseportsock . separate isSpace) ls
|
||||
case filter (\(_, s) -> s == fromOsPath sockfile) portssocks of
|
||||
((p, _s):_) -> waithiddenservice 1 p
|
||||
|
@ -80,7 +80,7 @@ addHiddenService appname uid ident = do
|
|||
let newport = fromMaybe (error "internal") $ headMaybe $
|
||||
filter (`notElem` map fst portssocks) highports
|
||||
torrc <- findTorrc
|
||||
writeFile (fromOsPath torrc) $ unlines $
|
||||
writeFileString torrc $ unlines $
|
||||
ls ++
|
||||
[ ""
|
||||
, "HiddenServiceDir " ++ fromOsPath (hiddenServiceDir appname uid ident)
|
||||
|
@ -112,7 +112,7 @@ addHiddenService appname uid ident = do
|
|||
waithiddenservice :: Int -> OnionPort -> IO (OnionAddress, OnionPort)
|
||||
waithiddenservice 0 _ = giveup "tor failed to create hidden service, perhaps the tor service is not running"
|
||||
waithiddenservice n p = do
|
||||
v <- tryIO $ readFile $ fromOsPath $
|
||||
v <- tryIO $ readFileString $
|
||||
hiddenServiceHostnameFile appname uid ident
|
||||
case v of
|
||||
Right s | ".onion\n" `isSuffixOf` s ->
|
||||
|
@ -152,7 +152,7 @@ hiddenServiceSocketFile appname uid ident =
|
|||
getHiddenServiceSocketFile :: AppName -> UserID -> UniqueIdent -> IO (Maybe OsPath)
|
||||
getHiddenServiceSocketFile _appname uid ident =
|
||||
parse . map words . lines <$> catchDefaultIO ""
|
||||
(readFile . fromOsPath =<< findTorrc)
|
||||
(readFileString =<< findTorrc)
|
||||
where
|
||||
parse [] = Nothing
|
||||
parse (("HiddenServiceDir":hsdir:[]):("HiddenServicePort":_hsport:hsaddr:[]):rest)
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue