newtype CheckGitIgnore = CheckGitIgnore Bool
-checkIgnored :: CheckGitIgnore -> FilePath -> Annex Bool
+checkIgnored :: CheckGitIgnore -> RawFilePath -> Annex Bool
checkIgnored (CheckGitIgnore False) _ = pure False
checkIgnored (CheckGitIgnore True) file =
ifM (Annex.getState Annex.force)
secureErase file
liftIO $ removeWhenExistsWith R.removeLink file
ic <- replaceWorkTreeFile file' $ \tmp -> do
- liftIO $ writePointerFile (toRawFilePath tmp) key mode
+ let tmp' = toRawFilePath tmp
+ liftIO $ writePointerFile tmp' key mode
#if ! defined(mingw32_HOST_OS)
-- Don't advance mtime; this avoids unncessary re-smudging
-- by git in some cases.
liftIO $ maybe noop
- (\t -> touch tmp t False)
+ (\t -> touch tmp' t False)
(fmap modificationTimeHiRes st)
#endif
withTSDelta (liftIO . genInodeCache (toRawFilePath tmp))
data LockDownConfig = LockDownConfig
{ lockingFile :: Bool
-- ^ write bit removed during lock down
- , hardlinkFileTmpDir :: Maybe FilePath
+ , hardlinkFileTmpDir :: Maybe RawFilePath
-- ^ hard link to temp directory
}
deriving (Show)
when (lockingFile cfg) $
freezeContent file
withTSDelta $ \delta -> liftIO $ do
- (tmpfile, h) <- openTempFile tmpdir $
+ (tmpfile, h) <- openTempFile (fromRawFilePath tmpdir) $
relatedTemplate $ "ingest-" ++ takeFileName file
hClose h
removeWhenExistsWith removeLink tmpfile
Just k -> do
let f = keyFilename source
if lockingFile cfg
- then addLink ci (fromRawFilePath f) k mic
+ then addLink ci f k mic
else do
mode <- liftIO $ catchMaybeIO $
fileMode <$> R.getFileStatus (contentLocation source)
throwM e
{- Creates the symlink to the annexed content, returns the link target. -}
-makeLink :: FilePath -> Key -> Maybe InodeCache -> Annex LinkTarget
-makeLink file key mcache = flip catchNonAsync (restoreFile file key) $ do
- l <- calcRepo $ gitAnnexLink (toRawFilePath file) key
- replaceWorkTreeFile file $ makeAnnexLink l . toRawFilePath
+makeLink :: RawFilePath -> Key -> Maybe InodeCache -> Annex LinkTarget
+makeLink file key mcache = flip catchNonAsync (restoreFile file' key) $ do
+ l <- calcRepo $ gitAnnexLink file key
+ replaceWorkTreeFile file' $ makeAnnexLink l . toRawFilePath
-- touch symlink to have same time as the original file,
-- as provided in the InodeCache
Nothing -> noop
return l
+ where
+ file' = fromRawFilePath file
{- Creates the symlink to the annexed content, and stages it in git.
-
- Also, using git add allows it to skip gitignored files, unless forced
- to include them.
-}
-addLink :: CheckGitIgnore -> FilePath -> Key -> Maybe InodeCache -> Annex ()
+addLink :: CheckGitIgnore -> RawFilePath -> Key -> Maybe InodeCache -> Annex ()
addLink ci file key mcache = ifM (coreSymlinks <$> Annex.getGitConfig)
( do
_ <- makeLink file key mcache
ps <- gitAddParams ci
- Annex.Queue.addCommand "add" (ps++[Param "--"]) [file]
+ Annex.Queue.addCommand "add" (ps++[Param "--"]) [fromRawFilePath file]
, do
l <- makeLink file key mcache
- addAnnexLink l (toRawFilePath file)
+ addAnnexLink l file
)
{- Parameters to pass to git add, forcing addition of ignored files.
-
- When the content of the key is not accepted into the annex, returns False.
-}
-addAnnexedFile :: CheckGitIgnore -> AddUnlockedMatcher -> FilePath -> Key -> Maybe FilePath -> Annex Bool
+addAnnexedFile :: CheckGitIgnore -> AddUnlockedMatcher -> RawFilePath -> Key -> Maybe RawFilePath -> Annex Bool
addAnnexedFile ci matcher file key mtmp = ifM (addUnlocked matcher mi)
( do
mode <- maybe
(pure Nothing)
- (\tmp -> liftIO $ catchMaybeIO $ fileMode <$> getFileStatus tmp)
+ (\tmp -> liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus tmp)
mtmp
- stagePointerFile file' mode =<< hashPointerFile key
- Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath file')
+ stagePointerFile file mode =<< hashPointerFile key
+ Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath file)
case mtmp of
- Just tmp -> ifM (moveAnnex key (toRawFilePath tmp))
+ Just tmp -> ifM (moveAnnex key tmp)
( linkunlocked mode >> return True
, writepointer mode >> return False
)
, do
addLink ci file key Nothing
case mtmp of
- Just tmp -> moveAnnex key (toRawFilePath tmp)
+ Just tmp -> moveAnnex key tmp
Nothing -> return True
)
where
mi = case mtmp of
Just tmp -> MatchingFile $ FileInfo
- { contentFile = Just (toRawFilePath tmp)
- , matchFile = file'
+ { contentFile = Just tmp
+ , matchFile = file
}
-- Provide as much info as we can without access to the
-- file's content.
Nothing -> MatchingInfo $ ProvidedInfo
- { providedFilePath = file'
+ { providedFilePath = file
, providedKey = Just key
, providedFileSize = fromMaybe 0 $
keySize `fromKey` key
, providedMimeEncoding = Nothing
}
- linkunlocked mode = linkFromAnnex key file' mode >>= \case
- LinkAnnexFailed -> liftIO $
- writePointerFile file' key mode
+ linkunlocked mode = linkFromAnnex key file mode >>= \case
+ LinkAnnexFailed -> liftIO $ writepointer mode
_ -> return ()
- writepointer mode = liftIO $ writePointerFile file' key mode
-
- file' = toRawFilePath file
+
+ writepointer mode = liftIO $ writePointerFile file key mode
{- .git/annex/smudge.log is used to log smudges worktree files that need to
- be updated. -}
-gitAnnexSmudgeLog :: Git.Repo -> FilePath
-gitAnnexSmudgeLog r = fromRawFilePath $ gitAnnexDir r P.</> "smudge.log"
+gitAnnexSmudgeLog :: Git.Repo -> RawFilePath
+gitAnnexSmudgeLog r = gitAnnexDir r P.</> "smudge.log"
gitAnnexSmudgeLock :: Git.Repo -> RawFilePath
gitAnnexSmudgeLock r = gitAnnexDir r P.</> "smudge.lck"
{- .git/annex/move.log is used to log moves that are in progress,
- to better support resuming an interrupted move. -}
-gitAnnexMoveLog :: Git.Repo -> FilePath
-gitAnnexMoveLog r = fromRawFilePath $ gitAnnexDir r P.</> "move.log"
+gitAnnexMoveLog :: Git.Repo -> RawFilePath
+gitAnnexMoveLog r = gitAnnexDir r P.</> "move.log"
-gitAnnexMoveLock :: Git.Repo -> FilePath
-gitAnnexMoveLock r = fromRawFilePath $ gitAnnexDir r P.</> "move.lck"
+gitAnnexMoveLock :: Git.Repo -> RawFilePath
+gitAnnexMoveLock r = gitAnnexDir r P.</> "move.lck"
{- .git/annex/export/ is used to store information about
- exports to special remotes. -}
removeModes writeModes .
addModes [ownerReadMode]
-isContentWritePermOk :: FilePath -> Annex Bool
+isContentWritePermOk :: RawFilePath -> Annex Bool
isContentWritePermOk file = ifM crippledFileSystem
( return True
, withShared go
go AllShared = want writeModes
go _ = return True
want wantmode =
- liftIO (catchMaybeIO $ fileMode <$> getFileStatus file) >>= return . \case
+ liftIO (catchMaybeIO $ fileMode <$> R.getFileStatus file) >>= return . \case
Nothing -> True
Just havemode -> havemode == combineModes (havemode:wantmode)
annexdotfiles <- getGitConfigVal annexDotFiles
let gofile (si, file) = case largeFilesOverride o of
Nothing ->
- let file' = fromRawFilePath file
- in ifM (pure (annexdotfiles || not (dotfile file')) <&&> (checkFileMatcher largematcher file' <||> Annex.getState Annex.force))
+ ifM (pure (annexdotfiles || not (dotfile file))
+ <&&> (checkFileMatcher largematcher file
+ <||> Annex.getState Annex.force))
( start o si file addunlockedmatcher
, ifM (annexAddSmallFiles <$> Annex.getGitConfig)
( startSmall o si file
addSmallOverridden :: AddOptions -> RawFilePath -> Annex Bool
addSmallOverridden o file = do
showNote "adding content to git repository"
- let file' = fromRawFilePath file
- s <- liftIO $ getSymbolicLinkStatus file'
+ s <- liftIO $ R.getSymbolicLinkStatus file
if not (isRegularFile s)
then addFile (checkGitIgnoreOption o) file
else do
-- Can't use addFile because the clean filter will
-- honor annex.largefiles and it has been overridden.
-- Instead, hash the file and add to the index.
- sha <- hashFile file'
+ sha <- hashFile file
let ty = if isExecutable (fileMode s)
then TreeExecutable
else TreeFile
Annex.Queue.addUpdateIndex =<<
- inRepo (Git.UpdateIndex.stageFile sha ty file')
+ inRepo (Git.UpdateIndex.stageFile sha ty (fromRawFilePath file))
return True
addFile :: CheckGitIgnore -> RawFilePath -> Annex Bool
fixuplink key = starting "add" (ActionItemWorkTreeFile file) si $ do
-- the annexed symlink is present but not yet added to git
liftIO $ removeFile (fromRawFilePath file)
- addLink (checkGitIgnoreOption o) (fromRawFilePath file) key Nothing
+ addLink (checkGitIgnoreOption o) file key Nothing
next $
cleanup key =<< inAnnex key
fixuppointer key = starting "add" (ActionItemWorkTreeFile file) si $ do
- Licensed under the GNU AGPL version 3 or higher.
-}
+{-# LANGUAGE OverloadedStrings #-}
+
module Command.AddUnused where
import Logs.Location
addLink (CheckGitIgnore False) file key Nothing
return True
where
- file = "unused." ++ fromRawFilePath (keyFile key)
+ file = "unused." <> keyFile key
{- The content is not in the annex, but in another directory, and
- it seems better to error out, rather than moving bad/tmp content into
module Command.AddUrl where
-import Network.URI
-
import Command
import Backend
import qualified Annex
import Utility.Metered
import Utility.HtmlDetect
import Utility.Path.Max
+import qualified Utility.RawFilePath as R
import qualified Annex.Transfer as Transfer
+import Network.URI
+import qualified System.FilePath.ByteString as P
+
cmd :: Command
cmd = notBareRepo $ withGlobalOptions [jobsOption, jsonOptions, jsonProgressOption] $
command "addurl" SectionCommon "add urls to annex"
downloadRemoteFile :: AddUnlockedMatcher -> Remote -> DownloadOptions -> URLString -> FilePath -> Maybe Integer -> Annex (Maybe Key)
downloadRemoteFile addunlockedmatcher r o uri file sz = checkCanAdd o file $ \canadd -> do
let urlkey = Backend.URL.fromUrl uri sz
- createWorkTreeDirectory (parentDir file)
+ createWorkTreeDirectory (parentDir (toRawFilePath file))
ifM (Annex.getState Annex.fast <||> pure (relaxedOption o))
( do
addWorkTree canadd addunlockedmatcher (Remote.uuid r) loguri file urlkey Nothing
)
normalfinish tmp = checkCanAdd o file $ \canadd -> do
showDestinationFile file
- createWorkTreeDirectory (parentDir file)
+ createWorkTreeDirectory (parentDir (toRawFilePath file))
Just <$> finishDownloadWith canadd addunlockedmatcher tmp webUUID url file
-- Ask youtube-dl what filename it will download first,
-- so it's only used when the file contains embedded media.
Left _ -> normalfinish tmp
where
dl dest = withTmpWorkDir mediakey $ \workdir -> do
- let cleanuptmp = pruneTmpWorkDirBefore tmp (liftIO . removeWhenExistsWith removeLink)
+ let cleanuptmp = pruneTmpWorkDirBefore tmp (liftIO . removeWhenExistsWith R.removeLink)
showNote "using youtube-dl"
Transfer.notifyTransfer Transfer.Download url $
Transfer.download webUUID mediakey (AssociatedFile Nothing) Transfer.noRetry $ \p ->
then return (Just tmp)
else return Nothing
-finishDownloadWith :: CanAddFile -> AddUnlockedMatcher -> FilePath -> UUID -> URLString -> FilePath -> Annex Key
+finishDownloadWith :: CanAddFile -> AddUnlockedMatcher -> RawFilePath -> UUID -> URLString -> RawFilePath -> Annex Key
finishDownloadWith canadd addunlockedmatcher tmp u url file = do
backend <- chooseBackend file
let source = KeySource
}
{- Adds worktree file to the repository. -}
-addWorkTree :: CanAddFile -> AddUnlockedMatcher -> UUID -> URLString -> FilePath -> Key -> Maybe FilePath -> Annex ()
+addWorkTree :: CanAddFile -> AddUnlockedMatcher -> UUID -> URLString -> RawFilePath -> Key -> Maybe RawFilePath -> Annex ()
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 $ \_ -> do
- createWorkTreeDirectory (takeDirectory file)
- liftIO $ renameFile tmp file
+ createWorkTreeDirectory (P.takeDirectory file)
+ liftIO $ renameFile
+ (fromRawFilePath tmp)
+ (fromRawFilePath file)
largematcher <- largeFilesMatcher
large <- checkFileMatcher largematcher file
if large
-- Move back to tmp because addAnnexedFile
-- needs the file in a different location
-- than the work tree file.
- liftIO $ renameFile file tmp
+ liftIO $ renameFile
+ (fromRawFilePath file)
+ (fromRawFilePath tmp)
go
- else void $ Command.Add.addSmall noci (toRawFilePath file)
+ else void $ Command.Add.addSmall noci file
where
go = do
maybeShowJSON $ JSONChunk [("key", serializeKey key)]
( do
when (isJust mtmp) $
logStatus key InfoPresent
- , maybe noop (\tmp -> pruneTmpWorkDirBefore tmp (liftIO . removeWhenExistsWith removeLink)) mtmp
+ , maybe noop (\tmp -> pruneTmpWorkDirBefore tmp (liftIO . removeWhenExistsWith R.removeLink)) mtmp
)
-- git does not need to check ignores, because that has already
-- been done, as witnessed by the CannAddFile.
noci = CheckGitIgnore False
-nodownloadWeb :: AddUnlockedMatcher -> DownloadOptions -> URLString -> Url.UrlInfo -> FilePath -> Annex (Maybe Key)
+nodownloadWeb :: AddUnlockedMatcher -> DownloadOptions -> URLString -> Url.UrlInfo -> RawFilePath -> Annex (Maybe Key)
nodownloadWeb addunlockedmatcher o url urlinfo file
| Url.urlExists urlinfo = if rawOption o
then nomedia
- else either (const nomedia) usemedia
+ else either (const nomedia) (usemedia . toRawFilePath)
=<< youtubeDlFileName url
| otherwise = do
warning $ "unable to access url: " ++ url
let mediakey = Backend.URL.fromUrl mediaurl Nothing
nodownloadWeb' o addunlockedmatcher mediaurl mediakey dest
-youtubeDlDestFile :: DownloadOptions -> FilePath -> FilePath -> FilePath
+youtubeDlDestFile :: DownloadOptions -> RawFilePath -> RawFilePath -> RawFilePath
youtubeDlDestFile o destfile mediafile
| isJust (fileOption o) = destfile
- | otherwise = takeFileName mediafile
+ | otherwise = P.takeFileName mediafile
-nodownloadWeb' :: DownloadOptions -> AddUnlockedMatcher -> URLString -> Key -> FilePath -> Annex (Maybe Key)
+nodownloadWeb' :: DownloadOptions -> AddUnlockedMatcher -> URLString -> Key -> RawFilePath -> Annex (Maybe Key)
nodownloadWeb' o addunlockedmatcher url key file = checkCanAdd o file $ \canadd -> do
- showDestinationFile file
+ showDestinationFile (fromRawFilePath file)
createWorkTreeDirectory (parentDir file)
addWorkTree canadd addunlockedmatcher webUUID url file key Nothing
return (Just key)
data CanAddFile = CanAddFile
-checkCanAdd :: DownloadOptions -> FilePath -> (CanAddFile -> Annex (Maybe a)) -> Annex (Maybe a)
-checkCanAdd o file a = ifM (isJust <$> (liftIO $ catchMaybeIO $ getSymbolicLinkStatus file))
+checkCanAdd :: DownloadOptions -> RawFilePath -> (CanAddFile -> Annex (Maybe a)) -> Annex (Maybe a)
+checkCanAdd o file a = ifM (isJust <$> (liftIO $ catchMaybeIO $ R.getSymbolicLinkStatus file))
( do
- warning $ file ++ " already exists; not overwriting"
+ warning $ fromRawFilePath file ++ " already exists; not overwriting"
return Nothing
, ifM (checkIgnored (checkGitIgnoreOption o) file)
( do
- warning $ "not adding " ++ file ++ " which is .gitignored (use --no-check-gitignore to override)"
+ warning $ "not adding " ++ fromRawFilePath file ++ " which is .gitignored (use --no-check-gitignore to override)"
return Nothing
, a CanAddFile
)
Command.Move.start (fromToOptions o) Command.Move.RemoveNever si file key
where
shouldCopy
- | autoMode o = want <||> numCopiesCheck (fromRawFilePath file) key (<)
+ | autoMode o = want <||> numCopiesCheck file key (<)
| otherwise = return True
want = case fromToOptions o of
Right (ToRemote dest) ->
import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused)
import Annex.NumCopies
import Annex.Content
+import qualified Utility.RawFilePath as R
cmd :: Command
cmd = command "dropunused" SectionMaintenance
where
droplocal = Command.Drop.performLocal key (AssociatedFile Nothing) numcopies []
-performOther :: (Key -> Git.Repo -> FilePath) -> Key -> CommandPerform
+performOther :: (Key -> Git.Repo -> RawFilePath) -> Key -> CommandPerform
performOther filespec key = do
f <- fromRepo $ filespec key
- pruneTmpWorkDirBefore f (liftIO . removeWhenExistsWith removeLink)
+ pruneTmpWorkDirBefore f (liftIO . removeWhenExistsWith R.removeLink)
next $ return True
start :: FixWhat -> SeekInput -> RawFilePath -> Key -> CommandStart
start fixwhat si file key = do
currlink <- liftIO $ catchMaybeIO $ R.readSymbolicLink file
- wantlink <- calcRepo $ gitAnnexLink (fromRawFilePath file) key
+ wantlink <- calcRepo $ gitAnnexLink file key
case currlink of
Just l
- | l /= toRawFilePath wantlink -> fixby $
- fixSymlink (fromRawFilePath file) wantlink
+ | l /= wantlink -> fixby $ fixSymlink file wantlink
| otherwise -> stop
Nothing -> case fixwhat of
FixAll -> fixthin
unlessM (checkedCopyFile key obj' tmp mode) $
error "unable to break hard link"
thawContent tmp
- modifyContent obj' $ freezeContent obj'
+ modifyContent obj $ freezeContent obj'
Database.Keys.storeInodeCaches key [file]
next $ return True
makeHardLink file key = do
replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do
mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file
- linkFromAnnex key tmp mode >>= \case
+ linkFromAnnex key (toRawFilePath tmp) mode >>= \case
LinkAnnexFailed -> error "unable to make hard link"
_ -> noop
next $ return True
-fixSymlink :: FilePath -> FilePath -> CommandPerform
+fixSymlink :: RawFilePath -> RawFilePath -> CommandPerform
fixSymlink file link = do
#if ! defined(mingw32_HOST_OS)
-- preserve mtime of symlink
mtime <- liftIO $ catchMaybeIO $ modificationTimeHiRes
- <$> getSymbolicLinkStatus file
+ <$> R.getSymbolicLinkStatus file
#endif
createWorkTreeDirectory (parentDir file)
- liftIO $ removeFile file
- liftIO $ createSymbolicLink link file
+ liftIO $ R.removeLink file
+ liftIO $ R.createSymbolicLink link file
#if ! defined(mingw32_HOST_OS)
liftIO $ maybe noop (\t -> touch file t False) mtime
#endif
- next $ cleanupSymlink file
+ next $ cleanupSymlink (fromRawFilePath file)
cleanupSymlink :: FilePath -> CommandCleanup
cleanupSymlink file = do
import Annex.Perms
import qualified Annex
import qualified Backend.URL
+import qualified Utility.RawFilePath as R
import Network.URI
let (keyname, file) = separate (== ' ') s
if not (null keyname) && not (null file)
then do
- file' <- liftIO $ relPathCwdToFile file
+ file' <- liftIO $ relPathCwdToFile (toRawFilePath file)
return $ Right (file', keyOpt keyname)
else return $
Left "Expected pairs of key and filename"
go (si, (file, key)) =
- let ai = mkActionItem (key, toRawFilePath file)
+ let ai = mkActionItem (key, file)
in starting "fromkey" ai si $
perform key file
inbackend <- inAnnex key
unless inbackend $ giveup $
"key ("++ keyname ++") is not present in backend (use --force to override this sanity check)"
- let ai = mkActionItem (key, toRawFilePath file)
+ let ai = mkActionItem (key, file')
starting "fromkey" ai si $
- perform key file
+ perform key file'
+ where
+ file' = toRawFilePath file
-- From user input to a Key.
-- User can input either a serialized key, or an url.
Just k -> k
Nothing -> giveup $ "bad key/url " ++ s
-perform :: Key -> FilePath -> CommandPerform
-perform key file = lookupKeyNotHidden (toRawFilePath file) >>= \case
- Nothing -> ifM (liftIO $ doesFileExist file)
+perform :: Key -> RawFilePath -> CommandPerform
+perform key file = lookupKeyNotHidden file >>= \case
+ Nothing -> ifM (liftIO $ doesFileExist (fromRawFilePath file))
( hasothercontent
, do
link <- calcRepo $ gitAnnexLink file key
createWorkTreeDirectory (parentDir file)
- liftIO $ createSymbolicLink link file
- Annex.Queue.addCommand "add" [Param "--"] [file]
+ liftIO $ R.createSymbolicLink link file
+ Annex.Queue.addCommand "add" [Param "--"] [fromRawFilePath file]
next $ return True
)
Just k
| otherwise -> hasothercontent
where
hasothercontent = do
- warning $ file ++ " already exists with different content"
+ warning $ fromRawFilePath file ++ " already exists with different content"
next $ return False
-}
{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
module Command.Fsck where
import qualified Data.Set as S
import qualified Data.Map as M
import Data.Either
+import qualified System.FilePath.ByteString as P
cmd :: Command
cmd = withGlobalOptions [jobsOption, jsonOptions, annexedMatchingOptions] $
start from inc si file key = Backend.getBackend (fromRawFilePath file) key >>= \case
Nothing -> stop
Just backend -> do
- numcopies <- getFileNumCopies (fromRawFilePath file)
+ numcopies <- getFileNumCopies file
case from of
Nothing -> go $ perform key file backend numcopies
Just r -> go $ performRemote key afile backend numcopies r
pid <- liftIO getPID
t <- fromRepo gitAnnexTmpObjectDir
createAnnexDirectory t
- let tmp = t </> "fsck" ++ show pid ++ "." ++ fromRawFilePath (keyFile key)
- let cleanup = liftIO $ catchIO (removeFile tmp) (const noop)
+ let tmp = t P.</> "fsck" <> toRawFilePath (show pid) <> "." <> keyFile key
+ let cleanup = liftIO $ catchIO (R.removeLink tmp) (const noop)
cleanup
cleanup `after` a tmp
- getfile tmp = ifM (checkDiskSpace (Just (takeDirectory tmp)) key 0 True)
+ getfile tmp = ifM (checkDiskSpace (Just (fromRawFilePath (P.takeDirectory tmp))) key 0 True)
( ifM (getcheap tmp)
( return (Just True)
, ifM (Annex.getState Annex.fast)
)
, return (Just False)
)
- getfile' tmp = Remote.retrieveKeyFile remote key (AssociatedFile Nothing) tmp dummymeter
+ getfile' tmp = Remote.retrieveKeyFile remote key (AssociatedFile Nothing) (fromRawFilePath tmp) dummymeter
dummymeter _ = noop
getcheap tmp = case Remote.retrieveKeyFileCheap remote of
- Just a -> isRight <$> tryNonAsync (a key afile tmp)
+ Just a -> isRight <$> tryNonAsync (a key afile (fromRawFilePath tmp))
Nothing -> return False
startKey :: Maybe Remote -> Incremental -> (SeekInput, Key, ActionItem) -> NumCopies -> CommandStart
{- Checks that symlinks points correctly to the annexed content. -}
fixLink :: Key -> RawFilePath -> Annex Bool
fixLink key file = do
- want <- calcRepo $ gitAnnexLink (fromRawFilePath file) key
+ want <- calcRepo $ gitAnnexLink file key
have <- getAnnexLinkTarget file
maybe noop (go want) have
return True
where
go want have
- | want /= fromRawFilePath (fromInternalGitPath have) = do
+ | want /= fromInternalGitPath have = do
showNote "fixing link"
- createWorkTreeDirectory (parentDir (fromRawFilePath file))
- liftIO $ removeFile (fromRawFilePath file)
+ createWorkTreeDirectory (parentDir file)
+ liftIO $ R.removeLink file
addAnnexLink want file
| otherwise = noop
- in this repository only. -}
verifyLocationLog :: Key -> KeyStatus -> ActionItem -> Annex Bool
verifyLocationLog key keystatus ai = do
- obj <- fromRawFilePath <$> calcRepo (gitAnnexLocation key)
+ obj <- calcRepo (gitAnnexLocation key)
present <- if isKeyUnlockedThin keystatus
- then liftIO (doesFileExist obj)
+ then liftIO (doesFileExist (fromRawFilePath obj))
else inAnnex key
u <- getUUID
- in a permission fixup here too. -}
when present $ do
void $ tryIO $ case keystatus of
- KeyUnlockedThin -> thawContent obj
- KeyLockedThin -> thawContent obj
- _ -> freezeContent obj
+ KeyUnlockedThin -> thawContent (fromRawFilePath obj)
+ KeyLockedThin -> thawContent (fromRawFilePath obj)
+ _ -> freezeContent (fromRawFilePath obj)
unlessM (isContentWritePermOk obj) $
- warning $ "** Unable to set correct write mode for " ++ obj ++ " ; perhaps you don't own that file"
- whenM (liftIO $ doesDirectoryExist $ parentDir obj) $
+ warning $ "** Unable to set correct write mode for " ++ fromRawFilePath obj ++ " ; perhaps you don't own that file"
+ whenM (liftIO $ R.doesPathExist $ parentDir obj) $
freezeContentDir obj
{- Warn when annex.securehashesonly is set and content using an
- config was set. -}
whenM (pure present <&&> (not <$> Backend.isCryptographicallySecure key)) $
whenM (annexSecureHashesOnly <$> Annex.getGitConfig) $
- warning $ "** Despite annex.securehashesonly being set, " ++ obj ++ " has content present in the annex using an insecure " ++ decodeBS (formatKeyVariety (fromKey keyVariety key)) ++ " key"
+ warning $ "** Despite annex.securehashesonly being set, " ++ fromRawFilePath obj ++ " has content present in the annex using an insecure " ++ decodeBS (formatKeyVariety (fromKey keyVariety key)) ++ " key"
verifyLocationLog' key ai present u (logChange key u)
replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do
mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file
ifM (annexThin <$> Annex.getGitConfig)
- ( void $ linkFromAnnex key tmp mode
+ ( void $ linkFromAnnex key (toRawFilePath tmp) mode
, do
obj <- fromRawFilePath <$> calcRepo (gitAnnexLocation key)
void $ checkedCopyFile key obj tmp mode
checkKeySize key _ ai = do
file <- calcRepo $ gitAnnexLocation key
ifM (liftIO $ R.doesPathExist file)
- ( checkKeySizeOr badContent key (fromRawFilePath file) ai
+ ( checkKeySizeOr badContent key file ai
, return True
)
-withLocalCopy :: Maybe FilePath -> (FilePath -> Annex Bool) -> Annex Bool
+withLocalCopy :: Maybe RawFilePath -> (RawFilePath -> Annex Bool) -> Annex Bool
withLocalCopy Nothing _ = return True
withLocalCopy (Just localcopy) f = f localcopy
-checkKeySizeRemote :: Key -> Remote -> ActionItem -> FilePath -> Annex Bool
+checkKeySizeRemote :: Key -> Remote -> ActionItem -> RawFilePath -> Annex Bool
checkKeySizeRemote key remote ai localcopy =
checkKeySizeOr (badContentRemote remote localcopy) key localcopy ai
-checkKeySizeOr :: (Key -> Annex String) -> Key -> FilePath -> ActionItem -> Annex Bool
+checkKeySizeOr :: (Key -> Annex String) -> Key -> RawFilePath -> ActionItem -> Annex Bool
checkKeySizeOr bad key file ai = case fromKey keySize key of
Nothing -> return True
Just size -> do
- size' <- liftIO $ getFileSize file
+ size' <- liftIO $ getFileSize (fromRawFilePath file)
comparesizes size size'
where
comparesizes a b = do
content <- calcRepo (gitAnnexLocation key)
ifM (pure (isKeyUnlockedThin keystatus) <&&> (not <$> isUnmodified key content))
( nocheck
- , checkBackendOr badContent backend key (fromRawFilePath content) ai
+ , checkBackendOr badContent backend key content ai
)
where
nocheck = return True
ai = mkActionItem (key, afile)
-checkBackendRemote :: Backend -> Key -> Remote -> ActionItem -> FilePath -> Annex Bool
+checkBackendRemote :: Backend -> Key -> Remote -> ActionItem -> RawFilePath -> Annex Bool
checkBackendRemote backend key remote ai localcopy =
checkBackendOr (badContentRemote remote localcopy) backend key localcopy ai
-checkBackendOr :: (Key -> Annex String) -> Backend -> Key -> FilePath -> ActionItem -> Annex Bool
+checkBackendOr :: (Key -> Annex String) -> Backend -> Key -> RawFilePath -> ActionItem -> Annex Bool
checkBackendOr bad backend key file ai =
checkBackendOr' bad backend key file ai (return True)
-- The postcheck action is run after the content is verified,
-- in order to detect situations where the file is changed while being
-- verified.
-checkBackendOr' :: (Key -> Annex String) -> Backend -> Key -> FilePath -> ActionItem -> Annex Bool -> Annex Bool
+checkBackendOr' :: (Key -> Annex String) -> Backend -> Key -> RawFilePath -> ActionItem -> Annex Bool -> Annex Bool
checkBackendOr' bad backend key file ai postcheck =
case Types.Backend.verifyKeyContent backend of
Nothing -> return True
Just verifier -> do
- ok <- verifier key file
+ ok <- verifier key (fromRawFilePath file)
ifM postcheck
( do
unless ok $ do
- symlink to a file in the remote). To avoid any further data loss,
- that temp file is moved to the bad content directory unless
- the local annex has a copy of the content. -}
-badContentRemote :: Remote -> FilePath -> Key -> Annex String
+badContentRemote :: Remote -> RawFilePath -> Key -> Annex String
badContentRemote remote localcopy key = do
bad <- fromRepo gitAnnexBadDir
- let destbad = bad </> fromRawFilePath (keyFile key)
- movedbad <- ifM (inAnnex key <||> liftIO (doesFileExist destbad))
+ let destbad = bad P.</> keyFile key
+ let destbad' = fromRawFilePath destbad
+ movedbad <- ifM (inAnnex key <||> liftIO (doesFileExist destbad'))
( return False
, do
createAnnexDirectory (parentDir destbad)
liftIO $ catchDefaultIO False $
- ifM (isSymbolicLink <$> getSymbolicLinkStatus localcopy)
- ( copyFileExternal CopyTimeStamps localcopy destbad
+ ifM (isSymbolicLink <$> R.getSymbolicLinkStatus localcopy)
+ ( copyFileExternal CopyTimeStamps (fromRawFilePath localcopy) destbad'
, do
- moveFile localcopy destbad
+ moveFile (fromRawFilePath localcopy) destbad'
return True
)
)
Remote.logStatus remote key InfoMissing
return $ case (movedbad, dropped) of
(True, Right ()) -> "moved from " ++ Remote.name remote ++
- " to " ++ destbad
+ " to " ++ fromRawFilePath destbad
(False, Right ()) -> "dropped from " ++ Remote.name remote
(_, Left e) -> "failed to drop from" ++ Remote.name remote ++ ": " ++ show e
recordStartTime :: UUID -> Annex ()
recordStartTime u = do
f <- fromRepo (gitAnnexFsckState u)
+ let f' = fromRawFilePath f
createAnnexDirectory $ parentDir f
- liftIO $ removeWhenExistsWith removeLink f
- liftIO $ withFile f WriteMode $ \h -> do
+ liftIO $ removeWhenExistsWith R.removeLink f
+ liftIO $ withFile f' WriteMode $ \h -> do
#ifndef mingw32_HOST_OS
- t <- modificationTime <$> getFileStatus f
+ t <- modificationTime <$> R.getFileStatus f
#else
t <- getPOSIXTime
#endif
hPutStr h $ showTime $ realToFrac t
- setAnnexFilePerm f
+ setAnnexFilePerm f'
where
showTime :: POSIXTime -> String
showTime = show
resetStartTime :: UUID -> Annex ()
-resetStartTime u = liftIO . removeWhenExistsWith removeLink
+resetStartTime u = liftIO . removeWhenExistsWith R.removeLink
=<< fromRepo (gitAnnexFsckState u)
{- Gets the incremental fsck start time. -}
getStartTime u = do
f <- fromRepo (gitAnnexFsckState u)
liftIO $ catchDefaultIO Nothing $ do
- timestamp <- modificationTime <$> getFileStatus f
+ timestamp <- modificationTime <$> R.getFileStatus f
let fromstatus = Just (realToFrac timestamp)
- fromfile <- parsePOSIXTime <$> readFile f
+ fromfile <- parsePOSIXTime <$> readFile (fromRawFilePath f)
return $ if matchingtimestamp fromfile fromstatus
then Just timestamp
else Nothing
afile = AssociatedFile (Just file)
ai = mkActionItem (key, afile)
expensivecheck
- | autoMode o = numCopiesCheck (fromRawFilePath file) key (<)
+ | autoMode o = numCopiesCheck file key (<)
<||> wantGet False (Just key) afile
| otherwise = return True
download (Remote.uuid r) key afile stdRetry
(\p -> do
showAction $ "from " ++ Remote.name r
- Remote.verifiedAction (Remote.retrieveKeyFile r key afile dest p)
+ Remote.verifiedAction $
+ Remote.retrieveKeyFile r key afile (fromRawFilePath dest) p
) witness
perform :: RawFilePath -> Key -> CommandPerform
perform file key = do
lockdown =<< calcRepo (gitAnnexLocation key)
- addLink (CheckGitIgnore False) (fromRawFilePath file) key
+ addLink (CheckGitIgnore False) file key
=<< withTSDelta (liftIO . genInodeCache file)
next $ cleanup file key
where
Just oldbackend -> do
exists <- inAnnex key
newbackend <- maybe defaultBackend return
- =<< chooseBackend (fromRawFilePath file)
+ =<< chooseBackend file
if (newbackend /= oldbackend || upgradableKey oldbackend key || forced) && exists
then starting "migrate" (mkActionItem (key, file)) si $
perform file key oldbackend newbackend
where
getnumcopies = case afile of
AssociatedFile Nothing -> getNumCopies
- AssociatedFile (Just af) -> getFileNumCopies (fromRawFilePath af)
+ AssociatedFile (Just af) -> getFileNumCopies af
get = notifyTransfer Download afile $
download (Remote.uuid src) key afile stdRetry $ \p ->
getViaTmp (Remote.retrievalSecurityPolicy src) (RemoteVerify src) key $ \t ->
- Remote.verifiedAction $ Remote.retrieveKeyFile src key afile t p
+ Remote.verifiedAction $ Remote.retrieveKeyFile src key afile (fromRawFilePath t) p
dispatch _ _ False = stop -- failed
dispatch RemoveNever _ True = next $ return True -- copy complete
go logf
-- Only need to check log when there is a copy.
| deststartedwithcopy = do
- wasnocopy <- checkLogFile logf gitAnnexMoveLock
+ wasnocopy <- checkLogFile (fromRawFilePath logf) gitAnnexMoveLock
(== logline)
if wasnocopy
then go' False
( do
-- Update symlink to use the new key.
liftIO $ removeFile (fromRawFilePath file)
- addLink (CheckGitIgnore False) (fromRawFilePath file) newkey Nothing
+ addLink (CheckGitIgnore False) file newkey Nothing
, do
mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file
liftIO $ whenM (isJust <$> isPointerFile file) $
import qualified Utility.CoProcess as CoProcess
import System.IO.Error
+import qualified Data.ByteString as B
type CheckIgnoreHandle = CoProcess.CoProcessHandle
checkIgnoreStop = void . tryIO . CoProcess.stop
{- Returns True if a file is ignored. -}
-checkIgnored :: CheckIgnoreHandle -> FilePath -> IO Bool
+checkIgnored :: CheckIgnoreHandle -> RawFilePath -> IO Bool
checkIgnored h file = CoProcess.query h send (receive "")
where
send to = do
- hPutStr to $ file ++ "\0"
+ B.hPutStr to $ file `B.snoc` 0
hFlush to
receive c from = do
s <- hGetSomeString from 1024
-- | Appends a line to a log file, first locking it to prevent
-- concurrent writers.
-appendLogFile :: FilePath -> (Git.Repo -> RawFilePath) -> L.ByteString -> Annex ()
+appendLogFile :: RawFilePath -> (Git.Repo -> RawFilePath) -> L.ByteString -> Annex ()
appendLogFile f lck c =
- createDirWhenNeeded (toRawFilePath f) $
+ createDirWhenNeeded f $
withExclusiveLock lck $ do
- liftIO $ withFile f AppendMode $ \h -> L8.hPutStrLn h c
- setAnnexFilePerm f
+ liftIO $ withFile f' AppendMode $
+ \h -> L8.hPutStrLn h c
+ setAnnexFilePerm f'
+ where
+ f' = fromRawFilePath f
-- | Modifies a log file.
--
--
-- The file is locked to prevent concurrent writers, and it is written
-- atomically.
-modifyLogFile :: FilePath -> (Git.Repo -> RawFilePath) -> ([L.ByteString] -> [L.ByteString]) -> Annex ()
+modifyLogFile :: RawFilePath -> (Git.Repo -> RawFilePath) -> ([L.ByteString] -> [L.ByteString]) -> Annex ()
modifyLogFile f lck modf = withExclusiveLock lck $ do
ls <- liftIO $ fromMaybe []
- <$> tryWhenExists (L8.lines <$> L.readFile f)
+ <$> tryWhenExists (L8.lines <$> L.readFile f')
let ls' = modf ls
when (ls' /= ls) $
- createDirWhenNeeded (toRawFilePath f) $
- viaTmp writelog f (L8.unlines ls')
+ createDirWhenNeeded f $
+ viaTmp writelog f' (L8.unlines ls')
where
- writelog f' b = do
- liftIO $ L.writeFile f' b
- setAnnexFilePerm f'
+ f' = fromRawFilePath f
+ writelog lf b = do
+ liftIO $ L.writeFile lf b
+ setAnnexFilePerm lf
-- | Checks the content of a log file to see if any line matches.
--
streamSmudged :: (Key -> TopFilePath -> Annex ()) -> Annex ()
streamSmudged a = do
logf <- fromRepo gitAnnexSmudgeLog
- streamLogFile logf gitAnnexSmudgeLock $ \l ->
+ streamLogFile (fromRawFilePath logf) gitAnnexSmudgeLock $ \l ->
case parse l of
Nothing -> noop
Just (k, f) -> a k f
#if ! defined(mingw32_HOST_OS)
-import System.Posix.Files
+import System.FilePath.ByteString (RawFilePath)
+import System.Posix.Files.ByteString
import Data.Time.Clock.POSIX
{- Changes the access and modification times of an existing file.
Can follow symlinks, or not. -}
-touchBoth :: FilePath -> POSIXTime -> POSIXTime -> Bool -> IO ()
+touchBoth :: RawFilePath -> POSIXTime -> POSIXTime -> Bool -> IO ()
touchBoth file atime mtime follow
| follow = setFileTimesHiRes file atime mtime
| otherwise = setSymbolicLinkTimesHiRes file atime mtime
{- Changes the access and modification times of an existing file
- to the same value. Can follow symlinks, or not. -}
-touch :: FilePath -> POSIXTime -> Bool -> IO ()
+touch :: RawFilePath -> POSIXTime -> Bool -> IO ()
touch file mtime = touchBoth file mtime mtime
#else
import Data.Time.Clock.POSIX
{- Noop for Windows -}
-touchBoth :: FilePath -> POSIXTime -> POSIXTime -> Bool -> IO ()
+touchBoth :: RawFilePath -> POSIXTime -> POSIXTime -> Bool -> IO ()
touchBoth _ _ _ _ = return ()
-touch :: FilePath -> POSIXTime -> Bool -> IO ()
+touch :: RawFilePath -> POSIXTime -> Bool -> IO ()
touch _ _ _ = return ()
#endif