more RawFilePath conversion
580/645 This commit was sponsored by Jack Hill on Patreon.
This commit is contained in:
Joey Hess
parent
eb42cd4d46
commit
4bcb4030a5
10 changed files with 61 additions and 50 deletions
|
|
@ -64,7 +64,7 @@ handleDropsFrom locs rs reason fromhere key afile si preverified runner = do
|
|||
(untrusted, have) <- trustPartition UnTrusted locs
|
||||
numcopies <- if null fs
|
||||
then getNumCopies
|
||||
else maximum <$> mapM (getFileNumCopies . fromRawFilePath) fs
|
||||
else maximum <$> mapM getFileNumCopies fs
|
||||
return (NumCopies (length have), numcopies, S.fromList untrusted)
|
||||
|
||||
{- Check that we have enough copies still to drop the content.
|
||||
|
|
|
|||
|
|
@ -271,7 +271,7 @@ buildImportTrees basetree msubdir importable = History
|
|||
mktreeitem (loc, v) = case v of
|
||||
Right k -> do
|
||||
relf <- fromRepo $ fromTopFilePath topf
|
||||
symlink <- calcRepo $ gitAnnexLink (fromRawFilePath relf) k
|
||||
symlink <- calcRepo $ gitAnnexLink relf k
|
||||
linksha <- hashSymlink symlink
|
||||
return $ TreeItem treepath (fromTreeItemType TreeSymlink) linksha
|
||||
Left sha ->
|
||||
|
|
@ -538,7 +538,7 @@ importKeys remote importtreeconfig importcontent importablecontents = do
|
|||
backend <- chooseBackend (fromRawFilePath f)
|
||||
let ks = KeySource
|
||||
{ keyFilename = f
|
||||
, contentLocation = toRawFilePath tmpfile
|
||||
, contentLocation = tmpfile
|
||||
, inodeCache = Nothing
|
||||
}
|
||||
fst <$> genKey ks nullMeterUpdate backend
|
||||
|
|
@ -671,7 +671,7 @@ matchesImportLocation matcher loc sz = checkMatcher' matcher mi mempty
|
|||
notIgnoredImportLocation :: ImportTreeConfig -> CheckGitIgnore -> ImportLocation -> Annex Bool
|
||||
notIgnoredImportLocation importtreeconfig ci loc = not <$> checkIgnored ci f
|
||||
where
|
||||
f = fromRawFilePath $ case importtreeconfig of
|
||||
f = case importtreeconfig of
|
||||
ImportSubTree dir _ ->
|
||||
getTopFilePath dir P.</> fromImportLocation loc
|
||||
ImportTree ->
|
||||
|
|
|
|||
|
|
@ -428,12 +428,12 @@ gitAnnexWebPrivKey :: Git.Repo -> FilePath
|
|||
gitAnnexWebPrivKey r = fromRawFilePath $ gitAnnexDir r P.</> "privkey.pem"
|
||||
|
||||
{- .git/annex/feeds/ is used to record per-key (url) state by importfeeds -}
|
||||
gitAnnexFeedStateDir :: Git.Repo -> FilePath
|
||||
gitAnnexFeedStateDir r = fromRawFilePath $
|
||||
P.addTrailingPathSeparator $ gitAnnexDir r P.</> "feedstate"
|
||||
gitAnnexFeedStateDir :: Git.Repo -> RawFilePath
|
||||
gitAnnexFeedStateDir r = P.addTrailingPathSeparator $
|
||||
gitAnnexDir r P.</> "feedstate"
|
||||
|
||||
gitAnnexFeedState :: Key -> Git.Repo -> FilePath
|
||||
gitAnnexFeedState k r = gitAnnexFeedStateDir r </> fromRawFilePath (keyFile k)
|
||||
gitAnnexFeedState :: Key -> Git.Repo -> RawFilePath
|
||||
gitAnnexFeedState k r = gitAnnexFeedStateDir r P.</> keyFile k
|
||||
|
||||
{- .git/annex/merge/ is used as a empty work tree for direct mode merges and
|
||||
- merges in adjusted branches. -}
|
||||
|
|
|
|||
|
|
@ -51,7 +51,8 @@ ensureInstalled = ifM (isJust <$> getEnv "GIT_ANNEX_PACKAGE_INSTALL")
|
|||
go (Just base) = do
|
||||
let program = base </> "git-annex"
|
||||
programfile <- programFile
|
||||
createDirectoryIfMissing True (parentDir programfile)
|
||||
createDirectoryIfMissing True $
|
||||
fromRawFilePath (parentDir (toRawFilePath programfile))
|
||||
writeFile programfile program
|
||||
|
||||
#ifdef darwin_HOST_OS
|
||||
|
|
@ -100,7 +101,7 @@ installWrapper :: FilePath -> String -> IO ()
|
|||
installWrapper file content = do
|
||||
curr <- catchDefaultIO "" $ readFileStrict file
|
||||
when (curr /= content) $ do
|
||||
createDirectoryIfMissing True (parentDir file)
|
||||
createDirectoryIfMissing True (fromRawFilePath (parentDir (toRawFilePath file)))
|
||||
viaTmp writeFile file content
|
||||
modifyFileMode file $ addModes [ownerExecuteMode]
|
||||
|
||||
|
|
|
|||
|
|
@ -46,7 +46,9 @@ makeRepo path bare = ifM (probeRepoExists path)
|
|||
{- Runs an action in the git repository in the specified directory. -}
|
||||
inDir :: FilePath -> Annex a -> IO a
|
||||
inDir dir a = do
|
||||
state <- Annex.new =<< Git.Config.read =<< Git.Construct.fromPath dir
|
||||
state <- Annex.new
|
||||
=<< Git.Config.read
|
||||
=<< Git.Construct.fromPath (toRawFilePath dir)
|
||||
Annex.eval state $ a `finally` stopCoProcesses
|
||||
|
||||
{- Creates a new repository, and returns its UUID. -}
|
||||
|
|
|
|||
|
|
@ -335,7 +335,8 @@ addLink file link mk = do
|
|||
Just (currlink, sha, _type)
|
||||
| s2w8 link == L.unpack currlink ->
|
||||
stageSymlink (toRawFilePath file) sha
|
||||
_ -> stageSymlink (toRawFilePath file) =<< hashSymlink link
|
||||
_ -> stageSymlink (toRawFilePath file)
|
||||
=<< hashSymlink (toRawFilePath link)
|
||||
madeChange file $ LinkChange mk
|
||||
|
||||
onDel :: Handler
|
||||
|
|
|
|||
|
|
@ -118,5 +118,6 @@ postPreferencesR = page "Preferences" (Just Configuration) $ do
|
|||
|
||||
inAutoStartFile :: Annex Bool
|
||||
inAutoStartFile = do
|
||||
here <- liftIO . absPath . fromRawFilePath =<< fromRepo Git.repoPath
|
||||
any (`equalFilePath` here) <$> liftIO readAutoStartFile
|
||||
here <- liftIO . absPath =<< fromRepo Git.repoPath
|
||||
any (`equalFilePath` here) . toRawFilePath
|
||||
<$> liftIO readAutoStartFile
|
||||
|
|
|
|||
|
|
@ -71,7 +71,9 @@ checkDirectory mdir = do
|
|||
canondir home d
|
||||
| "~/" `isPrefixOf` d = return d
|
||||
| "/~/" `isPrefixOf` d = return $ drop 1 d
|
||||
| otherwise = relHome $ absPathFrom home d
|
||||
| otherwise = relHome $ fromRawFilePath <$> absPathFrom
|
||||
(toRawFilePath home)
|
||||
(toRawFilePath d)
|
||||
|
||||
{- Modifies a Command to check that it is run in either a git-annex
|
||||
- repository, or a repository with a gcrypt-id set. -}
|
||||
|
|
|
|||
|
|
@ -165,14 +165,15 @@ checkUrl addunlockedmatcher r o si u = do
|
|||
startRemote :: AddUnlockedMatcher -> Remote -> AddUrlOptions -> SeekInput -> FilePath -> URLString -> Maybe Integer -> CommandStart
|
||||
startRemote addunlockedmatcher r o si file uri sz = do
|
||||
pathmax <- liftIO $ fileNameLengthLimit "."
|
||||
let file' = joinPath $ map (truncateFilePath pathmax) $ splitDirectories file
|
||||
let file' = joinPath $ map (truncateFilePath pathmax) $
|
||||
splitDirectories file
|
||||
startingAddUrl si uri o $ do
|
||||
showNote $ "from " ++ Remote.name r
|
||||
showDestinationFile file'
|
||||
performRemote addunlockedmatcher r o uri file' sz
|
||||
performRemote addunlockedmatcher r o uri (toRawFilePath file') sz
|
||||
|
||||
performRemote :: AddUnlockedMatcher -> Remote -> AddUrlOptions -> URLString -> FilePath -> Maybe Integer -> CommandPerform
|
||||
performRemote addunlockedmatcher r o uri file sz = ifAnnexed (toRawFilePath file) adduri geturi
|
||||
performRemote :: AddUnlockedMatcher -> Remote -> AddUrlOptions -> URLString -> RawFilePath -> Maybe Integer -> CommandPerform
|
||||
performRemote addunlockedmatcher r o uri file sz = ifAnnexed file adduri geturi
|
||||
where
|
||||
loguri = setDownloader uri OtherDownloader
|
||||
adduri = addUrlChecked o loguri file (Remote.uuid r) checkexistssize
|
||||
|
|
@ -181,10 +182,10 @@ performRemote addunlockedmatcher r o uri file sz = ifAnnexed (toRawFilePath file
|
|||
Just n -> (True, n == fromMaybe n (fromKey keySize key), loguri)
|
||||
geturi = next $ isJust <$> downloadRemoteFile addunlockedmatcher r (downloadOptions o) uri file sz
|
||||
|
||||
downloadRemoteFile :: AddUnlockedMatcher -> Remote -> DownloadOptions -> URLString -> FilePath -> Maybe Integer -> Annex (Maybe Key)
|
||||
downloadRemoteFile :: AddUnlockedMatcher -> Remote -> DownloadOptions -> URLString -> RawFilePath -> 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 (toRawFilePath file))
|
||||
createWorkTreeDirectory (parentDir file)
|
||||
ifM (Annex.getState Annex.fast <||> pure (relaxedOption o))
|
||||
( do
|
||||
addWorkTree canadd addunlockedmatcher (Remote.uuid r) loguri file urlkey Nothing
|
||||
|
|
@ -202,7 +203,7 @@ downloadRemoteFile addunlockedmatcher r o uri file sz = checkCanAdd o file $ \ca
|
|||
)
|
||||
where
|
||||
loguri = setDownloader uri OtherDownloader
|
||||
af = AssociatedFile (Just (toRawFilePath file))
|
||||
af = AssociatedFile (Just file)
|
||||
|
||||
startWeb :: AddUnlockedMatcher -> AddUrlOptions -> SeekInput -> URLString -> CommandStart
|
||||
startWeb addunlockedmatcher o si urlstring = go $ fromMaybe bad $ parseURI urlstring
|
||||
|
|
@ -231,7 +232,7 @@ startWeb addunlockedmatcher o si urlstring = go $ fromMaybe bad $ parseURI urlst
|
|||
, pure f
|
||||
)
|
||||
_ -> pure $ url2file url (pathdepthOption o) pathmax
|
||||
performWeb addunlockedmatcher o urlstring file urlinfo
|
||||
performWeb addunlockedmatcher o urlstring (toRawFilePath file) urlinfo
|
||||
|
||||
sanitizeOrPreserveFilePath :: AddUrlOptions -> FilePath -> Annex FilePath
|
||||
sanitizeOrPreserveFilePath o f
|
||||
|
|
@ -257,8 +258,8 @@ checkPreserveFileNameSecurity f = do
|
|||
, "has a security problem (" ++ d ++ "), not adding."
|
||||
]
|
||||
|
||||
performWeb :: AddUnlockedMatcher -> AddUrlOptions -> URLString -> FilePath -> Url.UrlInfo -> CommandPerform
|
||||
performWeb addunlockedmatcher o url file urlinfo = ifAnnexed (toRawFilePath file) addurl geturl
|
||||
performWeb :: AddUnlockedMatcher -> AddUrlOptions -> URLString -> RawFilePath -> Url.UrlInfo -> CommandPerform
|
||||
performWeb addunlockedmatcher o url file urlinfo = ifAnnexed file addurl geturl
|
||||
where
|
||||
geturl = next $ isJust <$> addUrlFile addunlockedmatcher (downloadOptions o) url urlinfo file
|
||||
addurl = addUrlChecked o url file webUUID $ \k ->
|
||||
|
|
@ -269,11 +270,11 @@ performWeb addunlockedmatcher o url file urlinfo = ifAnnexed (toRawFilePath file
|
|||
|
||||
{- Check that the url exists, and has the same size as the key,
|
||||
- and add it as an url to the key. -}
|
||||
addUrlChecked :: AddUrlOptions -> URLString -> FilePath -> UUID -> (Key -> Annex (Bool, Bool, URLString)) -> Key -> CommandPerform
|
||||
addUrlChecked :: AddUrlOptions -> URLString -> RawFilePath -> UUID -> (Key -> Annex (Bool, Bool, URLString)) -> Key -> CommandPerform
|
||||
addUrlChecked o url file u checkexistssize key =
|
||||
ifM ((elem url <$> getUrls key) <&&> (elem u <$> loggedLocations key))
|
||||
( do
|
||||
showDestinationFile file
|
||||
showDestinationFile (fromRawFilePath file)
|
||||
next $ return True
|
||||
, do
|
||||
(exists, samesize, url') <- checkexistssize key
|
||||
|
|
@ -295,35 +296,35 @@ addUrlChecked o url file u checkexistssize key =
|
|||
- different file, based on the title of the media. Unless the user
|
||||
- specified fileOption, which then forces using the FilePath.
|
||||
-}
|
||||
addUrlFile :: AddUnlockedMatcher -> DownloadOptions -> URLString -> Url.UrlInfo -> FilePath -> Annex (Maybe Key)
|
||||
addUrlFile :: AddUnlockedMatcher -> DownloadOptions -> URLString -> Url.UrlInfo -> RawFilePath -> Annex (Maybe Key)
|
||||
addUrlFile addunlockedmatcher o url urlinfo file =
|
||||
ifM (Annex.getState Annex.fast <||> pure (relaxedOption o))
|
||||
( nodownloadWeb addunlockedmatcher o url urlinfo file
|
||||
, downloadWeb addunlockedmatcher o url urlinfo file
|
||||
)
|
||||
|
||||
downloadWeb :: AddUnlockedMatcher -> DownloadOptions -> URLString -> Url.UrlInfo -> FilePath -> Annex (Maybe Key)
|
||||
downloadWeb :: AddUnlockedMatcher -> DownloadOptions -> URLString -> Url.UrlInfo -> RawFilePath -> Annex (Maybe Key)
|
||||
downloadWeb addunlockedmatcher o url urlinfo file =
|
||||
go =<< downloadWith' downloader urlkey webUUID url (AssociatedFile (Just (toRawFilePath file)))
|
||||
go =<< downloadWith' downloader urlkey webUUID url (AssociatedFile (Just file))
|
||||
where
|
||||
urlkey = addSizeUrlKey urlinfo $ Backend.URL.fromUrl url Nothing
|
||||
downloader f p = Url.withUrlOptions $ downloadUrl urlkey p [url] f
|
||||
go Nothing = return Nothing
|
||||
go (Just tmp) = ifM (pure (not (rawOption o)) <&&> liftIO (isHtml <$> readFile tmp))
|
||||
go (Just tmp) = ifM (pure (not (rawOption o)) <&&> liftIO (isHtml <$> readFile (fromRawFilePath tmp)))
|
||||
( tryyoutubedl tmp
|
||||
, normalfinish tmp
|
||||
)
|
||||
normalfinish tmp = checkCanAdd o file $ \canadd -> do
|
||||
showDestinationFile file
|
||||
createWorkTreeDirectory (parentDir (toRawFilePath file))
|
||||
showDestinationFile (fromRawFilePath file)
|
||||
createWorkTreeDirectory (parentDir 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.
|
||||
tryyoutubedl tmp = youtubeDlFileNameHtmlOnly url >>= \case
|
||||
Right mediafile ->
|
||||
let f = youtubeDlDestFile o file mediafile
|
||||
in ifAnnexed (toRawFilePath f)
|
||||
(alreadyannexed f)
|
||||
let f = youtubeDlDestFile o file (toRawFilePath mediafile)
|
||||
in ifAnnexed f
|
||||
(alreadyannexed (fromRawFilePath f))
|
||||
(dl f)
|
||||
Left _ -> normalfinish tmp
|
||||
where
|
||||
|
|
@ -332,12 +333,12 @@ downloadWeb addunlockedmatcher o url urlinfo file =
|
|||
showNote "using youtube-dl"
|
||||
Transfer.notifyTransfer Transfer.Download url $
|
||||
Transfer.download webUUID mediakey (AssociatedFile Nothing) Transfer.noRetry $ \p ->
|
||||
youtubeDl url workdir p >>= \case
|
||||
youtubeDl url (fromRawFilePath workdir) p >>= \case
|
||||
Right (Just mediafile) -> do
|
||||
cleanuptmp
|
||||
checkCanAdd o dest $ \canadd -> do
|
||||
showDestinationFile dest
|
||||
addWorkTree canadd addunlockedmatcher webUUID mediaurl dest mediakey (Just mediafile)
|
||||
showDestinationFile (fromRawFilePath dest)
|
||||
addWorkTree canadd addunlockedmatcher webUUID mediaurl dest mediakey (Just (toRawFilePath mediafile))
|
||||
return $ Just mediakey
|
||||
Right Nothing -> normalfinish tmp
|
||||
Left msg -> do
|
||||
|
|
@ -380,24 +381,24 @@ showDestinationFile file = do
|
|||
- Downloads the url, sets up the worktree file, and returns the
|
||||
- real key.
|
||||
-}
|
||||
downloadWith :: CanAddFile -> AddUnlockedMatcher -> (FilePath -> MeterUpdate -> Annex Bool) -> Key -> UUID -> URLString -> FilePath -> Annex (Maybe Key)
|
||||
downloadWith :: CanAddFile -> AddUnlockedMatcher -> (FilePath -> MeterUpdate -> Annex Bool) -> Key -> UUID -> URLString -> RawFilePath -> Annex (Maybe Key)
|
||||
downloadWith canadd addunlockedmatcher downloader dummykey u url file =
|
||||
go =<< downloadWith' downloader dummykey u url afile
|
||||
where
|
||||
afile = AssociatedFile (Just (toRawFilePath file))
|
||||
afile = AssociatedFile (Just file)
|
||||
go Nothing = return Nothing
|
||||
go (Just tmp) = Just <$> finishDownloadWith canadd addunlockedmatcher tmp u url file
|
||||
|
||||
{- Like downloadWith, but leaves the dummy key content in
|
||||
- the returned location. -}
|
||||
downloadWith' :: (FilePath -> MeterUpdate -> Annex Bool) -> Key -> UUID -> URLString -> AssociatedFile -> Annex (Maybe FilePath)
|
||||
downloadWith' :: (FilePath -> MeterUpdate -> Annex Bool) -> Key -> UUID -> URLString -> AssociatedFile -> Annex (Maybe RawFilePath)
|
||||
downloadWith' downloader dummykey u url afile =
|
||||
checkDiskSpaceToGet dummykey Nothing $ do
|
||||
tmp <- fromRepo $ gitAnnexTmpObjectLocation dummykey
|
||||
ok <- Transfer.notifyTransfer Transfer.Download url $
|
||||
Transfer.download u dummykey afile Transfer.stdRetry $ \p -> do
|
||||
createAnnexDirectory (parentDir tmp)
|
||||
downloader tmp p
|
||||
downloader (fromRawFilePath tmp) p
|
||||
if ok
|
||||
then return (Just tmp)
|
||||
else return Nothing
|
||||
|
|
@ -406,8 +407,8 @@ finishDownloadWith :: CanAddFile -> AddUnlockedMatcher -> RawFilePath -> UUID ->
|
|||
finishDownloadWith canadd addunlockedmatcher tmp u url file = do
|
||||
backend <- chooseBackend file
|
||||
let source = KeySource
|
||||
{ keyFilename = toRawFilePath file
|
||||
, contentLocation = toRawFilePath tmp
|
||||
{ keyFilename = file
|
||||
, contentLocation = tmp
|
||||
, inodeCache = Nothing
|
||||
}
|
||||
key <- fst <$> genKey source nullMeterUpdate backend
|
||||
|
|
|
|||
|
|
@ -454,9 +454,10 @@ feedProblem url message = ifM (checkFeedBroken url)
|
|||
- least 23 hours. -}
|
||||
checkFeedBroken :: URLString -> Annex Bool
|
||||
checkFeedBroken url = checkFeedBroken' url =<< feedState url
|
||||
checkFeedBroken' :: URLString -> FilePath -> Annex Bool
|
||||
checkFeedBroken' :: URLString -> RawFilePath -> Annex Bool
|
||||
checkFeedBroken' url f = do
|
||||
prev <- maybe Nothing readish <$> liftIO (catchMaybeIO $ readFile f)
|
||||
prev <- maybe Nothing readish
|
||||
<$> liftIO (catchMaybeIO $ readFile (fromRawFlePath f))
|
||||
now <- liftIO getCurrentTime
|
||||
case prev of
|
||||
Nothing -> do
|
||||
|
|
@ -471,7 +472,9 @@ checkFeedBroken' url f = do
|
|||
return broken
|
||||
|
||||
clearFeedProblem :: URLString -> Annex ()
|
||||
clearFeedProblem url = void $ liftIO . tryIO . removeFile =<< feedState url
|
||||
clearFeedProblem url =
|
||||
void $ liftIO . tryIO . removeFile . fromRawFilePath
|
||||
=<< feedState url
|
||||
|
||||
feedState :: URLString -> Annex FilePath
|
||||
feedState :: URLString -> Annex RawFilePath
|
||||
feedState url = fromRepo $ gitAnnexFeedState $ fromUrl url Nothing
|
||||
|
|
|
|||
Loading…
Reference in a new issue