mostly finished with createDirectoryUnder conversion
Remaining things needing converted are in the assistant, and Annex.Ssh. Every other remaining call to createDirectoryIfMissing True has been audited and is not relevant. The ones in Build/ of course don't get included in the program. Others included eg, Remote.Tahoe and Config.Files which both write to dotfiles under the home directory.
This commit is contained in:
parent
2f204b5d37
commit
7f992ef59c
11 changed files with 30 additions and 23 deletions
|
@ -20,6 +20,7 @@ import qualified Command.Add
|
|||
import Annex.Content
|
||||
import Annex.Ingest
|
||||
import Annex.CheckIgnore
|
||||
import Annex.Perms
|
||||
import Annex.UUID
|
||||
import Annex.YoutubeDl
|
||||
import Logs.Web
|
||||
|
@ -168,7 +169,7 @@ performRemote addunlockedmatcher r o uri file sz = ifAnnexed (toRawFilePath file
|
|||
downloadRemoteFile :: AddUnlockedMatcher -> Remote -> DownloadOptions -> URLString -> FilePath -> Maybe Integer -> Annex (Maybe Key)
|
||||
downloadRemoteFile addunlockedmatcher r o uri file sz = checkCanAdd file $ do
|
||||
let urlkey = Backend.URL.fromUrl uri sz
|
||||
liftIO $ createDirectoryIfMissing True (parentDir file)
|
||||
createWorkTreeDirectory (parentDir file)
|
||||
ifM (Annex.getState Annex.fast <||> pure (relaxedOption o))
|
||||
( do
|
||||
addWorkTree addunlockedmatcher (Remote.uuid r) loguri file urlkey Nothing
|
||||
|
@ -271,7 +272,7 @@ downloadWeb addunlockedmatcher o url urlinfo file =
|
|||
)
|
||||
normalfinish tmp = checkCanAdd file $ do
|
||||
showDestinationFile file
|
||||
liftIO $ createDirectoryIfMissing True (parentDir file)
|
||||
createWorkTreeDirectory (parentDir file)
|
||||
finishDownloadWith addunlockedmatcher tmp webUUID url file
|
||||
tryyoutubedl tmp
|
||||
-- Ask youtube-dl what filename it will download
|
||||
|
@ -357,7 +358,7 @@ downloadWith' downloader dummykey u url afile =
|
|||
tmp <- fromRepo $ gitAnnexTmpObjectLocation dummykey
|
||||
ok <- Transfer.notifyTransfer Transfer.Download url $
|
||||
Transfer.download u dummykey afile Transfer.stdRetry $ \p -> do
|
||||
liftIO $ createDirectoryIfMissing True (parentDir tmp)
|
||||
createAnnexDirectory (parentDir tmp)
|
||||
downloader tmp p
|
||||
if ok
|
||||
then return (Just tmp)
|
||||
|
@ -389,9 +390,9 @@ addWorkTree addunlockedmatcher u url file key mtmp = case mtmp of
|
|||
Nothing -> go
|
||||
Just tmp -> do
|
||||
-- Move to final location for large file check.
|
||||
pruneTmpWorkDirBefore tmp $ \_ -> liftIO $ do
|
||||
createDirectoryIfMissing True (takeDirectory file)
|
||||
renameFile tmp file
|
||||
pruneTmpWorkDirBefore tmp $ \_ -> do
|
||||
createWorkTreeDirectory (takeDirectory file)
|
||||
liftIO $ renameFile tmp file
|
||||
largematcher <- largeFilesMatcher
|
||||
large <- checkFileMatcher largematcher file
|
||||
if large
|
||||
|
@ -438,7 +439,7 @@ nodownloadWeb addunlockedmatcher o url urlinfo file
|
|||
nodownloadWeb' :: AddUnlockedMatcher -> URLString -> Key -> FilePath -> Annex (Maybe Key)
|
||||
nodownloadWeb' addunlockedmatcher url key file = checkCanAdd file $ do
|
||||
showDestinationFile file
|
||||
liftIO $ createDirectoryIfMissing True (parentDir file)
|
||||
createWorkTreeDirectory (parentDir file)
|
||||
addWorkTree addunlockedmatcher webUUID url file key Nothing
|
||||
return (Just key)
|
||||
|
||||
|
|
|
@ -94,7 +94,7 @@ fixSymlink file link = do
|
|||
mtime <- catchMaybeIO $ modificationTimeHiRes
|
||||
<$> getSymbolicLinkStatus file
|
||||
#endif
|
||||
createDirectoryIfMissing True (parentDir file)
|
||||
createWorkTreeDirectory (parentDir file)
|
||||
removeFile file
|
||||
createSymbolicLink link file
|
||||
#if ! defined(mingw32_HOST_OS)
|
||||
|
|
|
@ -13,6 +13,7 @@ import Command
|
|||
import qualified Annex.Queue
|
||||
import Annex.Content
|
||||
import Annex.WorkTree
|
||||
import Annex.Perms
|
||||
import qualified Annex
|
||||
import qualified Backend.URL
|
||||
|
||||
|
@ -85,7 +86,7 @@ perform key file = lookupFileNotHidden (toRawFilePath file) >>= \case
|
|||
( hasothercontent
|
||||
, do
|
||||
link <- calcRepo $ gitAnnexLink file key
|
||||
liftIO $ createDirectoryIfMissing True (parentDir file)
|
||||
createWorkTreeDirectory (parentDir file)
|
||||
liftIO $ createSymbolicLink link file
|
||||
Annex.Queue.addCommand "add" [Param "--"] [file]
|
||||
next $ return True
|
||||
|
|
|
@ -219,7 +219,7 @@ fixLink key file = do
|
|||
go want have
|
||||
| want /= fromRawFilePath (fromInternalGitPath have) = do
|
||||
showNote "fixing link"
|
||||
liftIO $ createDirectoryIfMissing True (parentDir (fromRawFilePath file))
|
||||
liftIO $ createWorkTreeDirectory (parentDir (fromRawFilePath file))
|
||||
liftIO $ removeFile (fromRawFilePath file)
|
||||
addAnnexLink want file
|
||||
| otherwise = noop
|
||||
|
|
|
@ -13,6 +13,7 @@ import Command
|
|||
import qualified Annex
|
||||
import qualified Git.Config
|
||||
import Config
|
||||
import Annex.Perms
|
||||
import Utility.ThreadScheduler
|
||||
import Utility.DiskFree
|
||||
import Git.Types (fromConfigKey)
|
||||
|
@ -172,10 +173,10 @@ instance Arbitrary FuzzAction where
|
|||
]
|
||||
|
||||
runFuzzAction :: FuzzAction -> Annex ()
|
||||
runFuzzAction (FuzzAdd (FuzzFile f)) = liftIO $ do
|
||||
createDirectoryIfMissing True $ parentDir f
|
||||
n <- getStdRandom random :: IO Int
|
||||
writeFile f $ show n ++ "\n"
|
||||
runFuzzAction (FuzzAdd (FuzzFile f)) = do
|
||||
createWorkTreeDirectory (parentDir f)
|
||||
n <- liftIO (getStdRandom random :: IO Int)
|
||||
liftIO $ writeFile f $ show n ++ "\n"
|
||||
runFuzzAction (FuzzDelete (FuzzFile f)) = liftIO $ nukeFile f
|
||||
runFuzzAction (FuzzMove (FuzzFile src) (FuzzFile dest)) = liftIO $
|
||||
rename src dest
|
||||
|
|
|
@ -25,6 +25,7 @@ import Annex.FileMatcher
|
|||
import Annex.Ingest
|
||||
import Annex.InodeSentinal
|
||||
import Annex.Import
|
||||
import Annex.Perms
|
||||
import Annex.RemoteTrackingBranch
|
||||
import Utility.InodeCache
|
||||
import Logs.Location
|
||||
|
@ -176,12 +177,12 @@ startLocal addunlockedmatcher largematcher mode (srcfile, destfile) =
|
|||
importfilechecked ld k = do
|
||||
-- Move or copy the src file to the dest file.
|
||||
-- The dest file is what will be ingested.
|
||||
liftIO $ createDirectoryIfMissing True (parentDir destfile)
|
||||
createWorkTreeDirectory (parentDir destfile)
|
||||
liftIO $ if mode == Duplicate || mode == SkipDuplicates
|
||||
then void $ copyFileExternal CopyAllMetaData srcfile destfile
|
||||
else moveFile srcfile destfile
|
||||
-- Get the inode cache of the dest file. It should be
|
||||
-- weakly the same as the origianlly locked down file's
|
||||
-- weakly the same as the originally locked down file's
|
||||
-- inode cache. (Since the file may have been copied,
|
||||
-- its inodes may not be the same.)
|
||||
newcache <- withTSDelta $ liftIO . genInodeCache destfile'
|
||||
|
|
|
@ -10,7 +10,6 @@ module Database.Init where
|
|||
import Annex.Common
|
||||
import Annex.Perms
|
||||
import Utility.FileMode
|
||||
import Utility.Directory
|
||||
|
||||
import Database.Persist.Sqlite
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
|
|
|
@ -245,8 +245,9 @@ explodePackedRefsFile r = do
|
|||
nukeFile f
|
||||
where
|
||||
makeref (sha, ref) = do
|
||||
let dest = fromRawFilePath (localGitDir r) </> fromRef ref
|
||||
createDirectoryIfMissing True (parentDir dest)
|
||||
let gitd = fromRawFilePath (localGitDir r)
|
||||
let dest = gitd </> fromRef ref
|
||||
createDirectoryUnder gitd (parentDir dest)
|
||||
unlessM (doesFileExist dest) $
|
||||
writeFile dest (fromRef sha)
|
||||
|
||||
|
|
|
@ -49,6 +49,7 @@ import qualified Remote.Helper.Ssh as Ssh
|
|||
import Utility.Metered
|
||||
import Annex.UUID
|
||||
import Annex.Ssh
|
||||
import Annex.Perms
|
||||
import qualified Remote.Rsync
|
||||
import qualified Remote.Directory
|
||||
import Utility.Rsync
|
||||
|
@ -283,7 +284,7 @@ setupRepo gcryptid r
|
|||
- which is needed for direct rsync of objects to work.
|
||||
-}
|
||||
rsyncsetup = Remote.Rsync.withRsyncScratchDir $ \tmp -> do
|
||||
liftIO $ createDirectoryIfMissing True $ tmp </> objectDir
|
||||
createAnnexDirectory (tmp </> objectDir)
|
||||
dummycfg <- liftIO dummyRemoteGitConfig
|
||||
(rsynctransport, rsyncurl, _) <- rsyncTransport r dummycfg
|
||||
let tmpconfig = tmp </> "config"
|
||||
|
@ -368,7 +369,7 @@ store' repo r rsyncopts
|
|||
| not $ Git.repoIsUrl repo =
|
||||
byteStorer $ \k b p -> guardUsable repo (return False) $ liftIO $ do
|
||||
let tmpdir = Git.repoLocation repo </> "tmp" </> fromRawFilePath (keyFile k)
|
||||
void $ tryIO $ createDirectoryIfMissing True tmpdir
|
||||
void $ tryIO $ createDirectoryUnder (Git.repoLocation repo) tmpdir
|
||||
let tmpf = tmpdir </> fromRawFilePath (keyFile k)
|
||||
meteredWriteFile p tmpf b
|
||||
let destdir = parentDir $ gCryptLocation repo k
|
||||
|
|
|
@ -27,6 +27,7 @@ import Config.Cost
|
|||
import Annex.Content
|
||||
import Annex.UUID
|
||||
import Annex.Ssh
|
||||
import Annex.Perms
|
||||
import Remote.Helper.Special
|
||||
import Remote.Helper.Messages
|
||||
import Remote.Helper.ExportImport
|
||||
|
@ -218,7 +219,7 @@ store o k src meterupdate = storeGeneric o meterupdate basedest populatedest
|
|||
storeGeneric :: RsyncOpts -> MeterUpdate -> FilePath -> (FilePath -> Annex Bool) -> Annex Bool
|
||||
storeGeneric o meterupdate basedest populatedest = withRsyncScratchDir $ \tmp -> do
|
||||
let dest = tmp </> basedest
|
||||
liftIO $ createDirectoryIfMissing True $ parentDir dest
|
||||
createAnnexDirectory (parentDir dest)
|
||||
ok <- populatedest dest
|
||||
ps <- sendParams
|
||||
if ok
|
||||
|
|
|
@ -17,6 +17,7 @@ import qualified Data.ByteString.Lazy as L
|
|||
import Annex.Common
|
||||
import Annex.Content
|
||||
import Annex.Link
|
||||
import Annex.Perms
|
||||
import Types.Key
|
||||
import Logs.Presence
|
||||
import qualified Annex.Queue
|
||||
|
@ -115,7 +116,7 @@ moveLocationLogs = do
|
|||
dest <- fromRepo $ logFile2 k
|
||||
dir <- fromRepo Upgrade.V2.gitStateDir
|
||||
let f = dir </> l
|
||||
liftIO $ createDirectoryIfMissing True (parentDir dest)
|
||||
createWorkTreeDirectory (parentDir dest)
|
||||
-- could just git mv, but this way deals with
|
||||
-- log files that are not checked into git,
|
||||
-- as well as merging with already upgraded
|
||||
|
|
Loading…
Reference in a new issue