more OsPath conversion (639/749)
Sponsored-by: k0ld
This commit is contained in:
Joey Hess
parent
a5d48edd94
commit
c74c75b352
28 changed files with 147 additions and 132 deletions
|
|
@ -22,7 +22,7 @@ import Annex.Concurrent.Utility
|
|||
|
||||
newtype CheckGitIgnore = CheckGitIgnore Bool
|
||||
|
||||
checkIgnored :: CheckGitIgnore -> RawFilePath -> Annex Bool
|
||||
checkIgnored :: CheckGitIgnore -> OsPath -> Annex Bool
|
||||
checkIgnored (CheckGitIgnore False) _ = pure False
|
||||
checkIgnored (CheckGitIgnore True) file =
|
||||
ifM (Annex.getRead Annex.force)
|
||||
|
|
|
|||
12
CmdLine.hs
12
CmdLine.hs
|
|
@ -5,6 +5,8 @@
|
|||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module CmdLine (
|
||||
dispatch,
|
||||
usage,
|
||||
|
|
@ -29,6 +31,7 @@ import Annex.Action
|
|||
import Annex.Environment
|
||||
import Command
|
||||
import Types.Messages
|
||||
import qualified Utility.OsString as OS
|
||||
|
||||
{- Parses input arguments, finds a matching Command, and runs it. -}
|
||||
dispatch :: Bool -> Bool -> CmdParams -> [Command] -> [(String, String)] -> IO Git.Repo -> String -> String -> IO ()
|
||||
|
|
@ -159,17 +162,18 @@ findAddonCommand Nothing = return Nothing
|
|||
findAddonCommand (Just subcommandname) =
|
||||
searchPath c >>= \case
|
||||
Nothing -> return Nothing
|
||||
Just p -> return (Just (mkAddonCommand p subcommandname))
|
||||
Just p -> return (Just (mkAddonCommand (fromOsPath p) subcommandname))
|
||||
where
|
||||
c = "git-annex-" ++ subcommandname
|
||||
|
||||
findAllAddonCommands :: IO [Command]
|
||||
findAllAddonCommands =
|
||||
filter isaddoncommand
|
||||
. map (\p -> mkAddonCommand p (deprefix p))
|
||||
<$> searchPathContents ("git-annex-" `isPrefixOf`)
|
||||
. map go
|
||||
<$> searchPathContents (literalOsPath "git-annex-" `OS.isPrefixOf`)
|
||||
where
|
||||
deprefix = replace "git-annex-" "" . takeFileName
|
||||
go p = mkAddonCommand (fromOsPath p) (deprefix p)
|
||||
deprefix = replace "git-annex-" "" . fromOsPath . takeFileName
|
||||
isaddoncommand c
|
||||
-- git-annex-shell
|
||||
| cmdname c == "shell" = False
|
||||
|
|
|
|||
|
|
@ -31,7 +31,6 @@ import Utility.InodeCache
|
|||
import Annex.InodeSentinal
|
||||
import Annex.CheckIgnore
|
||||
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)
|
||||
|
||||
|
|
@ -140,23 +139,23 @@ seek' o = do
|
|||
dr = dryRunOption o
|
||||
|
||||
{- Pass file off to git-add. -}
|
||||
startSmall :: Bool -> DryRun -> SeekInput -> RawFilePath -> CommandStart
|
||||
startSmall :: Bool -> DryRun -> SeekInput -> OsPath -> CommandStart
|
||||
startSmall isdotfile dr si file =
|
||||
liftIO (catchMaybeIO $ R.getSymbolicLinkStatus file) >>= \case
|
||||
liftIO (catchMaybeIO $ R.getSymbolicLinkStatus $ fromOsPath file) >>= \case
|
||||
Just s ->
|
||||
starting "add" (ActionItemTreeFile file) si $
|
||||
addSmall isdotfile dr file s
|
||||
Nothing -> stop
|
||||
|
||||
addSmall :: Bool -> DryRun -> RawFilePath -> FileStatus -> CommandPerform
|
||||
addSmall :: Bool -> DryRun -> OsPath -> FileStatus -> CommandPerform
|
||||
addSmall isdotfile dr file s = do
|
||||
showNote $ (if isdotfile then "dotfile" else "non-large file")
|
||||
<> "; adding content to git repository"
|
||||
skipWhenDryRun dr $ next $ addFile Small file s
|
||||
|
||||
startSmallOverridden :: DryRun -> SeekInput -> RawFilePath -> CommandStart
|
||||
startSmallOverridden :: DryRun -> SeekInput -> OsPath -> CommandStart
|
||||
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
|
||||
showNote "adding content to git repository"
|
||||
skipWhenDryRun dr $ next $ addFile Small file s
|
||||
|
|
@ -164,22 +163,23 @@ startSmallOverridden dr si file =
|
|||
|
||||
data SmallOrLarge = Small | Large
|
||||
|
||||
addFile :: SmallOrLarge -> RawFilePath -> FileStatus -> Annex Bool
|
||||
addFile :: SmallOrLarge -> OsPath -> FileStatus -> Annex Bool
|
||||
addFile smallorlarge file s = do
|
||||
let file' = fromOsPath file
|
||||
sha <- if isSymbolicLink s
|
||||
then hashBlob =<< liftIO (R.readSymbolicLink file)
|
||||
then hashBlob =<< liftIO (R.readSymbolicLink file')
|
||||
else if isRegularFile s
|
||||
then hashFile file
|
||||
else do
|
||||
qp <- coreQuotePath <$> Annex.getGitConfig
|
||||
giveup $ decodeBS $ quote qp $
|
||||
file <> " is not a regular file"
|
||||
giveup $ decodeBS $ quote qp file
|
||||
<> " is not a regular file"
|
||||
let treetype = if isSymbolicLink s
|
||||
then TreeSymlink
|
||||
else if intersectFileModes ownerExecuteMode (fileMode s) /= 0
|
||||
then TreeExecutable
|
||||
else TreeFile
|
||||
s' <- liftIO $ catchMaybeIO $ R.getSymbolicLinkStatus file
|
||||
s' <- liftIO $ catchMaybeIO $ R.getSymbolicLinkStatus file'
|
||||
if maybe True (changed s) s'
|
||||
then do
|
||||
warning $ QuotedPath file <> " changed while it was being added"
|
||||
|
|
@ -206,9 +206,9 @@ addFile smallorlarge file s = do
|
|||
isRegularFile a /= isRegularFile b ||
|
||||
isSymbolicLink a /= isSymbolicLink b
|
||||
|
||||
start :: DryRun -> SeekInput -> RawFilePath -> AddUnlockedMatcher -> CommandStart
|
||||
start :: DryRun -> SeekInput -> OsPath -> AddUnlockedMatcher -> CommandStart
|
||||
start dr si file addunlockedmatcher =
|
||||
liftIO (catchMaybeIO $ R.getSymbolicLinkStatus file) >>= \case
|
||||
liftIO (catchMaybeIO $ R.getSymbolicLinkStatus $ fromOsPath file) >>= \case
|
||||
Nothing -> stop
|
||||
Just s
|
||||
| not (isRegularFile s) && not (isSymbolicLink s) -> stop
|
||||
|
|
@ -231,11 +231,11 @@ start dr si file addunlockedmatcher =
|
|||
starting "add" (ActionItemTreeFile file) si $
|
||||
addingExistingLink file key $
|
||||
skipWhenDryRun dr $ withOtherTmp $ \tmp -> do
|
||||
let tmpf = tmp P.</> P.takeFileName file
|
||||
let tmpf = tmp </> takeFileName file
|
||||
liftIO $ moveFile file tmpf
|
||||
ifM (isSymbolicLink <$> liftIO (R.getSymbolicLinkStatus tmpf))
|
||||
ifM (isSymbolicLink <$> liftIO (R.getSymbolicLinkStatus $ fromOsPath tmpf))
|
||||
( do
|
||||
liftIO $ R.removeLink tmpf
|
||||
liftIO $ removeFile tmpf
|
||||
addSymlink file key Nothing
|
||||
next $ cleanup key =<< inAnnex key
|
||||
, do
|
||||
|
|
@ -249,7 +249,7 @@ start dr si file addunlockedmatcher =
|
|||
Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath file)
|
||||
next $ addFile Large file s
|
||||
|
||||
perform :: RawFilePath -> AddUnlockedMatcher -> CommandPerform
|
||||
perform :: OsPath -> AddUnlockedMatcher -> CommandPerform
|
||||
perform file addunlockedmatcher = withOtherTmp $ \tmpdir -> do
|
||||
lockingfile <- not <$> addUnlocked addunlockedmatcher
|
||||
(MatchingFile (FileInfo file file Nothing))
|
||||
|
|
@ -259,7 +259,7 @@ perform file addunlockedmatcher = withOtherTmp $ \tmpdir -> do
|
|||
, hardlinkFileTmpDir = Just tmpdir
|
||||
, checkWritePerms = True
|
||||
}
|
||||
ld <- lockDown cfg (fromRawFilePath file)
|
||||
ld <- lockDown cfg file
|
||||
let sizer = keySource <$> ld
|
||||
v <- metered Nothing sizer Nothing $ \_meter meterupdate ->
|
||||
ingestAdd meterupdate ld
|
||||
|
|
|
|||
|
|
@ -27,7 +27,7 @@ start :: UnusedMaps -> Int -> CommandStart
|
|||
start = startUnused go (other "bad") (other "tmp")
|
||||
where
|
||||
go n key = do
|
||||
let file = "unused." <> keyFile key
|
||||
let file = literalOsPath "unused." <> keyFile key
|
||||
starting "addunused"
|
||||
(ActionItemTreeFile file)
|
||||
(SeekInput [show n]) $
|
||||
|
|
|
|||
|
|
@ -177,14 +177,14 @@ checkUrl addunlockedmatcher r o si u = do
|
|||
warning (UnquotedString (show e))
|
||||
next $ return False
|
||||
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)))
|
||||
void $ commandAction $ startRemote addunlockedmatcher r o si f' u sz
|
||||
go deffile (Right (UrlMulti l)) = case fileOption (downloadOptions o) of
|
||||
Nothing ->
|
||||
forM_ l $ \(u', sz, f) -> do
|
||||
f' <- sanitizeOrPreserveFilePath o f
|
||||
let f'' = adjustFile o (deffile </> f')
|
||||
f' <- sanitizeOrPreserveFilePath o (fromOsPath f)
|
||||
let f'' = adjustFile o (fromOsPath (toOsPath deffile </> toOsPath f'))
|
||||
void $ commandAction $ startRemote addunlockedmatcher r o si f'' u' sz
|
||||
Just f -> case l of
|
||||
[] -> noop
|
||||
|
|
@ -200,14 +200,14 @@ 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' = P.joinPath $ map (truncateFilePath pathmax) $
|
||||
let file' = toOsPath $ P.joinPath $ map (truncateFilePath pathmax) $
|
||||
P.splitDirectories (toRawFilePath file)
|
||||
startingAddUrl si uri o $ do
|
||||
showNote $ UnquotedString $ "from " ++ Remote.name r
|
||||
showDestinationFile file'
|
||||
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
|
||||
Just k -> adduri k
|
||||
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)
|
||||
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
|
||||
let urlkey = Backend.URL.fromUrl uri sz (verifiableOption o)
|
||||
createWorkTreeDirectory (parentDir file)
|
||||
|
|
@ -265,12 +265,12 @@ startWeb addunlockedmatcher o si urlstring = go $ fromMaybe bad $ parseURIPortab
|
|||
f <- sanitizeOrPreserveFilePath o sf
|
||||
if preserveFilenameOption (downloadOptions o)
|
||||
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 f
|
||||
)
|
||||
_ -> 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 o f
|
||||
|
|
@ -294,12 +294,12 @@ checkPreserveFileNameSecurity f = do
|
|||
qp <- coreQuotePath <$> Annex.getGitConfig
|
||||
giveup $ decodeBS $ quote qp $
|
||||
"--preserve-filename was used, but the filename ("
|
||||
<> QuotedPath (toRawFilePath f)
|
||||
<> QuotedPath (toOsPath f)
|
||||
<> ") has a security problem ("
|
||||
<> d
|
||||
<> "), 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
|
||||
Just k -> addurl k
|
||||
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,
|
||||
- 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 =
|
||||
ifM ((elem url <$> getUrls key) <&&> (elem u <$> loggedLocations key))
|
||||
( do
|
||||
|
|
@ -340,14 +340,14 @@ 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 -> RawFilePath -> Annex (Maybe Key)
|
||||
addUrlFile :: AddUnlockedMatcher -> DownloadOptions -> URLString -> Url.UrlInfo -> OsPath -> Annex (Maybe Key)
|
||||
addUrlFile addunlockedmatcher o url urlinfo file =
|
||||
ifM (Annex.getRead Annex.fast <||> pure (relaxedOption o))
|
||||
( nodownloadWeb 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 =
|
||||
go =<< downloadWith' downloader urlkey webUUID url file
|
||||
where
|
||||
|
|
@ -366,25 +366,25 @@ downloadWeb addunlockedmatcher o url urlinfo file =
|
|||
-- so it's only used when the file contains embedded media.
|
||||
tryyoutubedl tmp backend = youtubeDlFileNameHtmlOnly url >>= \case
|
||||
Right mediafile -> do
|
||||
liftIO $ liftIO $ removeWhenExistsWith R.removeLink tmp
|
||||
let f = youtubeDlDestFile o file (toRawFilePath mediafile)
|
||||
liftIO $ liftIO $ removeWhenExistsWith removeFile tmp
|
||||
let f = youtubeDlDestFile o file mediafile
|
||||
lookupKey f >>= \case
|
||||
Just k -> alreadyannexed f k
|
||||
Nothing -> dl f
|
||||
Left err -> checkRaw (Just err) o (pure Nothing) (normalfinish tmp backend)
|
||||
where
|
||||
dl dest = withTmpWorkDir mediakey $ \workdir -> do
|
||||
let cleanuptmp = pruneTmpWorkDirBefore tmp (liftIO . removeWhenExistsWith R.removeLink)
|
||||
let cleanuptmp = pruneTmpWorkDirBefore tmp (liftIO . removeWhenExistsWith removeFile)
|
||||
dlcmd <- youtubeDlCommand
|
||||
showNote ("using " <> UnquotedString dlcmd)
|
||||
Transfer.notifyTransfer Transfer.Download url $
|
||||
Transfer.download' webUUID mediakey (AssociatedFile Nothing) Nothing Transfer.noRetry $ \p -> do
|
||||
showDestinationFile dest
|
||||
youtubeDl url (fromRawFilePath workdir) p >>= \case
|
||||
youtubeDl url workdir p >>= \case
|
||||
Right (Just mediafile) -> do
|
||||
cleanuptmp
|
||||
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
|
||||
Left msg -> do
|
||||
cleanuptmp
|
||||
|
|
@ -445,10 +445,10 @@ startingAddUrl si url o p = starting "addurl" ai si $ do
|
|||
ai = OnlyActionOn urlkey (ActionItemOther (Just (UnquotedString url)))
|
||||
urlkey = Backend.URL.fromUrl url Nothing (verifiableOption (downloadOptions o))
|
||||
|
||||
showDestinationFile :: RawFilePath -> Annex ()
|
||||
showDestinationFile :: OsPath -> Annex ()
|
||||
showDestinationFile file = do
|
||||
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
|
||||
- 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
|
||||
- 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 =
|
||||
go =<< downloadWith' downloader dummykey u url file
|
||||
where
|
||||
|
|
@ -468,7 +468,7 @@ downloadWith canadd addunlockedmatcher downloader dummykey u url file =
|
|||
|
||||
{- Like downloadWith, but leaves the dummy key content in
|
||||
- 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 =
|
||||
checkDiskSpaceToGet dummykey Nothing Nothing $ do
|
||||
backend <- chooseBackend file
|
||||
|
|
@ -477,14 +477,14 @@ downloadWith' downloader dummykey u url file =
|
|||
ok <- Transfer.notifyTransfer Transfer.Download url $ \_w ->
|
||||
Transfer.runTransfer t (Just backend) afile Nothing Transfer.stdRetry $ \p -> do
|
||||
createAnnexDirectory (parentDir tmp)
|
||||
downloader (fromRawFilePath tmp) p
|
||||
downloader tmp p
|
||||
if ok
|
||||
then return (Just (tmp, backend))
|
||||
else return Nothing
|
||||
where
|
||||
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
|
||||
let source = KeySource
|
||||
{ keyFilename = file
|
||||
|
|
@ -502,14 +502,14 @@ addSizeUrlKey urlinfo key = alterKey key $ \d -> d
|
|||
}
|
||||
|
||||
{- 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
|
||||
Nothing -> go
|
||||
Just tmp -> do
|
||||
s <- liftIO $ R.getSymbolicLinkStatus tmp
|
||||
s <- liftIO $ R.getSymbolicLinkStatus (fromOsPath tmp)
|
||||
-- Move to final location for large file check.
|
||||
pruneTmpWorkDirBefore tmp $ \_ -> do
|
||||
createWorkTreeDirectory (P.takeDirectory file)
|
||||
createWorkTreeDirectory (takeDirectory file)
|
||||
liftIO $ moveFile tmp file
|
||||
largematcher <- largeFilesMatcher
|
||||
large <- checkFileMatcher NoLiveUpdate largematcher file
|
||||
|
|
@ -531,15 +531,15 @@ addWorkTree _ addunlockedmatcher u url file key mtmp = case mtmp of
|
|||
( do
|
||||
when (isJust mtmp) $
|
||||
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
|
||||
| Url.urlExists urlinfo = if rawOption o
|
||||
then nomedia
|
||||
else youtubeDlFileName url >>= \case
|
||||
Right mediafile -> usemedia (toRawFilePath mediafile)
|
||||
Right mediafile -> usemedia mediafile
|
||||
Left err -> checkRaw (Just err) o (pure Nothing) nomedia
|
||||
| otherwise = do
|
||||
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)
|
||||
nodownloadWeb' o addunlockedmatcher mediaurl mediakey dest
|
||||
|
||||
youtubeDlDestFile :: DownloadOptions -> RawFilePath -> RawFilePath -> RawFilePath
|
||||
youtubeDlDestFile :: DownloadOptions -> OsPath -> OsPath -> OsPath
|
||||
youtubeDlDestFile o destfile mediafile
|
||||
| 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
|
||||
showDestinationFile file
|
||||
createWorkTreeDirectory (parentDir file)
|
||||
|
|
@ -601,8 +601,8 @@ adjustFile o = addprefix . addsuffix
|
|||
|
||||
data CanAddFile = CanAddFile
|
||||
|
||||
checkCanAdd :: DownloadOptions -> RawFilePath -> (CanAddFile -> Annex (Maybe a)) -> Annex (Maybe a)
|
||||
checkCanAdd o file a = ifM (isJust <$> (liftIO $ catchMaybeIO $ R.getSymbolicLinkStatus file))
|
||||
checkCanAdd :: DownloadOptions -> OsPath -> (CanAddFile -> Annex (Maybe a)) -> Annex (Maybe a)
|
||||
checkCanAdd o file a = ifM (isJust <$> (liftIO $ catchMaybeIO $ R.getSymbolicLinkStatus (fromOsPath file)))
|
||||
( do
|
||||
warning $ QuotedPath file <> " already exists; not overwriting"
|
||||
return Nothing
|
||||
|
|
|
|||
|
|
@ -32,4 +32,4 @@ run _ _ file = tryNonAsync (genKey ks nullMeterUpdate =<< defaultBackend) >>= \c
|
|||
Left _err -> return False
|
||||
where
|
||||
ks = KeySource file' file' Nothing
|
||||
file' = toRawFilePath file
|
||||
file' = toOsPath file
|
||||
|
|
|
|||
|
|
@ -152,7 +152,7 @@ seek (ShowOrigin ck@(ConfigKey name) forfile) = commandAction $
|
|||
| decodeBS name `elem` annexAttrs =
|
||||
case forfile of
|
||||
Just file -> do
|
||||
v <- checkAttr (decodeBS name) (toRawFilePath file)
|
||||
v <- checkAttr (decodeBS name) (toOsPath file)
|
||||
if null v
|
||||
then cont
|
||||
else showval "gitattributes" v
|
||||
|
|
|
|||
|
|
@ -9,7 +9,6 @@ module Command.ContentLocation where
|
|||
|
||||
import Command
|
||||
import Annex.Content
|
||||
import qualified Utility.RawFilePath as R
|
||||
|
||||
import qualified Data.ByteString.Char8 as B8
|
||||
|
||||
|
|
@ -23,10 +22,13 @@ cmd = noCommit $ noMessages $
|
|||
run :: () -> SeekInput -> String -> Annex Bool
|
||||
run _ _ p = do
|
||||
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
|
||||
where
|
||||
check f = ifM (liftIO (R.doesPathExist f))
|
||||
check f = ifM (liftIO (doesFileExist f))
|
||||
( return (Just f)
|
||||
, return Nothing
|
||||
)
|
||||
emit f = liftIO $ do
|
||||
B8.putStrLn $ fromOsPath f
|
||||
return True
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
- However, auto mode avoids unnecessary copies, and avoids getting or
|
||||
- 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
|
||||
ru <- case fto of
|
||||
FromOrToRemote (ToRemote dest) -> getru dest
|
||||
|
|
@ -90,7 +90,7 @@ start o fto si file key = do
|
|||
where
|
||||
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 $
|
||||
Command.Move.start lu fto Command.Move.RemoveNever si file key
|
||||
where
|
||||
|
|
|
|||
|
|
@ -119,7 +119,7 @@ fixupReq req@(Req {}) opts =
|
|||
maybe (return r) go (parseLinkTargetOrPointer =<< v)
|
||||
_ -> maybe (return r) go =<< liftIO (isPointerFile f)
|
||||
where
|
||||
f = toRawFilePath (getfile r)
|
||||
f = toOsPath (getfile r)
|
||||
go k = do
|
||||
when (getOption opts) $
|
||||
unlessM (inAnnex k) $
|
||||
|
|
@ -132,7 +132,7 @@ fixupReq req@(Req {}) opts =
|
|||
si = SeekInput []
|
||||
af = AssociatedFile (Just f)
|
||||
repoint k = withObjectLoc k $
|
||||
pure . setfile r . fromRawFilePath
|
||||
pure . setfile r . fromOsPath
|
||||
|
||||
externalDiffer :: String -> [String] -> Differ
|
||||
externalDiffer c ps = \req -> boolSystem c (map Param ps ++ serializeReq req )
|
||||
|
|
|
|||
|
|
@ -76,7 +76,7 @@ seek o = startConcurrency commandStages $ do
|
|||
where
|
||||
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
|
||||
where
|
||||
afile = AssociatedFile (Just file)
|
||||
|
|
|
|||
|
|
@ -17,7 +17,6 @@ import qualified Git
|
|||
import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused)
|
||||
import Annex.NumCopies
|
||||
import Annex.Content
|
||||
import qualified Utility.RawFilePath as R
|
||||
|
||||
cmd :: Command
|
||||
cmd = withAnnexOptions [jobsOption, jsonOptions] $
|
||||
|
|
@ -77,8 +76,8 @@ perform from numcopies mincopies key = case from of
|
|||
pcc = Command.Drop.PreferredContentChecked False
|
||||
ud = Command.Drop.DroppingUnused True
|
||||
|
||||
performOther :: (Key -> Git.Repo -> RawFilePath) -> Key -> CommandPerform
|
||||
performOther :: (Key -> Git.Repo -> OsPath) -> Key -> CommandPerform
|
||||
performOther filespec key = do
|
||||
f <- fromRepo $ filespec key
|
||||
pruneTmpWorkDirBefore f (liftIO . removeWhenExistsWith R.removeLink)
|
||||
pruneTmpWorkDirBefore f (liftIO . removeWhenExistsWith removeFile)
|
||||
next $ return True
|
||||
|
|
|
|||
|
|
@ -57,7 +57,7 @@ start _os = do
|
|||
Nothing -> giveup "Need user-id parameter."
|
||||
Just userid -> go userid
|
||||
else starting "enable-tor" ai si $ do
|
||||
gitannex <- liftIO programPath
|
||||
gitannex <- fromOsPath <$> liftIO programPath
|
||||
let ps = [Param (cmdname cmd), Param (show curruserid)]
|
||||
sucommand <- liftIO $ mkSuCommand gitannex ps
|
||||
cleanenv <- liftIO $ cleanStandaloneEnvironment
|
||||
|
|
@ -145,6 +145,6 @@ checkHiddenService = bracket setup cleanup go
|
|||
|
||||
haslistener sockfile = catchBoolIO $ do
|
||||
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
|
||||
return True
|
||||
|
|
|
|||
|
|
@ -39,7 +39,7 @@ optParser :: Parser ExamineOptions
|
|||
optParser = ExamineOptions
|
||||
<$> optional parseFormatOption
|
||||
<*> (fmap (DeferredParse . tobackend) <$> migrateopt)
|
||||
<*> (AssociatedFile <$> fileopt)
|
||||
<*> (AssociatedFile . fmap stringToOsPath <$> fileopt)
|
||||
where
|
||||
fileopt = optional $ strOption
|
||||
( long "filename" <> metavar paramFile
|
||||
|
|
@ -59,8 +59,8 @@ run o _ input = do
|
|||
let objectpointer = formatPointer k
|
||||
isterminal <- liftIO $ checkIsTerminal stdout
|
||||
showFormatted isterminal (format o) (serializeKey' k) $
|
||||
[ ("objectpath", fromRawFilePath objectpath)
|
||||
, ("objectpointer", fromRawFilePath objectpointer)
|
||||
[ ("objectpath", fromOsPath objectpath)
|
||||
, ("objectpointer", decodeBS objectpointer)
|
||||
] ++ formatVars k af
|
||||
return True
|
||||
where
|
||||
|
|
@ -71,7 +71,7 @@ run o _ input = do
|
|||
ik = fromMaybe (giveup "bad key") (deserializeKey' ikb)
|
||||
af = if B.null ifb'
|
||||
then associatedFile o
|
||||
else AssociatedFile (Just ifb')
|
||||
else AssociatedFile (Just (toOsPath ifb'))
|
||||
|
||||
getkey = case migrateToBackend o of
|
||||
Nothing -> pure ik
|
||||
|
|
|
|||
|
|
@ -78,8 +78,8 @@ optParser _ = ExportOptions
|
|||
-- To handle renames which swap files, the exported file is first renamed
|
||||
-- to a stable temporary name based on the key.
|
||||
exportTempName :: Key -> ExportLocation
|
||||
exportTempName ek = mkExportLocation $ toRawFilePath $
|
||||
".git-annex-tmp-content-" ++ serializeKey ek
|
||||
exportTempName ek = mkExportLocation $
|
||||
literalOsPath ".git-annex-tmp-content-" <> toOsPath (serializeKey'' ek)
|
||||
|
||||
seek :: ExportOptions -> CommandSeek
|
||||
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)
|
||||
then tryrenameannexobject $ sendannexobject
|
||||
-- Sending a non-annexed file.
|
||||
else withTmpFile (toOsPath "export") $ \tmp h -> do
|
||||
else withTmpFile (literalOsPath "export") $ \tmp h -> do
|
||||
b <- catObject contentsha
|
||||
liftIO $ L.hPut h b
|
||||
liftIO $ hClose h
|
||||
Remote.action $
|
||||
storer (fromRawFilePath (fromOsPath tmp)) ek loc nullMeterUpdate
|
||||
Remote.action $ storer tmp ek loc nullMeterUpdate
|
||||
let failedsend = liftIO $ modifyMVar_ allfilledvar (pure . const (AllFilled False))
|
||||
case sent of
|
||||
Right True -> next $ cleanupExport r db ek loc True
|
||||
|
|
|
|||
|
|
@ -27,13 +27,11 @@ import Git.Env
|
|||
import Git.UpdateIndex
|
||||
import qualified Git.LsTree as LsTree
|
||||
import qualified Git.Branch as Git
|
||||
import Utility.RawFilePath
|
||||
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.Set as S
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
import Data.ByteString.Builder
|
||||
import qualified System.FilePath.ByteString as P
|
||||
|
||||
cmd :: Command
|
||||
cmd = noMessages $ withAnnexOptions [annexedMatchingOptions] $
|
||||
|
|
@ -120,10 +118,10 @@ mkUUIDMatcher' sameasmap l = \u ->
|
|||
|
||||
seek :: FilterBranchOptions -> CommandSeek
|
||||
seek o = withOtherTmp $ \tmpdir -> do
|
||||
let tmpindex = tmpdir P.</> "index"
|
||||
let tmpindex = tmpdir </> literalOsPath "index"
|
||||
gc <- Annex.getGitConfig
|
||||
tmpindexrepo <- Annex.inRepo $ \r ->
|
||||
addGitEnv r indexEnv (fromRawFilePath tmpindex)
|
||||
addGitEnv r indexEnv (fromOsPath tmpindex)
|
||||
withUpdateIndex tmpindexrepo $ \h -> do
|
||||
keyinfomatcher <- mkUUIDMatcher (keyInformation o)
|
||||
repoconfigmatcher <- mkUUIDMatcher (repoConfig o)
|
||||
|
|
@ -186,7 +184,7 @@ seek o = withOtherTmp $ \tmpdir -> do
|
|||
|
||||
-- Commit the temporary index, and output the result.
|
||||
t <- liftIO $ Git.writeTree tmpindexrepo
|
||||
liftIO $ removeWhenExistsWith removeLink tmpindex
|
||||
liftIO $ removeWhenExistsWith removeFile tmpindex
|
||||
cmode <- annexCommitMode <$> Annex.getGitConfig
|
||||
cmessage <- Annex.Branch.commitMessage
|
||||
c <- inRepo $ Git.commitTree cmode [cmessage] [] t
|
||||
|
|
|
|||
|
|
@ -36,7 +36,7 @@ seek _ = liftIO longRunningFilterProcessHandshake >>= \case
|
|||
go
|
||||
Nothing -> return ()
|
||||
|
||||
smudge :: FilePath -> Annex ()
|
||||
smudge :: OsPath -> Annex ()
|
||||
smudge file = do
|
||||
{- The whole git file content is necessarily buffered in memory,
|
||||
- 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. -}
|
||||
liftIO $ respondFilterRequest b
|
||||
|
||||
clean :: FilePath -> Annex ()
|
||||
clean :: OsPath -> Annex ()
|
||||
clean file = do
|
||||
{- We have to consume everything git is sending before we can
|
||||
- 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
|
||||
-- hash the content provided by git, but Backend does not currently
|
||||
-- have an interface to do so.
|
||||
Command.Smudge.clean' (toRawFilePath file)
|
||||
Command.Smudge.clean' file
|
||||
(parseLinkTargetOrPointer' b)
|
||||
passthrough
|
||||
discardreststdin
|
||||
|
|
|
|||
|
|
@ -88,9 +88,9 @@ contentPresentUnlessLimited s = do
|
|||
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
|
||||
showFormatted isterminal (formatOption o) file
|
||||
showFormatted isterminal (formatOption o) (fromOsPath file)
|
||||
(formatVars key (AssociatedFile (Just file)))
|
||||
next $ return True
|
||||
|
||||
|
|
@ -113,14 +113,14 @@ showFormatted (IsTerminal isterminal) format unformatted vars =
|
|||
|
||||
formatVars :: Key -> AssociatedFile -> [(String, String)]
|
||||
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)
|
||||
, ("backend", decodeBS $ formatKeyVariety $ fromKey keyVariety key)
|
||||
, ("bytesize", size show)
|
||||
, ("humansize", size $ roughSize storageUnits True)
|
||||
, ("keyname", decodeBS $ S.fromShort $ fromKey keyName key)
|
||||
, ("hashdirlower", fromRawFilePath $ hashDirLower def key)
|
||||
, ("hashdirmixed", fromRawFilePath $ hashDirMixed def key)
|
||||
, ("hashdirlower", fromOsPath $ hashDirLower def key)
|
||||
, ("hashdirmixed", fromOsPath $ hashDirMixed def key)
|
||||
, ("mtime", whenavail show $ fromKey keyMtime key)
|
||||
]
|
||||
where
|
||||
|
|
|
|||
|
|
@ -55,7 +55,7 @@ seek o = startConcurrency transferStages $ do
|
|||
where
|
||||
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
|
||||
lu <- prepareLiveUpdate Nothing key AddingKey
|
||||
start' lu (expensivecheck lu) from key afile ai si
|
||||
|
|
|
|||
|
|
@ -24,7 +24,6 @@ import Data.Time.LocalTime
|
|||
import Control.Concurrent.STM
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as TE
|
||||
import qualified System.FilePath.ByteString as P
|
||||
import qualified Data.ByteString as B
|
||||
|
||||
import Command
|
||||
|
|
@ -158,7 +157,7 @@ getFeed o url st =
|
|||
| scrapeOption o = scrape
|
||||
| otherwise = get
|
||||
|
||||
get = withTmpFile (toOsPath "feed") $ \tmpf h -> do
|
||||
get = withTmpFile (literalOsPath "feed") $ \tmpf h -> do
|
||||
let tmpf' = fromRawFilePath $ fromOsPath tmpf
|
||||
liftIO $ hClose h
|
||||
ifM (downloadFeed url tmpf')
|
||||
|
|
@ -270,7 +269,7 @@ downloadFeed :: URLString -> FilePath -> Annex Bool
|
|||
downloadFeed url f
|
||||
| Url.parseURIRelaxed url == Nothing = giveup "invalid feed url"
|
||||
| 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 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)
|
||||
( startUrlDownload cv todownload linkurl $
|
||||
withTmpWorkDir mediakey $ \workdir -> do
|
||||
dl <- youtubeDl linkurl (fromRawFilePath workdir) nullMeterUpdate
|
||||
dl <- youtubeDl linkurl workdir nullMeterUpdate
|
||||
case dl of
|
||||
Right (Just mediafile) -> do
|
||||
let ext = case takeExtension mediafile of
|
||||
let ext = case fromOsPath (takeExtension mediafile) of
|
||||
[] -> ".m"
|
||||
s -> s
|
||||
runDownload todownload linkurl ext cache cv $ \f ->
|
||||
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])
|
||||
-- youtube-dl didn't support it, so
|
||||
-- download it as if the link were
|
||||
|
|
@ -353,15 +352,15 @@ startDownload addunlockedmatcher opts cache cv todownload = case location todown
|
|||
|
||||
downloadEnclosure :: AddUnlockedMatcher -> ImportFeedOptions -> Cache -> TMVar Bool -> ToDownload -> URLString -> CommandPerform
|
||||
downloadEnclosure addunlockedmatcher opts cache cv todownload url =
|
||||
runDownload todownload url (takeWhile (/= '?') $ takeExtension url) cache cv $ \f -> do
|
||||
let f' = fromRawFilePath f
|
||||
let extension = takeWhile (/= '?') $ fromOsPath $ takeExtension $ toOsPath url
|
||||
in runDownload todownload url extension cache cv $ \f -> do
|
||||
r <- checkClaimingUrl (downloadOptions opts) url
|
||||
if Remote.uuid r == webUUID || rawOption (downloadOptions opts)
|
||||
then checkRaw (Just url) (downloadOptions opts) (pure Nothing) $ do
|
||||
let dlopts = (downloadOptions opts)
|
||||
-- force using the filename
|
||||
-- chosen here
|
||||
{ fileOption = Just f'
|
||||
{ fileOption = Just (fromOsPath f)
|
||||
-- don't use youtube-dl
|
||||
, rawOption = True
|
||||
}
|
||||
|
|
@ -385,7 +384,7 @@ downloadEnclosure addunlockedmatcher opts cache cv todownload url =
|
|||
downloadRemoteFile addunlockedmatcher r (downloadOptions opts) url f sz
|
||||
Right (UrlMulti l) -> do
|
||||
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
|
||||
return $ Just $ if all isJust kl
|
||||
then catMaybes kl
|
||||
|
|
@ -397,7 +396,7 @@ runDownload
|
|||
-> String
|
||||
-> Cache
|
||||
-> TMVar Bool
|
||||
-> (RawFilePath -> Annex (Maybe [Key]))
|
||||
-> (OsPath -> Annex (Maybe [Key]))
|
||||
-> CommandPerform
|
||||
runDownload todownload url extension cache cv getter = do
|
||||
dest <- makeunique (1 :: Integer) $
|
||||
|
|
@ -406,7 +405,7 @@ runDownload todownload url extension cache cv getter = do
|
|||
Nothing -> do
|
||||
recordsuccess
|
||||
next $ return True
|
||||
Just f -> getter (toRawFilePath f) >>= \case
|
||||
Just f -> getter f >>= \case
|
||||
Just ks
|
||||
-- Download problem.
|
||||
| null ks -> do
|
||||
|
|
@ -440,7 +439,7 @@ runDownload todownload url extension cache cv getter = do
|
|||
- to be re-downloaded. -}
|
||||
makeunique n file = ifM alreadyexists
|
||||
( ifM forced
|
||||
( lookupKey (toRawFilePath f) >>= \case
|
||||
( lookupKey f >>= \case
|
||||
Just k -> checksameurl k
|
||||
Nothing -> tryanother
|
||||
, tryanother
|
||||
|
|
@ -449,12 +448,12 @@ runDownload todownload url extension cache cv getter = do
|
|||
)
|
||||
where
|
||||
f = if n < 2
|
||||
then file
|
||||
then toOsPath file
|
||||
else
|
||||
let (d, base) = splitFileName file
|
||||
in d </> show n ++ "_" ++ base
|
||||
let (d, base) = splitFileName (toOsPath file)
|
||||
in d </> toOsPath (show n ++ "_") <> base
|
||||
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)
|
||||
( return Nothing
|
||||
, tryanother
|
||||
|
|
@ -609,10 +608,10 @@ feedProblem url message = ifM (checkFeedBroken url)
|
|||
- least 23 hours. -}
|
||||
checkFeedBroken :: URLString -> Annex Bool
|
||||
checkFeedBroken url = checkFeedBroken' url =<< feedState url
|
||||
checkFeedBroken' :: URLString -> RawFilePath -> Annex Bool
|
||||
checkFeedBroken' :: URLString -> OsPath -> Annex Bool
|
||||
checkFeedBroken' url f = do
|
||||
prev <- maybe Nothing readish
|
||||
<$> liftIO (catchMaybeIO $ readFile (fromRawFilePath f))
|
||||
<$> liftIO (catchMaybeIO $ readFile (fromOsPath f))
|
||||
now <- liftIO getCurrentTime
|
||||
case prev of
|
||||
Nothing -> do
|
||||
|
|
@ -628,10 +627,9 @@ checkFeedBroken' url f = do
|
|||
|
||||
clearFeedProblem :: URLString -> Annex ()
|
||||
clearFeedProblem url =
|
||||
void $ liftIO . tryIO . removeFile . fromRawFilePath
|
||||
=<< feedState url
|
||||
void $ liftIO . tryIO . removeFile =<< feedState url
|
||||
|
||||
feedState :: URLString -> Annex RawFilePath
|
||||
feedState :: URLString -> Annex OsPath
|
||||
feedState url = fromRepo $ gitAnnexFeedState $ fromUrl url Nothing False
|
||||
|
||||
{- The feed library parses the feed to Text, and does not use the
|
||||
|
|
|
|||
|
|
@ -57,7 +57,7 @@ seek o = startConcurrency stages $
|
|||
, 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)
|
||||
where
|
||||
afile = AssociatedFile (Just file)
|
||||
|
|
|
|||
|
|
@ -94,7 +94,7 @@ stages ToHere = transferStages
|
|||
stages (FromRemoteToRemote _ _) = 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
|
||||
where
|
||||
afile = AssociatedFile (Just f)
|
||||
|
|
|
|||
|
|
@ -67,7 +67,7 @@ seek o = do
|
|||
where
|
||||
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 =
|
||||
startKeys o remotemap (si, key, mkActionItem (key, afile))
|
||||
where
|
||||
|
|
|
|||
|
|
@ -52,11 +52,11 @@ checkIgnoreStop :: CheckIgnoreHandle -> IO ()
|
|||
checkIgnoreStop = void . tryIO . CoProcess.stop
|
||||
|
||||
{- 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 "")
|
||||
where
|
||||
send to = do
|
||||
B.hPutStr to $ file `B.snoc` 0
|
||||
B.hPutStr to $ fromOsPath file `B.snoc` 0
|
||||
hFlush to
|
||||
receive c from = do
|
||||
s <- hGetSomeString from 1024
|
||||
|
|
@ -68,4 +68,4 @@ checkIgnored h file = CoProcess.query h send (receive "")
|
|||
parse s = case segment (== '\0') s of
|
||||
(_source:_line:pattern:_pathname:_eol:[]) -> Just $ not $ null pattern
|
||||
_ -> Nothing
|
||||
eofError = ioError $ mkIOError userErrorType "git cat-file EOF" Nothing Nothing
|
||||
eofError = ioError $ mkIOError userErrorType "git check-ignore EOF" Nothing Nothing
|
||||
|
|
|
|||
|
|
@ -130,7 +130,7 @@ longRunningFilterProcessHandshake =
|
|||
-- Delay capability is not implemented, so filter it out.
|
||||
filtercapabilities = filter (`elem` [Capability "smudge", Capability "clean"])
|
||||
|
||||
data FilterRequest = Smudge FilePath | Clean FilePath
|
||||
data FilterRequest = Smudge OsPath | Clean OsPath
|
||||
deriving (Show, Eq)
|
||||
|
||||
{- Waits for the next FilterRequest to be received. Does not read
|
||||
|
|
@ -143,8 +143,8 @@ getFilterRequest = do
|
|||
let cs = mapMaybe decodeConfigValue ps
|
||||
case (extractConfigValue cs "command", extractConfigValue cs "pathname") of
|
||||
(Just command, Just pathname)
|
||||
| command == "smudge" -> return $ Just $ Smudge pathname
|
||||
| command == "clean" -> return $ Just $ Clean pathname
|
||||
| command == "smudge" -> return $ Just $ Smudge $ toOsPath pathname
|
||||
| command == "clean" -> return $ Just $ Clean $ toOsPath pathname
|
||||
| otherwise -> return Nothing
|
||||
_ -> return Nothing
|
||||
|
||||
|
|
|
|||
|
|
@ -7,6 +7,7 @@
|
|||
-}
|
||||
|
||||
{-# LANGUAGE OverloadedStrings, TypeSynonymInstances #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module Git.Quote (
|
||||
unquote,
|
||||
|
|
@ -71,6 +72,12 @@ instance Quoteable RawFilePath where
|
|||
|
||||
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.
|
||||
-- With OverloadedStrings, strings are passed through without quoting.
|
||||
-- Eg: QuotedPath f <> ": not found"
|
||||
|
|
|
|||
|
|
@ -8,6 +8,7 @@
|
|||
-}
|
||||
|
||||
{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module Utility.Aeson (
|
||||
module X,
|
||||
|
|
@ -32,6 +33,9 @@ import qualified Data.Vector
|
|||
import Prelude
|
||||
|
||||
import Utility.FileSystemEncoding
|
||||
#ifdef WITH_OSPATH
|
||||
import Utility.OsPath
|
||||
#endif
|
||||
|
||||
-- | Use this instead of Data.Aeson.encode to make sure that the
|
||||
-- below String instance is used.
|
||||
|
|
@ -60,6 +64,11 @@ instance ToJSON' String where
|
|||
instance ToJSON' S.ByteString where
|
||||
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.
|
||||
--
|
||||
-- Use this instead of Data.Text.pack.
|
||||
|
|
|
|||
|
|
@ -14,7 +14,6 @@ module Utility.HtmlDetect (
|
|||
|
||||
import Author
|
||||
import qualified Utility.FileIO as F
|
||||
import Utility.RawFilePath
|
||||
import Utility.OsPath
|
||||
|
||||
import Text.HTML.TagSoup
|
||||
|
|
@ -60,8 +59,8 @@ isHtmlBs = isHtml . B8.unpack
|
|||
-- It would be equivalent to use isHtml <$> readFile file,
|
||||
-- but since that would not read all of the file, the handle
|
||||
-- would remain open until it got garbage collected sometime later.
|
||||
isHtmlFile :: RawFilePath -> IO Bool
|
||||
isHtmlFile file = F.withFile (toOsPath file) ReadMode $ \h ->
|
||||
isHtmlFile :: OsPath -> IO Bool
|
||||
isHtmlFile file = F.withFile file ReadMode $ \h ->
|
||||
isHtmlBs <$> B.hGet h htmlPrefixLength
|
||||
|
||||
-- | How much of the beginning of a html document is needed to detect it.
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue