mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

more OsPath conversion (639/749)

Browse source 
Sponsored-by: k0ld
This commit is contained in:
Joey Hess 2025-02-07 16:07:05 -04:00
parent a5d48edd94
commit c74c75b352
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
28 changed files with 147 additions and 132 deletions
Download patch file Download diff file Expand all files Collapse all files

2
Annex/CheckIgnore.hs
View file

@ -22,7 +22,7 @@ import Annex.Concurrent.Utility
newtype CheckGitIgnore = CheckGitIgnore Bool newtype CheckGitIgnore = CheckGitIgnore Bool
checkIgnored :: CheckGitIgnore -> RawFilePath -> Annex Bool checkIgnored :: CheckGitIgnore -> OsPath -> Annex Bool
checkIgnored (CheckGitIgnore False) _ = pure False checkIgnored (CheckGitIgnore False) _ = pure False
checkIgnored (CheckGitIgnore True) file = checkIgnored (CheckGitIgnore True) file =
ifM (Annex.getRead Annex.force) ifM (Annex.getRead Annex.force)

12
CmdLine.hs
View file

@ -5,6 +5,8 @@
- Licensed under the GNU AGPL version 3 or higher. - Licensed under the GNU AGPL version 3 or higher.
-} -}
{-# LANGUAGE OverloadedStrings #-}
module CmdLine ( module CmdLine (
dispatch, dispatch,
usage, usage,
@ -29,6 +31,7 @@ import Annex.Action
import Annex.Environment import Annex.Environment
import Command import Command
import Types.Messages import Types.Messages
import qualified Utility.OsString as OS
{- Parses input arguments, finds a matching Command, and runs it. -} {- Parses input arguments, finds a matching Command, and runs it. -}
dispatch :: Bool -> Bool -> CmdParams -> [Command] -> [(String, String)] -> IO Git.Repo -> String -> String -> IO () dispatch :: Bool -> Bool -> CmdParams -> [Command] -> [(String, String)] -> IO Git.Repo -> String -> String -> IO ()
@ -159,17 +162,18 @@ findAddonCommand Nothing = return Nothing
findAddonCommand (Just subcommandname) = findAddonCommand (Just subcommandname) =
searchPath c >>= \case searchPath c >>= \case
Nothing -> return Nothing Nothing -> return Nothing
Just p -> return (Just (mkAddonCommand p subcommandname)) Just p -> return (Just (mkAddonCommand (fromOsPath p) subcommandname))
where where
c = "git-annex-" ++ subcommandname c = "git-annex-" ++ subcommandname
findAllAddonCommands :: IO [Command] findAllAddonCommands :: IO [Command]
findAllAddonCommands = findAllAddonCommands =
filter isaddoncommand filter isaddoncommand
. map (\p -> mkAddonCommand p (deprefix p)) . map go
<$> searchPathContents ("git-annex-" `isPrefixOf`) <$> searchPathContents (literalOsPath "git-annex-" `OS.isPrefixOf`)
where where
deprefix = replace "git-annex-" "" . takeFileName go p = mkAddonCommand (fromOsPath p) (deprefix p)
deprefix = replace "git-annex-" "" . fromOsPath . takeFileName
isaddoncommand c isaddoncommand c
-- git-annex-shell -- git-annex-shell
| cmdname c == "shell" = False | cmdname c == "shell" = False

36
Command/Add.hs
View file

@ -31,7 +31,6 @@ import Utility.InodeCache
import Annex.InodeSentinal import Annex.InodeSentinal
import Annex.CheckIgnore import Annex.CheckIgnore
import qualified Utility.RawFilePath as R import qualified Utility.RawFilePath as R
import qualified System.FilePath.ByteString as P
import System.PosixCompat.Files (fileSize, isSymbolicLink, isRegularFile, modificationTime, fileID, deviceID, fileMode, ownerExecuteMode, intersectFileModes) import System.PosixCompat.Files (fileSize, isSymbolicLink, isRegularFile, modificationTime, fileID, deviceID, fileMode, ownerExecuteMode, intersectFileModes)
@ -140,23 +139,23 @@ seek' o = do
dr = dryRunOption o dr = dryRunOption o
{- Pass file off to git-add. -} {- Pass file off to git-add. -}
startSmall :: Bool -> DryRun -> SeekInput -> RawFilePath -> CommandStart startSmall :: Bool -> DryRun -> SeekInput -> OsPath -> CommandStart
startSmall isdotfile dr si file = startSmall isdotfile dr si file =
liftIO (catchMaybeIO $ R.getSymbolicLinkStatus file) >>= \case liftIO (catchMaybeIO $ R.getSymbolicLinkStatus $ fromOsPath file) >>= \case
Just s -> Just s ->
starting "add" (ActionItemTreeFile file) si $ starting "add" (ActionItemTreeFile file) si $
addSmall isdotfile dr file s addSmall isdotfile dr file s
Nothing -> stop Nothing -> stop
addSmall :: Bool -> DryRun -> RawFilePath -> FileStatus -> CommandPerform addSmall :: Bool -> DryRun -> OsPath -> FileStatus -> CommandPerform
addSmall isdotfile dr file s = do addSmall isdotfile dr file s = do
showNote $ (if isdotfile then "dotfile" else "non-large file") showNote $ (if isdotfile then "dotfile" else "non-large file")
<> "; adding content to git repository" <> "; adding content to git repository"
skipWhenDryRun dr $ next $ addFile Small file s skipWhenDryRun dr $ next $ addFile Small file s
startSmallOverridden :: DryRun -> SeekInput -> RawFilePath -> CommandStart startSmallOverridden :: DryRun -> SeekInput -> OsPath -> CommandStart
startSmallOverridden dr si file = startSmallOverridden dr si file =
liftIO (catchMaybeIO $ R.getSymbolicLinkStatus file) >>= \case liftIO (catchMaybeIO $ R.getSymbolicLinkStatus $ fromOsPath file) >>= \case
Just s -> starting "add" (ActionItemTreeFile file) si $ do Just s -> starting "add" (ActionItemTreeFile file) si $ do
showNote "adding content to git repository" showNote "adding content to git repository"
skipWhenDryRun dr $ next $ addFile Small file s skipWhenDryRun dr $ next $ addFile Small file s
@ -164,22 +163,23 @@ startSmallOverridden dr si file =
data SmallOrLarge = Small | Large data SmallOrLarge = Small | Large
addFile :: SmallOrLarge -> RawFilePath -> FileStatus -> Annex Bool addFile :: SmallOrLarge -> OsPath -> FileStatus -> Annex Bool
addFile smallorlarge file s = do addFile smallorlarge file s = do
let file' = fromOsPath file
sha <- if isSymbolicLink s sha <- if isSymbolicLink s
then hashBlob =<< liftIO (R.readSymbolicLink file) then hashBlob =<< liftIO (R.readSymbolicLink file')
else if isRegularFile s else if isRegularFile s
then hashFile file then hashFile file
else do else do
qp <- coreQuotePath <$> Annex.getGitConfig qp <- coreQuotePath <$> Annex.getGitConfig
giveup $ decodeBS $ quote qp $ giveup $ decodeBS $ quote qp file
file <> " is not a regular file" <> " is not a regular file"
let treetype = if isSymbolicLink s let treetype = if isSymbolicLink s
then TreeSymlink then TreeSymlink
else if intersectFileModes ownerExecuteMode (fileMode s) /= 0 else if intersectFileModes ownerExecuteMode (fileMode s) /= 0
then TreeExecutable then TreeExecutable
else TreeFile else TreeFile
s' <- liftIO $ catchMaybeIO $ R.getSymbolicLinkStatus file s' <- liftIO $ catchMaybeIO $ R.getSymbolicLinkStatus file'
if maybe True (changed s) s' if maybe True (changed s) s'
then do then do
warning $ QuotedPath file <> " changed while it was being added" warning $ QuotedPath file <> " changed while it was being added"
@ -206,9 +206,9 @@ addFile smallorlarge file s = do
isRegularFile a /= isRegularFile b || isRegularFile a /= isRegularFile b ||
isSymbolicLink a /= isSymbolicLink b isSymbolicLink a /= isSymbolicLink b
start :: DryRun -> SeekInput -> RawFilePath -> AddUnlockedMatcher -> CommandStart start :: DryRun -> SeekInput -> OsPath -> AddUnlockedMatcher -> CommandStart
start dr si file addunlockedmatcher = start dr si file addunlockedmatcher =
liftIO (catchMaybeIO $ R.getSymbolicLinkStatus file) >>= \case liftIO (catchMaybeIO $ R.getSymbolicLinkStatus $ fromOsPath file) >>= \case
Nothing -> stop Nothing -> stop
Just s Just s
| not (isRegularFile s) && not (isSymbolicLink s) -> stop | not (isRegularFile s) && not (isSymbolicLink s) -> stop
@ -231,11 +231,11 @@ start dr si file addunlockedmatcher =
starting "add" (ActionItemTreeFile file) si $ starting "add" (ActionItemTreeFile file) si $
addingExistingLink file key $ addingExistingLink file key $
skipWhenDryRun dr $ withOtherTmp $ \tmp -> do skipWhenDryRun dr $ withOtherTmp $ \tmp -> do
let tmpf = tmp P.</> P.takeFileName file let tmpf = tmp </> takeFileName file
liftIO $ moveFile file tmpf liftIO $ moveFile file tmpf
ifM (isSymbolicLink <$> liftIO (R.getSymbolicLinkStatus tmpf)) ifM (isSymbolicLink <$> liftIO (R.getSymbolicLinkStatus $ fromOsPath tmpf))
( do ( do
liftIO $ R.removeLink tmpf liftIO $ removeFile tmpf
addSymlink file key Nothing addSymlink file key Nothing
next $ cleanup key =<< inAnnex key next $ cleanup key =<< inAnnex key
, do , do
@ -249,7 +249,7 @@ start dr si file addunlockedmatcher =
Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath file) Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath file)
next $ addFile Large file s next $ addFile Large file s
perform :: RawFilePath -> AddUnlockedMatcher -> CommandPerform perform :: OsPath -> AddUnlockedMatcher -> CommandPerform
perform file addunlockedmatcher = withOtherTmp $ \tmpdir -> do perform file addunlockedmatcher = withOtherTmp $ \tmpdir -> do
lockingfile <- not <$> addUnlocked addunlockedmatcher lockingfile <- not <$> addUnlocked addunlockedmatcher
(MatchingFile (FileInfo file file Nothing)) (MatchingFile (FileInfo file file Nothing))
@ -259,7 +259,7 @@ perform file addunlockedmatcher = withOtherTmp $ \tmpdir -> do
, hardlinkFileTmpDir = Just tmpdir , hardlinkFileTmpDir = Just tmpdir
, checkWritePerms = True , checkWritePerms = True
} }
ld <- lockDown cfg (fromRawFilePath file) ld <- lockDown cfg file
let sizer = keySource <$> ld let sizer = keySource <$> ld
v <- metered Nothing sizer Nothing $ \_meter meterupdate -> v <- metered Nothing sizer Nothing $ \_meter meterupdate ->
ingestAdd meterupdate ld ingestAdd meterupdate ld

2
Command/AddUnused.hs
View file

@ -27,7 +27,7 @@ start :: UnusedMaps -> Int -> CommandStart
start = startUnused go (other "bad") (other "tmp") start = startUnused go (other "bad") (other "tmp")
where where
go n key = do go n key = do
let file = "unused." <> keyFile key let file = literalOsPath "unused." <> keyFile key
starting "addunused" starting "addunused"
(ActionItemTreeFile file) (ActionItemTreeFile file)
(SeekInput [show n]) $ (SeekInput [show n]) $

70
Command/AddUrl.hs
View file

@ -177,14 +177,14 @@ checkUrl addunlockedmatcher r o si u = do
warning (UnquotedString (show e)) warning (UnquotedString (show e))
next $ return False next $ return False
go deffile (Right (UrlContents sz mf)) = do go deffile (Right (UrlContents sz mf)) = do
f <- maybe (pure deffile) (sanitizeOrPreserveFilePath o) mf f <- maybe (pure deffile) (sanitizeOrPreserveFilePath o . fromOsPath) mf
let f' = adjustFile o (fromMaybe f (fileOption (downloadOptions o))) let f' = adjustFile o (fromMaybe f (fileOption (downloadOptions o)))
void $ commandAction $ startRemote addunlockedmatcher r o si f' u sz void $ commandAction $ startRemote addunlockedmatcher r o si f' u sz
go deffile (Right (UrlMulti l)) = case fileOption (downloadOptions o) of go deffile (Right (UrlMulti l)) = case fileOption (downloadOptions o) of
Nothing -> Nothing ->
forM_ l $ \(u', sz, f) -> do forM_ l $ \(u', sz, f) -> do
f' <- sanitizeOrPreserveFilePath o f f' <- sanitizeOrPreserveFilePath o (fromOsPath f)
let f'' = adjustFile o (deffile </> f') let f'' = adjustFile o (fromOsPath (toOsPath deffile </> toOsPath f'))
void $ commandAction $ startRemote addunlockedmatcher r o si f'' u' sz void $ commandAction $ startRemote addunlockedmatcher r o si f'' u' sz
Just f -> case l of Just f -> case l of
[] -> noop [] -> noop
@ -200,14 +200,14 @@ checkUrl addunlockedmatcher r o si u = do
startRemote :: AddUnlockedMatcher -> Remote -> AddUrlOptions -> SeekInput -> FilePath -> URLString -> Maybe Integer -> CommandStart startRemote :: AddUnlockedMatcher -> Remote -> AddUrlOptions -> SeekInput -> FilePath -> URLString -> Maybe Integer -> CommandStart
startRemote addunlockedmatcher r o si file uri sz = do startRemote addunlockedmatcher r o si file uri sz = do
pathmax <- liftIO $ fileNameLengthLimit "." pathmax <- liftIO $ fileNameLengthLimit "."
let file' = P.joinPath $ map (truncateFilePath pathmax) $ let file' = toOsPath $ P.joinPath $ map (truncateFilePath pathmax) $
P.splitDirectories (toRawFilePath file) P.splitDirectories (toRawFilePath file)
startingAddUrl si uri o $ do startingAddUrl si uri o $ do
showNote $ UnquotedString $ "from " ++ Remote.name r showNote $ UnquotedString $ "from " ++ Remote.name r
showDestinationFile file' showDestinationFile file'
performRemote addunlockedmatcher r o uri file' sz performRemote addunlockedmatcher r o uri file' sz
performRemote :: AddUnlockedMatcher -> Remote -> AddUrlOptions -> URLString -> RawFilePath -> Maybe Integer -> CommandPerform performRemote :: AddUnlockedMatcher -> Remote -> AddUrlOptions -> URLString -> OsPath -> Maybe Integer -> CommandPerform
performRemote addunlockedmatcher r o uri file sz = lookupKey file >>= \case performRemote addunlockedmatcher r o uri file sz = lookupKey file >>= \case
Just k -> adduri k Just k -> adduri k
Nothing -> geturi Nothing -> geturi
@ -219,7 +219,7 @@ performRemote addunlockedmatcher r o uri file sz = lookupKey file >>= \case
Just n -> (True, n == fromMaybe n (fromKey keySize key), loguri) Just n -> (True, n == fromMaybe n (fromKey keySize key), loguri)
geturi = next $ isJust <$> downloadRemoteFile addunlockedmatcher r (downloadOptions o) uri file sz geturi = next $ isJust <$> downloadRemoteFile addunlockedmatcher r (downloadOptions o) uri file sz
downloadRemoteFile :: AddUnlockedMatcher -> Remote -> DownloadOptions -> URLString -> RawFilePath -> Maybe Integer -> Annex (Maybe Key) downloadRemoteFile :: AddUnlockedMatcher -> Remote -> DownloadOptions -> URLString -> OsPath -> Maybe Integer -> Annex (Maybe Key)
downloadRemoteFile addunlockedmatcher r o uri file sz = checkCanAdd o file $ \canadd -> do downloadRemoteFile addunlockedmatcher r o uri file sz = checkCanAdd o file $ \canadd -> do
let urlkey = Backend.URL.fromUrl uri sz (verifiableOption o) let urlkey = Backend.URL.fromUrl uri sz (verifiableOption o)
createWorkTreeDirectory (parentDir file) createWorkTreeDirectory (parentDir file)
@ -265,12 +265,12 @@ startWeb addunlockedmatcher o si urlstring = go $ fromMaybe bad $ parseURIPortab
f <- sanitizeOrPreserveFilePath o sf f <- sanitizeOrPreserveFilePath o sf
if preserveFilenameOption (downloadOptions o) if preserveFilenameOption (downloadOptions o)
then pure f then pure f
else ifM (liftIO $ doesFileExist f <||> doesDirectoryExist f) else ifM (liftIO $ doesFileExist (toOsPath f) <||> doesDirectoryExist (toOsPath f))
( pure $ url2file url (pathdepthOption o) pathmax ( pure $ url2file url (pathdepthOption o) pathmax
, pure f , pure f
) )
_ -> pure $ url2file url (pathdepthOption o) pathmax _ -> pure $ url2file url (pathdepthOption o) pathmax
performWeb addunlockedmatcher o urlstring (toRawFilePath file) urlinfo performWeb addunlockedmatcher o urlstring (toOsPath file) urlinfo
sanitizeOrPreserveFilePath :: AddUrlOptions -> FilePath -> Annex FilePath sanitizeOrPreserveFilePath :: AddUrlOptions -> FilePath -> Annex FilePath
sanitizeOrPreserveFilePath o f sanitizeOrPreserveFilePath o f
@ -294,12 +294,12 @@ checkPreserveFileNameSecurity f = do
qp <- coreQuotePath <$> Annex.getGitConfig qp <- coreQuotePath <$> Annex.getGitConfig
giveup $ decodeBS $ quote qp $ giveup $ decodeBS $ quote qp $
"--preserve-filename was used, but the filename (" "--preserve-filename was used, but the filename ("
<> QuotedPath (toRawFilePath f) <> QuotedPath (toOsPath f)
<> ") has a security problem (" <> ") has a security problem ("
<> d <> d
<> "), not adding." <> "), not adding."
performWeb :: AddUnlockedMatcher -> AddUrlOptions -> URLString -> RawFilePath -> Url.UrlInfo -> CommandPerform performWeb :: AddUnlockedMatcher -> AddUrlOptions -> URLString -> OsPath -> Url.UrlInfo -> CommandPerform
performWeb addunlockedmatcher o url file urlinfo = lookupKey file >>= \case performWeb addunlockedmatcher o url file urlinfo = lookupKey file >>= \case
Just k -> addurl k Just k -> addurl k
Nothing -> geturl Nothing -> geturl
@ -314,7 +314,7 @@ performWeb addunlockedmatcher o url file urlinfo = lookupKey file >>= \case
{- Check that the url exists, and has the same size as the key, {- Check that the url exists, and has the same size as the key,
- and add it as an url to the key. -} - and add it as an url to the key. -}
addUrlChecked :: AddUrlOptions -> URLString -> RawFilePath -> UUID -> (Key -> Annex (Maybe (Bool, Bool, URLString))) -> Key -> CommandPerform addUrlChecked :: AddUrlOptions -> URLString -> OsPath -> UUID -> (Key -> Annex (Maybe (Bool, Bool, URLString))) -> Key -> CommandPerform
addUrlChecked o url file u checkexistssize key = addUrlChecked o url file u checkexistssize key =
ifM ((elem url <$> getUrls key) <&&> (elem u <$> loggedLocations key)) ifM ((elem url <$> getUrls key) <&&> (elem u <$> loggedLocations key))
( do ( do
@ -340,14 +340,14 @@ addUrlChecked o url file u checkexistssize key =
- different file, based on the title of the media. Unless the user - different file, based on the title of the media. Unless the user
- specified fileOption, which then forces using the FilePath. - specified fileOption, which then forces using the FilePath.
-} -}
addUrlFile :: AddUnlockedMatcher -> DownloadOptions -> URLString -> Url.UrlInfo -> RawFilePath -> Annex (Maybe Key) addUrlFile :: AddUnlockedMatcher -> DownloadOptions -> URLString -> Url.UrlInfo -> OsPath -> Annex (Maybe Key)
addUrlFile addunlockedmatcher o url urlinfo file = addUrlFile addunlockedmatcher o url urlinfo file =
ifM (Annex.getRead Annex.fast <||> pure (relaxedOption o)) ifM (Annex.getRead Annex.fast <||> pure (relaxedOption o))
( nodownloadWeb addunlockedmatcher o url urlinfo file ( nodownloadWeb addunlockedmatcher o url urlinfo file
, downloadWeb addunlockedmatcher o url urlinfo file , downloadWeb addunlockedmatcher o url urlinfo file
) )
downloadWeb :: AddUnlockedMatcher -> DownloadOptions -> URLString -> Url.UrlInfo -> RawFilePath -> Annex (Maybe Key) downloadWeb :: AddUnlockedMatcher -> DownloadOptions -> URLString -> Url.UrlInfo -> OsPath -> Annex (Maybe Key)
downloadWeb addunlockedmatcher o url urlinfo file = downloadWeb addunlockedmatcher o url urlinfo file =
go =<< downloadWith' downloader urlkey webUUID url file go =<< downloadWith' downloader urlkey webUUID url file
where where
@ -366,25 +366,25 @@ downloadWeb addunlockedmatcher o url urlinfo file =
-- so it's only used when the file contains embedded media. -- so it's only used when the file contains embedded media.
tryyoutubedl tmp backend = youtubeDlFileNameHtmlOnly url >>= \case tryyoutubedl tmp backend = youtubeDlFileNameHtmlOnly url >>= \case
Right mediafile -> do Right mediafile -> do
liftIO $ liftIO $ removeWhenExistsWith R.removeLink tmp liftIO $ liftIO $ removeWhenExistsWith removeFile tmp
let f = youtubeDlDestFile o file (toRawFilePath mediafile) let f = youtubeDlDestFile o file mediafile
lookupKey f >>= \case lookupKey f >>= \case
Just k -> alreadyannexed f k Just k -> alreadyannexed f k
Nothing -> dl f Nothing -> dl f
Left err -> checkRaw (Just err) o (pure Nothing) (normalfinish tmp backend) Left err -> checkRaw (Just err) o (pure Nothing) (normalfinish tmp backend)
where where
dl dest = withTmpWorkDir mediakey $ \workdir -> do dl dest = withTmpWorkDir mediakey $ \workdir -> do
let cleanuptmp = pruneTmpWorkDirBefore tmp (liftIO . removeWhenExistsWith R.removeLink) let cleanuptmp = pruneTmpWorkDirBefore tmp (liftIO . removeWhenExistsWith removeFile)
dlcmd <- youtubeDlCommand dlcmd <- youtubeDlCommand
showNote ("using " <> UnquotedString dlcmd) showNote ("using " <> UnquotedString dlcmd)
Transfer.notifyTransfer Transfer.Download url $ Transfer.notifyTransfer Transfer.Download url $
Transfer.download' webUUID mediakey (AssociatedFile Nothing) Nothing Transfer.noRetry $ \p -> do Transfer.download' webUUID mediakey (AssociatedFile Nothing) Nothing Transfer.noRetry $ \p -> do
showDestinationFile dest showDestinationFile dest
youtubeDl url (fromRawFilePath workdir) p >>= \case youtubeDl url workdir p >>= \case
Right (Just mediafile) -> do Right (Just mediafile) -> do
cleanuptmp cleanuptmp
checkCanAdd o dest $ \canadd -> do checkCanAdd o dest $ \canadd -> do
addWorkTree canadd addunlockedmatcher webUUID mediaurl dest mediakey (Just (toRawFilePath mediafile)) addWorkTree canadd addunlockedmatcher webUUID mediaurl dest mediakey (Just mediafile)
return $ Just mediakey return $ Just mediakey
Left msg -> do Left msg -> do
cleanuptmp cleanuptmp
@ -445,10 +445,10 @@ startingAddUrl si url o p = starting "addurl" ai si $ do
ai = OnlyActionOn urlkey (ActionItemOther (Just (UnquotedString url))) ai = OnlyActionOn urlkey (ActionItemOther (Just (UnquotedString url)))
urlkey = Backend.URL.fromUrl url Nothing (verifiableOption (downloadOptions o)) urlkey = Backend.URL.fromUrl url Nothing (verifiableOption (downloadOptions o))
showDestinationFile :: RawFilePath -> Annex () showDestinationFile :: OsPath -> Annex ()
showDestinationFile file = do showDestinationFile file = do
showNote ("to " <> QuotedPath file) showNote ("to " <> QuotedPath file)
maybeShowJSON $ JSONChunk [("file", fromRawFilePath file)] maybeShowJSON $ JSONChunk [("file", file)]
{- The Key should be a dummy key, based on the URL, which is used {- The Key should be a dummy key, based on the URL, which is used
- for this download, before we can examine the file and find its real key. - for this download, before we can examine the file and find its real key.
@ -459,7 +459,7 @@ showDestinationFile file = do
- Downloads the url, sets up the worktree file, and returns the - Downloads the url, sets up the worktree file, and returns the
- real key. - real key.
-} -}
downloadWith :: CanAddFile -> AddUnlockedMatcher -> (FilePath -> MeterUpdate -> Annex Bool) -> Key -> UUID -> URLString -> RawFilePath -> Annex (Maybe Key) downloadWith :: CanAddFile -> AddUnlockedMatcher -> (OsPath -> MeterUpdate -> Annex Bool) -> Key -> UUID -> URLString -> OsPath -> Annex (Maybe Key)
downloadWith canadd addunlockedmatcher downloader dummykey u url file = downloadWith canadd addunlockedmatcher downloader dummykey u url file =
go =<< downloadWith' downloader dummykey u url file go =<< downloadWith' downloader dummykey u url file
where where
@ -468,7 +468,7 @@ downloadWith canadd addunlockedmatcher downloader dummykey u url file =
{- Like downloadWith, but leaves the dummy key content in {- Like downloadWith, but leaves the dummy key content in
- the returned location. -} - the returned location. -}
downloadWith' :: (FilePath -> MeterUpdate -> Annex Bool) -> Key -> UUID -> URLString -> RawFilePath -> Annex (Maybe (RawFilePath, Backend)) downloadWith' :: (OsPath -> MeterUpdate -> Annex Bool) -> Key -> UUID -> URLString -> OsPath -> Annex (Maybe (OsPath, Backend))
downloadWith' downloader dummykey u url file = downloadWith' downloader dummykey u url file =
checkDiskSpaceToGet dummykey Nothing Nothing $ do checkDiskSpaceToGet dummykey Nothing Nothing $ do
backend <- chooseBackend file backend <- chooseBackend file
@ -477,14 +477,14 @@ downloadWith' downloader dummykey u url file =
ok <- Transfer.notifyTransfer Transfer.Download url $ \_w -> ok <- Transfer.notifyTransfer Transfer.Download url $ \_w ->
Transfer.runTransfer t (Just backend) afile Nothing Transfer.stdRetry $ \p -> do Transfer.runTransfer t (Just backend) afile Nothing Transfer.stdRetry $ \p -> do
createAnnexDirectory (parentDir tmp) createAnnexDirectory (parentDir tmp)
downloader (fromRawFilePath tmp) p downloader tmp p
if ok if ok
then return (Just (tmp, backend)) then return (Just (tmp, backend))
else return Nothing else return Nothing
where where
afile = AssociatedFile (Just file) afile = AssociatedFile (Just file)
finishDownloadWith :: CanAddFile -> AddUnlockedMatcher -> RawFilePath -> Backend -> UUID -> URLString -> RawFilePath -> Annex Key finishDownloadWith :: CanAddFile -> AddUnlockedMatcher -> OsPath -> Backend -> UUID -> URLString -> OsPath -> Annex Key
finishDownloadWith canadd addunlockedmatcher tmp backend u url file = do finishDownloadWith canadd addunlockedmatcher tmp backend u url file = do
let source = KeySource let source = KeySource
{ keyFilename = file { keyFilename = file
@ -502,14 +502,14 @@ addSizeUrlKey urlinfo key = alterKey key $ \d -> d
} }
{- Adds worktree file to the repository. -} {- Adds worktree file to the repository. -}
addWorkTree :: CanAddFile -> AddUnlockedMatcher -> UUID -> URLString -> RawFilePath -> Key -> Maybe RawFilePath -> Annex () addWorkTree :: CanAddFile -> AddUnlockedMatcher -> UUID -> URLString -> OsPath -> Key -> Maybe OsPath -> Annex ()
addWorkTree _ addunlockedmatcher u url file key mtmp = case mtmp of addWorkTree _ addunlockedmatcher u url file key mtmp = case mtmp of
Nothing -> go Nothing -> go
Just tmp -> do Just tmp -> do
s <- liftIO $ R.getSymbolicLinkStatus tmp s <- liftIO $ R.getSymbolicLinkStatus (fromOsPath tmp)
-- Move to final location for large file check. -- Move to final location for large file check.
pruneTmpWorkDirBefore tmp $ \_ -> do pruneTmpWorkDirBefore tmp $ \_ -> do
createWorkTreeDirectory (P.takeDirectory file) createWorkTreeDirectory (takeDirectory file)
liftIO $ moveFile tmp file liftIO $ moveFile tmp file
largematcher <- largeFilesMatcher largematcher <- largeFilesMatcher
large <- checkFileMatcher NoLiveUpdate largematcher file large <- checkFileMatcher NoLiveUpdate largematcher file
@ -531,15 +531,15 @@ addWorkTree _ addunlockedmatcher u url file key mtmp = case mtmp of
( do ( do
when (isJust mtmp) $ when (isJust mtmp) $
logStatus NoLiveUpdate key InfoPresent logStatus NoLiveUpdate key InfoPresent
, maybe noop (\tmp -> pruneTmpWorkDirBefore tmp (liftIO . removeWhenExistsWith R.removeLink)) mtmp , maybe noop (\tmp -> pruneTmpWorkDirBefore tmp (liftIO . removeWhenExistsWith removeFile)) mtmp
) )
nodownloadWeb :: AddUnlockedMatcher -> DownloadOptions -> URLString -> Url.UrlInfo -> RawFilePath -> Annex (Maybe Key) nodownloadWeb :: AddUnlockedMatcher -> DownloadOptions -> URLString -> Url.UrlInfo -> OsPath -> Annex (Maybe Key)
nodownloadWeb addunlockedmatcher o url urlinfo file nodownloadWeb addunlockedmatcher o url urlinfo file
| Url.urlExists urlinfo = if rawOption o | Url.urlExists urlinfo = if rawOption o
then nomedia then nomedia
else youtubeDlFileName url >>= \case else youtubeDlFileName url >>= \case
Right mediafile -> usemedia (toRawFilePath mediafile) Right mediafile -> usemedia mediafile
Left err -> checkRaw (Just err) o (pure Nothing) nomedia Left err -> checkRaw (Just err) o (pure Nothing) nomedia
| otherwise = do | otherwise = do
warning $ UnquotedString $ "unable to access url: " ++ url warning $ UnquotedString $ "unable to access url: " ++ url
@ -554,12 +554,12 @@ nodownloadWeb addunlockedmatcher o url urlinfo file
let mediakey = Backend.URL.fromUrl mediaurl Nothing (verifiableOption o) let mediakey = Backend.URL.fromUrl mediaurl Nothing (verifiableOption o)
nodownloadWeb' o addunlockedmatcher mediaurl mediakey dest nodownloadWeb' o addunlockedmatcher mediaurl mediakey dest
youtubeDlDestFile :: DownloadOptions -> RawFilePath -> RawFilePath -> RawFilePath youtubeDlDestFile :: DownloadOptions -> OsPath -> OsPath -> OsPath
youtubeDlDestFile o destfile mediafile youtubeDlDestFile o destfile mediafile
| isJust (fileOption o) = destfile | isJust (fileOption o) = destfile
| otherwise = P.takeFileName mediafile | otherwise = takeFileName mediafile
nodownloadWeb' :: DownloadOptions -> AddUnlockedMatcher -> URLString -> Key -> RawFilePath -> Annex (Maybe Key) nodownloadWeb' :: DownloadOptions -> AddUnlockedMatcher -> URLString -> Key -> OsPath -> Annex (Maybe Key)
nodownloadWeb' o addunlockedmatcher url key file = checkCanAdd o file $ \canadd -> do nodownloadWeb' o addunlockedmatcher url key file = checkCanAdd o file $ \canadd -> do
showDestinationFile file showDestinationFile file
createWorkTreeDirectory (parentDir file) createWorkTreeDirectory (parentDir file)
@ -601,8 +601,8 @@ adjustFile o = addprefix . addsuffix
data CanAddFile = CanAddFile data CanAddFile = CanAddFile
checkCanAdd :: DownloadOptions -> RawFilePath -> (CanAddFile -> Annex (Maybe a)) -> Annex (Maybe a) checkCanAdd :: DownloadOptions -> OsPath -> (CanAddFile -> Annex (Maybe a)) -> Annex (Maybe a)
checkCanAdd o file a = ifM (isJust <$> (liftIO $ catchMaybeIO $ R.getSymbolicLinkStatus file)) checkCanAdd o file a = ifM (isJust <$> (liftIO $ catchMaybeIO $ R.getSymbolicLinkStatus (fromOsPath file)))
( do ( do
warning $ QuotedPath file <> " already exists; not overwriting" warning $ QuotedPath file <> " already exists; not overwriting"
return Nothing return Nothing

2
Command/CalcKey.hs
View file

@ -32,4 +32,4 @@ run _ _ file = tryNonAsync (genKey ks nullMeterUpdate =<< defaultBackend) >>= \c
Left _err -> return False Left _err -> return False
where where
ks = KeySource file' file' Nothing ks = KeySource file' file' Nothing
file' = toRawFilePath file file' = toOsPath file

2
Command/Config.hs
View file

@ -152,7 +152,7 @@ seek (ShowOrigin ck@(ConfigKey name) forfile) = commandAction $
| decodeBS name `elem` annexAttrs = | decodeBS name `elem` annexAttrs =
case forfile of case forfile of
Just file -> do Just file -> do
v <- checkAttr (decodeBS name) (toRawFilePath file) v <- checkAttr (decodeBS name) (toOsPath file)
if null v if null v
then cont then cont
else showval "gitattributes" v else showval "gitattributes" v

8
Command/ContentLocation.hs
View file

@ -9,7 +9,6 @@ module Command.ContentLocation where
import Command import Command
import Annex.Content import Annex.Content
import qualified Utility.RawFilePath as R
import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Char8 as B8
@ -23,10 +22,13 @@ cmd = noCommit $ noMessages $
run :: () -> SeekInput -> String -> Annex Bool run :: () -> SeekInput -> String -> Annex Bool
run _ _ p = do run _ _ p = do
let k = fromMaybe (giveup "bad key") $ deserializeKey p let k = fromMaybe (giveup "bad key") $ deserializeKey p
maybe (return False) (\f -> liftIO (B8.putStrLn f) >> return True) maybe (return False) emit
=<< inAnnex' (pure True) Nothing check k =<< inAnnex' (pure True) Nothing check k
where where
check f = ifM (liftIO (R.doesPathExist f)) check f = ifM (liftIO (doesFileExist f))
( return (Just f) ( return (Just f)
, return Nothing , return Nothing
) )
emit f = liftIO $ do
B8.putStrLn $ fromOsPath f
return True

4
Command/Copy.hs
View file

@ -77,7 +77,7 @@ seek' o fto = startConcurrency (Command.Move.stages fto) $ do
{- A copy is just a move that does not delete the source file. {- A copy is just a move that does not delete the source file.
- However, auto mode avoids unnecessary copies, and avoids getting or - However, auto mode avoids unnecessary copies, and avoids getting or
- sending non-preferred content. -} - sending non-preferred content. -}
start :: CopyOptions -> FromToHereOptions -> SeekInput -> RawFilePath -> Key -> CommandStart start :: CopyOptions -> FromToHereOptions -> SeekInput -> OsPath -> Key -> CommandStart
start o fto si file key = do start o fto si file key = do
ru <- case fto of ru <- case fto of
FromOrToRemote (ToRemote dest) -> getru dest FromOrToRemote (ToRemote dest) -> getru dest
@ -90,7 +90,7 @@ start o fto si file key = do
where where
getru dest = Just . Remote.uuid <$> getParsed dest getru dest = Just . Remote.uuid <$> getParsed dest
start' :: LiveUpdate -> CopyOptions -> FromToHereOptions -> SeekInput -> RawFilePath -> Key -> CommandStart start' :: LiveUpdate -> CopyOptions -> FromToHereOptions -> SeekInput -> OsPath -> Key -> CommandStart
start' lu o fto si file key = stopUnless shouldCopy $ start' lu o fto si file key = stopUnless shouldCopy $
Command.Move.start lu fto Command.Move.RemoveNever si file key Command.Move.start lu fto Command.Move.RemoveNever si file key
where where

4
Command/DiffDriver.hs
View file

@ -119,7 +119,7 @@ fixupReq req@(Req {}) opts =
maybe (return r) go (parseLinkTargetOrPointer =<< v) maybe (return r) go (parseLinkTargetOrPointer =<< v)
_ -> maybe (return r) go =<< liftIO (isPointerFile f) _ -> maybe (return r) go =<< liftIO (isPointerFile f)
where where
f = toRawFilePath (getfile r) f = toOsPath (getfile r)
go k = do go k = do
when (getOption opts) $ when (getOption opts) $
unlessM (inAnnex k) $ unlessM (inAnnex k) $
@ -132,7 +132,7 @@ fixupReq req@(Req {}) opts =
si = SeekInput [] si = SeekInput []
af = AssociatedFile (Just f) af = AssociatedFile (Just f)
repoint k = withObjectLoc k $ repoint k = withObjectLoc k $
pure . setfile r . fromRawFilePath pure . setfile r . fromOsPath
externalDiffer :: String -> [String] -> Differ externalDiffer :: String -> [String] -> Differ
externalDiffer c ps = \req -> boolSystem c (map Param ps ++ serializeReq req ) externalDiffer c ps = \req -> boolSystem c (map Param ps ++ serializeReq req )

2
Command/Drop.hs
View file

@ -76,7 +76,7 @@ seek o = startConcurrency commandStages $ do
where where
ww = WarnUnmatchLsFiles "drop" ww = WarnUnmatchLsFiles "drop"
start :: DropOptions -> Maybe Remote -> SeekInput -> RawFilePath -> Key -> CommandStart start :: DropOptions -> Maybe Remote -> SeekInput -> OsPath -> Key -> CommandStart
start o from si file key = start' o from key afile ai si start o from si file key = start' o from key afile ai si
where where
afile = AssociatedFile (Just file) afile = AssociatedFile (Just file)

5
Command/DropUnused.hs
View file

@ -17,7 +17,6 @@ import qualified Git
import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused) import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused)
import Annex.NumCopies import Annex.NumCopies
import Annex.Content import Annex.Content
import qualified Utility.RawFilePath as R
cmd :: Command cmd :: Command
cmd = withAnnexOptions [jobsOption, jsonOptions] $ cmd = withAnnexOptions [jobsOption, jsonOptions] $
@ -77,8 +76,8 @@ perform from numcopies mincopies key = case from of
pcc = Command.Drop.PreferredContentChecked False pcc = Command.Drop.PreferredContentChecked False
ud = Command.Drop.DroppingUnused True ud = Command.Drop.DroppingUnused True
performOther :: (Key -> Git.Repo -> RawFilePath) -> Key -> CommandPerform performOther :: (Key -> Git.Repo -> OsPath) -> Key -> CommandPerform
performOther filespec key = do performOther filespec key = do
f <- fromRepo $ filespec key f <- fromRepo $ filespec key
pruneTmpWorkDirBefore f (liftIO . removeWhenExistsWith R.removeLink) pruneTmpWorkDirBefore f (liftIO . removeWhenExistsWith removeFile)
next $ return True next $ return True

4
Command/EnableTor.hs
View file

@ -57,7 +57,7 @@ start _os = do
Nothing -> giveup "Need user-id parameter." Nothing -> giveup "Need user-id parameter."
Just userid -> go userid Just userid -> go userid
else starting "enable-tor" ai si $ do else starting "enable-tor" ai si $ do
gitannex <- liftIO programPath gitannex <- fromOsPath <$> liftIO programPath
let ps = [Param (cmdname cmd), Param (show curruserid)] let ps = [Param (cmdname cmd), Param (show curruserid)]
sucommand <- liftIO $ mkSuCommand gitannex ps sucommand <- liftIO $ mkSuCommand gitannex ps
cleanenv <- liftIO $ cleanStandaloneEnvironment cleanenv <- liftIO $ cleanStandaloneEnvironment
@ -145,6 +145,6 @@ checkHiddenService = bracket setup cleanup go
haslistener sockfile = catchBoolIO $ do haslistener sockfile = catchBoolIO $ do
soc <- S.socket S.AF_UNIX S.Stream S.defaultProtocol soc <- S.socket S.AF_UNIX S.Stream S.defaultProtocol
S.connect soc (S.SockAddrUnix sockfile) S.connect soc (S.SockAddrUnix $ fromOsPath sockfile)
S.close soc S.close soc
return True return True

8
Command/ExamineKey.hs
View file

@ -39,7 +39,7 @@ optParser :: Parser ExamineOptions
optParser = ExamineOptions optParser = ExamineOptions
<$> optional parseFormatOption <$> optional parseFormatOption
<*> (fmap (DeferredParse . tobackend) <$> migrateopt) <*> (fmap (DeferredParse . tobackend) <$> migrateopt)
<*> (AssociatedFile <$> fileopt) <*> (AssociatedFile . fmap stringToOsPath <$> fileopt)
where where
fileopt = optional $ strOption fileopt = optional $ strOption
( long "filename" <> metavar paramFile ( long "filename" <> metavar paramFile
@ -59,8 +59,8 @@ run o _ input = do
let objectpointer = formatPointer k let objectpointer = formatPointer k
isterminal <- liftIO $ checkIsTerminal stdout isterminal <- liftIO $ checkIsTerminal stdout
showFormatted isterminal (format o) (serializeKey' k) $ showFormatted isterminal (format o) (serializeKey' k) $
[ ("objectpath", fromRawFilePath objectpath) [ ("objectpath", fromOsPath objectpath)
, ("objectpointer", fromRawFilePath objectpointer) , ("objectpointer", decodeBS objectpointer)
] ++ formatVars k af ] ++ formatVars k af
return True return True
where where
@ -71,7 +71,7 @@ run o _ input = do
ik = fromMaybe (giveup "bad key") (deserializeKey' ikb) ik = fromMaybe (giveup "bad key") (deserializeKey' ikb)
af = if B.null ifb' af = if B.null ifb'
then associatedFile o then associatedFile o
else AssociatedFile (Just ifb') else AssociatedFile (Just (toOsPath ifb'))
getkey = case migrateToBackend o of getkey = case migrateToBackend o of
Nothing -> pure ik Nothing -> pure ik

9
Command/Export.hs
View file

@ -78,8 +78,8 @@ optParser _ = ExportOptions
-- To handle renames which swap files, the exported file is first renamed -- To handle renames which swap files, the exported file is first renamed
-- to a stable temporary name based on the key. -- to a stable temporary name based on the key.
exportTempName :: Key -> ExportLocation exportTempName :: Key -> ExportLocation
exportTempName ek = mkExportLocation $ toRawFilePath $ exportTempName ek = mkExportLocation $
".git-annex-tmp-content-" ++ serializeKey ek literalOsPath ".git-annex-tmp-content-" <> toOsPath (serializeKey'' ek)
seek :: ExportOptions -> CommandSeek seek :: ExportOptions -> CommandSeek
seek o = startConcurrency commandStages $ do seek o = startConcurrency commandStages $ do
@ -312,12 +312,11 @@ performExport r srcrs db ek af contentsha loc allfilledvar = do
sent <- tryNonAsync $ if not (isGitShaKey ek) sent <- tryNonAsync $ if not (isGitShaKey ek)
then tryrenameannexobject $ sendannexobject then tryrenameannexobject $ sendannexobject
-- Sending a non-annexed file. -- Sending a non-annexed file.
else withTmpFile (toOsPath "export") $ \tmp h -> do else withTmpFile (literalOsPath "export") $ \tmp h -> do
b <- catObject contentsha b <- catObject contentsha
liftIO $ L.hPut h b liftIO $ L.hPut h b
liftIO $ hClose h liftIO $ hClose h
Remote.action $ Remote.action $ storer tmp ek loc nullMeterUpdate
storer (fromRawFilePath (fromOsPath tmp)) ek loc nullMeterUpdate
let failedsend = liftIO $ modifyMVar_ allfilledvar (pure . const (AllFilled False)) let failedsend = liftIO $ modifyMVar_ allfilledvar (pure . const (AllFilled False))
case sent of case sent of
Right True -> next $ cleanupExport r db ek loc True Right True -> next $ cleanupExport r db ek loc True

8
Command/FilterBranch.hs
View file

@ -27,13 +27,11 @@ import Git.Env
import Git.UpdateIndex import Git.UpdateIndex
import qualified Git.LsTree as LsTree import qualified Git.LsTree as LsTree
import qualified Git.Branch as Git import qualified Git.Branch as Git
import Utility.RawFilePath
import qualified Data.Map as M import qualified Data.Map as M
import qualified Data.Set as S import qualified Data.Set as S
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
import Data.ByteString.Builder import Data.ByteString.Builder
import qualified System.FilePath.ByteString as P
cmd :: Command cmd :: Command
cmd = noMessages $ withAnnexOptions [annexedMatchingOptions] $ cmd = noMessages $ withAnnexOptions [annexedMatchingOptions] $
@ -120,10 +118,10 @@ mkUUIDMatcher' sameasmap l = \u ->
seek :: FilterBranchOptions -> CommandSeek seek :: FilterBranchOptions -> CommandSeek
seek o = withOtherTmp $ \tmpdir -> do seek o = withOtherTmp $ \tmpdir -> do
let tmpindex = tmpdir P.</> "index" let tmpindex = tmpdir </> literalOsPath "index"
gc <- Annex.getGitConfig gc <- Annex.getGitConfig
tmpindexrepo <- Annex.inRepo $ \r -> tmpindexrepo <- Annex.inRepo $ \r ->
addGitEnv r indexEnv (fromRawFilePath tmpindex) addGitEnv r indexEnv (fromOsPath tmpindex)
withUpdateIndex tmpindexrepo $ \h -> do withUpdateIndex tmpindexrepo $ \h -> do
keyinfomatcher <- mkUUIDMatcher (keyInformation o) keyinfomatcher <- mkUUIDMatcher (keyInformation o)
repoconfigmatcher <- mkUUIDMatcher (repoConfig o) repoconfigmatcher <- mkUUIDMatcher (repoConfig o)
@ -186,7 +184,7 @@ seek o = withOtherTmp $ \tmpdir -> do
-- Commit the temporary index, and output the result. -- Commit the temporary index, and output the result.
t <- liftIO $ Git.writeTree tmpindexrepo t <- liftIO $ Git.writeTree tmpindexrepo
liftIO $ removeWhenExistsWith removeLink tmpindex liftIO $ removeWhenExistsWith removeFile tmpindex
cmode <- annexCommitMode <$> Annex.getGitConfig cmode <- annexCommitMode <$> Annex.getGitConfig
cmessage <- Annex.Branch.commitMessage cmessage <- Annex.Branch.commitMessage
c <- inRepo $ Git.commitTree cmode [cmessage] [] t c <- inRepo $ Git.commitTree cmode [cmessage] [] t

6
Command/FilterProcess.hs
View file

@ -36,7 +36,7 @@ seek _ = liftIO longRunningFilterProcessHandshake >>= \case
go go
Nothing -> return () Nothing -> return ()
smudge :: FilePath -> Annex () smudge :: OsPath -> Annex ()
smudge file = do smudge file = do
{- The whole git file content is necessarily buffered in memory, {- The whole git file content is necessarily buffered in memory,
- because we have to consume everything git is sending before - because we have to consume everything git is sending before
@ -49,7 +49,7 @@ smudge file = do
- See Command.Smudge.smudge for details of how this works. -} - See Command.Smudge.smudge for details of how this works. -}
liftIO $ respondFilterRequest b liftIO $ respondFilterRequest b
clean :: FilePath -> Annex () clean :: OsPath -> Annex ()
clean file = do clean file = do
{- We have to consume everything git is sending before we can {- We have to consume everything git is sending before we can
- respond to it. But it can be an arbitrarily large file, - respond to it. But it can be an arbitrarily large file,
@ -82,7 +82,7 @@ clean file = do
-- read from the file. It may be less expensive to incrementally -- read from the file. It may be less expensive to incrementally
-- hash the content provided by git, but Backend does not currently -- hash the content provided by git, but Backend does not currently
-- have an interface to do so. -- have an interface to do so.
Command.Smudge.clean' (toRawFilePath file) Command.Smudge.clean' file
(parseLinkTargetOrPointer' b) (parseLinkTargetOrPointer' b)
passthrough passthrough
discardreststdin discardreststdin

10
Command/Find.hs
View file

@ -88,9 +88,9 @@ contentPresentUnlessLimited s = do
else Just True else Just True
} }
start :: FindOptions -> IsTerminal -> SeekInput -> RawFilePath -> Key -> CommandStart start :: FindOptions -> IsTerminal -> SeekInput -> OsPath -> Key -> CommandStart
start o isterminal _ file key = startingCustomOutput key $ do start o isterminal _ file key = startingCustomOutput key $ do
showFormatted isterminal (formatOption o) file showFormatted isterminal (formatOption o) (fromOsPath file)
(formatVars key (AssociatedFile (Just file))) (formatVars key (AssociatedFile (Just file)))
next $ return True next $ return True
@ -113,14 +113,14 @@ showFormatted (IsTerminal isterminal) format unformatted vars =
formatVars :: Key -> AssociatedFile -> [(String, String)] formatVars :: Key -> AssociatedFile -> [(String, String)]
formatVars key (AssociatedFile af) = formatVars key (AssociatedFile af) =
(maybe id (\f l -> (("file", fromRawFilePath f) : l)) af) (maybe id (\f l -> (("file", fromOsPath f) : l)) af)
[ ("key", serializeKey key) [ ("key", serializeKey key)
, ("backend", decodeBS $ formatKeyVariety $ fromKey keyVariety key) , ("backend", decodeBS $ formatKeyVariety $ fromKey keyVariety key)
, ("bytesize", size show) , ("bytesize", size show)
, ("humansize", size $ roughSize storageUnits True) , ("humansize", size $ roughSize storageUnits True)
, ("keyname", decodeBS $ S.fromShort $ fromKey keyName key) , ("keyname", decodeBS $ S.fromShort $ fromKey keyName key)
, ("hashdirlower", fromRawFilePath $ hashDirLower def key) , ("hashdirlower", fromOsPath $ hashDirLower def key)
, ("hashdirmixed", fromRawFilePath $ hashDirMixed def key) , ("hashdirmixed", fromOsPath $ hashDirMixed def key)
, ("mtime", whenavail show $ fromKey keyMtime key) , ("mtime", whenavail show $ fromKey keyMtime key)
] ]
where where

2
Command/Get.hs
View file

@ -55,7 +55,7 @@ seek o = startConcurrency transferStages $ do
where where
ww = WarnUnmatchLsFiles "get" ww = WarnUnmatchLsFiles "get"
start :: GetOptions -> Maybe Remote -> SeekInput -> RawFilePath -> Key -> CommandStart start :: GetOptions -> Maybe Remote -> SeekInput -> OsPath -> Key -> CommandStart
start o from si file key = do start o from si file key = do
lu <- prepareLiveUpdate Nothing key AddingKey lu <- prepareLiveUpdate Nothing key AddingKey
start' lu (expensivecheck lu) from key afile ai si start' lu (expensivecheck lu) from key afile ai si

44
Command/ImportFeed.hs
View file

@ -24,7 +24,6 @@ import Data.Time.LocalTime
import Control.Concurrent.STM import Control.Concurrent.STM
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as TE import qualified Data.Text.Encoding as TE
import qualified System.FilePath.ByteString as P
import qualified Data.ByteString as B import qualified Data.ByteString as B
import Command import Command
@ -158,7 +157,7 @@ getFeed o url st =
| scrapeOption o = scrape | scrapeOption o = scrape
| otherwise = get | otherwise = get
get = withTmpFile (toOsPath "feed") $ \tmpf h -> do get = withTmpFile (literalOsPath "feed") $ \tmpf h -> do
let tmpf' = fromRawFilePath $ fromOsPath tmpf let tmpf' = fromRawFilePath $ fromOsPath tmpf
liftIO $ hClose h liftIO $ hClose h
ifM (downloadFeed url tmpf') ifM (downloadFeed url tmpf')
@ -270,7 +269,7 @@ downloadFeed :: URLString -> FilePath -> Annex Bool
downloadFeed url f downloadFeed url f
| Url.parseURIRelaxed url == Nothing = giveup "invalid feed url" | Url.parseURIRelaxed url == Nothing = giveup "invalid feed url"
| otherwise = Url.withUrlOptions $ | otherwise = Url.withUrlOptions $
Url.download nullMeterUpdate Nothing url f Url.download nullMeterUpdate Nothing url (toOsPath f)
startDownload :: AddUnlockedMatcher -> ImportFeedOptions -> Cache -> TMVar Bool -> ToDownload -> CommandStart startDownload :: AddUnlockedMatcher -> ImportFeedOptions -> Cache -> TMVar Bool -> ToDownload -> CommandStart
startDownload addunlockedmatcher opts cache cv todownload = case location todownload of startDownload addunlockedmatcher opts cache cv todownload = case location todownload of
@ -315,15 +314,15 @@ startDownload addunlockedmatcher opts cache cv todownload = case location todown
ifM (useYoutubeDl (downloadOptions opts) <&&> youtubeDlSupported linkurl) ifM (useYoutubeDl (downloadOptions opts) <&&> youtubeDlSupported linkurl)
( startUrlDownload cv todownload linkurl $ ( startUrlDownload cv todownload linkurl $
withTmpWorkDir mediakey $ \workdir -> do withTmpWorkDir mediakey $ \workdir -> do
dl <- youtubeDl linkurl (fromRawFilePath workdir) nullMeterUpdate dl <- youtubeDl linkurl workdir nullMeterUpdate
case dl of case dl of
Right (Just mediafile) -> do Right (Just mediafile) -> do
let ext = case takeExtension mediafile of let ext = case fromOsPath (takeExtension mediafile) of
[] -> ".m" [] -> ".m"
s -> s s -> s
runDownload todownload linkurl ext cache cv $ \f -> runDownload todownload linkurl ext cache cv $ \f ->
checkCanAdd (downloadOptions opts) f $ \canadd -> do checkCanAdd (downloadOptions opts) f $ \canadd -> do
addWorkTree canadd addunlockedmatcher webUUID mediaurl f mediakey (Just (toRawFilePath mediafile)) addWorkTree canadd addunlockedmatcher webUUID mediaurl f mediakey (Just mediafile)
return (Just [mediakey]) return (Just [mediakey])
-- youtube-dl didn't support it, so -- youtube-dl didn't support it, so
-- download it as if the link were -- download it as if the link were
@ -352,16 +351,16 @@ startDownload addunlockedmatcher opts cache cv todownload = case location todown
) )
downloadEnclosure :: AddUnlockedMatcher -> ImportFeedOptions -> Cache -> TMVar Bool -> ToDownload -> URLString -> CommandPerform downloadEnclosure :: AddUnlockedMatcher -> ImportFeedOptions -> Cache -> TMVar Bool -> ToDownload -> URLString -> CommandPerform
downloadEnclosure addunlockedmatcher opts cache cv todownload url = downloadEnclosure addunlockedmatcher opts cache cv todownload url =
runDownload todownload url (takeWhile (/= '?') $ takeExtension url) cache cv $ \f -> do let extension = takeWhile (/= '?') $ fromOsPath $ takeExtension $ toOsPath url
let f' = fromRawFilePath f in runDownload todownload url extension cache cv $ \f -> do
r <- checkClaimingUrl (downloadOptions opts) url r <- checkClaimingUrl (downloadOptions opts) url
if Remote.uuid r == webUUID || rawOption (downloadOptions opts) if Remote.uuid r == webUUID || rawOption (downloadOptions opts)
then checkRaw (Just url) (downloadOptions opts) (pure Nothing) $ do then checkRaw (Just url) (downloadOptions opts) (pure Nothing) $ do
let dlopts = (downloadOptions opts) let dlopts = (downloadOptions opts)
-- force using the filename -- force using the filename
-- chosen here -- chosen here
{ fileOption = Just f' { fileOption = Just (fromOsPath f)
-- don't use youtube-dl -- don't use youtube-dl
, rawOption = True , rawOption = True
} }
@ -385,7 +384,7 @@ downloadEnclosure addunlockedmatcher opts cache cv todownload url =
downloadRemoteFile addunlockedmatcher r (downloadOptions opts) url f sz downloadRemoteFile addunlockedmatcher r (downloadOptions opts) url f sz
Right (UrlMulti l) -> do Right (UrlMulti l) -> do
kl <- forM l $ \(url', sz, subf) -> kl <- forM l $ \(url', sz, subf) ->
let dest = f P.</> toRawFilePath (sanitizeFilePath subf) let dest = f </> toOsPath (sanitizeFilePath (fromOsPath subf))
in downloadRemoteFile addunlockedmatcher r (downloadOptions opts) url' dest sz in downloadRemoteFile addunlockedmatcher r (downloadOptions opts) url' dest sz
return $ Just $ if all isJust kl return $ Just $ if all isJust kl
then catMaybes kl then catMaybes kl
@ -397,7 +396,7 @@ runDownload
-> String -> String
-> Cache -> Cache
-> TMVar Bool -> TMVar Bool
-> (RawFilePath -> Annex (Maybe [Key])) -> (OsPath -> Annex (Maybe [Key]))
-> CommandPerform -> CommandPerform
runDownload todownload url extension cache cv getter = do runDownload todownload url extension cache cv getter = do
dest <- makeunique (1 :: Integer) $ dest <- makeunique (1 :: Integer) $
@ -406,7 +405,7 @@ runDownload todownload url extension cache cv getter = do
Nothing -> do Nothing -> do
recordsuccess recordsuccess
next $ return True next $ return True
Just f -> getter (toRawFilePath f) >>= \case Just f -> getter f >>= \case
Just ks Just ks
-- Download problem. -- Download problem.
| null ks -> do | null ks -> do
@ -440,7 +439,7 @@ runDownload todownload url extension cache cv getter = do
- to be re-downloaded. -} - to be re-downloaded. -}
makeunique n file = ifM alreadyexists makeunique n file = ifM alreadyexists
( ifM forced ( ifM forced
( lookupKey (toRawFilePath f) >>= \case ( lookupKey f >>= \case
Just k -> checksameurl k Just k -> checksameurl k
Nothing -> tryanother Nothing -> tryanother
, tryanother , tryanother
@ -449,12 +448,12 @@ runDownload todownload url extension cache cv getter = do
) )
where where
f = if n < 2 f = if n < 2
then file then toOsPath file
else else
let (d, base) = splitFileName file let (d, base) = splitFileName (toOsPath file)
in d </> show n ++ "_" ++ base in d </> toOsPath (show n ++ "_") <> base
tryanother = makeunique (n + 1) file tryanother = makeunique (n + 1) file
alreadyexists = liftIO $ isJust <$> catchMaybeIO (R.getSymbolicLinkStatus (toRawFilePath f)) alreadyexists = liftIO $ isJust <$> catchMaybeIO (R.getSymbolicLinkStatus (fromOsPath f))
checksameurl k = ifM (elem url . map fst . map getDownloader <$> getUrls k) checksameurl k = ifM (elem url . map fst . map getDownloader <$> getUrls k)
( return Nothing ( return Nothing
, tryanother , tryanother
@ -609,10 +608,10 @@ feedProblem url message = ifM (checkFeedBroken url)
- least 23 hours. -} - least 23 hours. -}
checkFeedBroken :: URLString -> Annex Bool checkFeedBroken :: URLString -> Annex Bool
checkFeedBroken url = checkFeedBroken' url =<< feedState url checkFeedBroken url = checkFeedBroken' url =<< feedState url
checkFeedBroken' :: URLString -> RawFilePath -> Annex Bool checkFeedBroken' :: URLString -> OsPath -> Annex Bool
checkFeedBroken' url f = do checkFeedBroken' url f = do
prev <- maybe Nothing readish prev <- maybe Nothing readish
<$> liftIO (catchMaybeIO $ readFile (fromRawFilePath f)) <$> liftIO (catchMaybeIO $ readFile (fromOsPath f))
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
case prev of case prev of
Nothing -> do Nothing -> do
@ -628,10 +627,9 @@ checkFeedBroken' url f = do
clearFeedProblem :: URLString -> Annex () clearFeedProblem :: URLString -> Annex ()
clearFeedProblem url = clearFeedProblem url =
void $ liftIO . tryIO . removeFile . fromRawFilePath void $ liftIO . tryIO . removeFile =<< feedState url
=<< feedState url
feedState :: URLString -> Annex RawFilePath feedState :: URLString -> Annex OsPath
feedState url = fromRepo $ gitAnnexFeedState $ fromUrl url Nothing False feedState url = fromRepo $ gitAnnexFeedState $ fromUrl url Nothing False
{- The feed library parses the feed to Text, and does not use the {- The feed library parses the feed to Text, and does not use the

2
Command/Mirror.hs
View file

@ -57,7 +57,7 @@ seek o = startConcurrency stages $
, usesLocationLog = True , usesLocationLog = True
} }
start :: MirrorOptions -> SeekInput -> RawFilePath -> Key -> CommandStart start :: MirrorOptions -> SeekInput -> OsPath -> Key -> CommandStart
start o si file k = startKey o afile (si, k, ai) start o si file k = startKey o afile (si, k, ai)
where where
afile = AssociatedFile (Just file) afile = AssociatedFile (Just file)

2
Command/Move.hs
View file

@ -94,7 +94,7 @@ stages ToHere = transferStages
stages (FromRemoteToRemote _ _) = transferStages stages (FromRemoteToRemote _ _) = transferStages
stages (FromAnywhereToRemote _) = transferStages stages (FromAnywhereToRemote _) = transferStages
start :: LiveUpdate -> FromToHereOptions -> RemoveWhen -> SeekInput -> RawFilePath -> Key -> CommandStart start :: LiveUpdate -> FromToHereOptions -> RemoveWhen -> SeekInput -> OsPath -> Key -> CommandStart
start lu fromto removewhen si f k = start' lu fromto removewhen afile si k ai start lu fromto removewhen si f k = start' lu fromto removewhen afile si k ai
where where
afile = AssociatedFile (Just f) afile = AssociatedFile (Just f)

2
Command/Whereis.hs
View file

@ -67,7 +67,7 @@ seek o = do
where where
ww = WarnUnmatchLsFiles "whereis" ww = WarnUnmatchLsFiles "whereis"
start :: WhereisOptions -> M.Map UUID Remote -> SeekInput -> RawFilePath -> Key -> CommandStart start :: WhereisOptions -> M.Map UUID Remote -> SeekInput -> OsPath -> Key -> CommandStart
start o remotemap si file key = start o remotemap si file key =
startKeys o remotemap (si, key, mkActionItem (key, afile)) startKeys o remotemap (si, key, mkActionItem (key, afile))
where where

6
Git/CheckIgnore.hs
View file

@ -52,11 +52,11 @@ checkIgnoreStop :: CheckIgnoreHandle -> IO ()
checkIgnoreStop = void . tryIO . CoProcess.stop checkIgnoreStop = void . tryIO . CoProcess.stop
{- Returns True if a file is ignored. -} {- Returns True if a file is ignored. -}
checkIgnored :: CheckIgnoreHandle -> RawFilePath -> IO Bool checkIgnored :: CheckIgnoreHandle -> OsPath -> IO Bool
checkIgnored h file = CoProcess.query h send (receive "") checkIgnored h file = CoProcess.query h send (receive "")
where where
send to = do send to = do
B.hPutStr to $ file `B.snoc` 0 B.hPutStr to $ fromOsPath file `B.snoc` 0
hFlush to hFlush to
receive c from = do receive c from = do
s <- hGetSomeString from 1024 s <- hGetSomeString from 1024
@ -68,4 +68,4 @@ checkIgnored h file = CoProcess.query h send (receive "")
parse s = case segment (== '\0') s of parse s = case segment (== '\0') s of
(_source:_line:pattern:_pathname:_eol:[]) -> Just $ not $ null pattern (_source:_line:pattern:_pathname:_eol:[]) -> Just $ not $ null pattern
_ -> Nothing _ -> Nothing
eofError = ioError $ mkIOError userErrorType "git cat-file EOF" Nothing Nothing eofError = ioError $ mkIOError userErrorType "git check-ignore EOF" Nothing Nothing

6
Git/FilterProcess.hs
View file

@ -130,7 +130,7 @@ longRunningFilterProcessHandshake =
-- Delay capability is not implemented, so filter it out. -- Delay capability is not implemented, so filter it out.
filtercapabilities = filter (`elem` [Capability "smudge", Capability "clean"]) filtercapabilities = filter (`elem` [Capability "smudge", Capability "clean"])
data FilterRequest = Smudge FilePath | Clean FilePath data FilterRequest = Smudge OsPath | Clean OsPath
deriving (Show, Eq) deriving (Show, Eq)
{- Waits for the next FilterRequest to be received. Does not read {- Waits for the next FilterRequest to be received. Does not read
@ -143,8 +143,8 @@ getFilterRequest = do
let cs = mapMaybe decodeConfigValue ps let cs = mapMaybe decodeConfigValue ps
case (extractConfigValue cs "command", extractConfigValue cs "pathname") of case (extractConfigValue cs "command", extractConfigValue cs "pathname") of
(Just command, Just pathname) (Just command, Just pathname)
| command == "smudge" -> return $ Just $ Smudge pathname | command == "smudge" -> return $ Just $ Smudge $ toOsPath pathname
| command == "clean" -> return $ Just $ Clean pathname | command == "clean" -> return $ Just $ Clean $ toOsPath pathname
| otherwise -> return Nothing | otherwise -> return Nothing
_ -> return Nothing _ -> return Nothing

7
Git/Quote.hs
View file

@ -7,6 +7,7 @@
-} -}
{-# LANGUAGE OverloadedStrings, TypeSynonymInstances #-} {-# LANGUAGE OverloadedStrings, TypeSynonymInstances #-}
{-# LANGUAGE CPP #-}
module Git.Quote ( module Git.Quote (
unquote, unquote,
@ -71,6 +72,12 @@ instance Quoteable RawFilePath where
noquote = id noquote = id
#ifdef WITH_OSPATH
instance Quoteable OsPath where
quote qp f = quote qp (fromOsPath f :: RawFilePath)
noquote = fromOsPath
#endif
-- Allows building up a string that contains paths, which will get quoted. -- Allows building up a string that contains paths, which will get quoted.
-- With OverloadedStrings, strings are passed through without quoting. -- With OverloadedStrings, strings are passed through without quoting.
-- Eg: QuotedPath f <> ": not found" -- Eg: QuotedPath f <> ": not found"

9
Utility/Aeson.hs
View file

@ -8,6 +8,7 @@
-} -}
{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
{-# LANGUAGE CPP #-}
module Utility.Aeson ( module Utility.Aeson (
module X, module X,
@ -32,6 +33,9 @@ import qualified Data.Vector
import Prelude import Prelude
import Utility.FileSystemEncoding import Utility.FileSystemEncoding
#ifdef WITH_OSPATH
import Utility.OsPath
#endif
-- | Use this instead of Data.Aeson.encode to make sure that the -- | Use this instead of Data.Aeson.encode to make sure that the
-- below String instance is used. -- below String instance is used.
@ -60,6 +64,11 @@ instance ToJSON' String where
instance ToJSON' S.ByteString where instance ToJSON' S.ByteString where
toJSON' = toJSON . packByteString toJSON' = toJSON . packByteString
#ifdef WITH_OSPATH
instance ToJSON' OsPath where
toJSON' p = toJSON' (fromOsPath p :: S.ByteString)
#endif
-- | Pack a String to Text, correctly handling the filesystem encoding. -- | Pack a String to Text, correctly handling the filesystem encoding.
-- --
-- Use this instead of Data.Text.pack. -- Use this instead of Data.Text.pack.

5
Utility/HtmlDetect.hs
View file

@ -14,7 +14,6 @@ module Utility.HtmlDetect (
import Author import Author
import qualified Utility.FileIO as F import qualified Utility.FileIO as F
import Utility.RawFilePath
import Utility.OsPath import Utility.OsPath
import Text.HTML.TagSoup import Text.HTML.TagSoup
@ -60,8 +59,8 @@ isHtmlBs = isHtml . B8.unpack
-- It would be equivalent to use isHtml <$> readFile file, -- It would be equivalent to use isHtml <$> readFile file,
-- but since that would not read all of the file, the handle -- but since that would not read all of the file, the handle
-- would remain open until it got garbage collected sometime later. -- would remain open until it got garbage collected sometime later.
isHtmlFile :: RawFilePath -> IO Bool isHtmlFile :: OsPath -> IO Bool
isHtmlFile file = F.withFile (toOsPath file) ReadMode $ \h -> isHtmlFile file = F.withFile file ReadMode $ \h ->
isHtmlBs <$> B.hGet h htmlPrefixLength isHtmlBs <$> B.hGet h htmlPrefixLength
-- | How much of the beginning of a html document is needed to detect it. -- | How much of the beginning of a html document is needed to detect it.