more OsPath conversion (502/749)
Sponsored-by: Kevin Mueller on Patreon
This commit is contained in:
Joey Hess
parent
b28433072c
commit
0b9e9cbf70
15 changed files with 147 additions and 149 deletions
|
|
@ -12,7 +12,6 @@ module Remote.Bup (remote) where
|
|||
import qualified Data.Map as M
|
||||
import qualified Data.ByteString as S
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
import qualified System.FilePath.ByteString as P
|
||||
import Data.ByteString.Lazy.UTF8 (fromString)
|
||||
import Control.Concurrent.Async
|
||||
|
||||
|
|
@ -96,12 +95,12 @@ gen r u rc gc rs = do
|
|||
, getRepo = return r
|
||||
, gitconfig = gc
|
||||
, localpath = if bupLocal buprepo && not (null buprepo)
|
||||
then Just buprepo
|
||||
then Just (toOsPath buprepo)
|
||||
else Nothing
|
||||
, remotetype = remote
|
||||
, availability = if null buprepo
|
||||
then pure LocallyAvailable
|
||||
else checkPathAvailability (bupLocal buprepo) buprepo
|
||||
else checkPathAvailability (bupLocal buprepo) (toOsPath buprepo)
|
||||
, readonly = False
|
||||
, appendonly = False
|
||||
, untrustworthy = False
|
||||
|
|
@ -270,7 +269,7 @@ onBupRemote r runner command params = do
|
|||
(sshcmd, sshparams) <- Ssh.toRepo NoConsumeStdin r c remotecmd
|
||||
liftIO $ runner sshcmd sshparams
|
||||
where
|
||||
path = fromRawFilePath $ Git.repoPath r
|
||||
path = fromOsPath $ Git.repoPath r
|
||||
base = fromMaybe path (stripPrefix "/~/" path)
|
||||
dir = shellEscape base
|
||||
|
||||
|
|
@ -299,11 +298,11 @@ bup2GitRemote :: BupRepo -> IO Git.Repo
|
|||
bup2GitRemote "" = do
|
||||
-- bup -r "" operates on ~/.bup
|
||||
h <- myHomeDir
|
||||
Git.Construct.fromPath $ toRawFilePath $ h </> ".bup"
|
||||
Git.Construct.fromPath $ toOsPath h </> literalOsPath ".bup"
|
||||
bup2GitRemote r
|
||||
| bupLocal r =
|
||||
if "/" `isPrefixOf` r
|
||||
then Git.Construct.fromPath (toRawFilePath r)
|
||||
then Git.Construct.fromPath (toOsPath r)
|
||||
else giveup "please specify an absolute path"
|
||||
| otherwise = Git.Construct.fromUrl $ "ssh://" ++ host ++ slash dir
|
||||
where
|
||||
|
|
@ -335,10 +334,10 @@ bupLocal = notElem ':'
|
|||
lockBup :: Bool -> Remote -> Annex a -> Annex a
|
||||
lockBup writer r a = do
|
||||
dir <- fromRepo gitAnnexRemotesDir
|
||||
unlessM (liftIO $ doesDirectoryExist (fromRawFilePath dir)) $
|
||||
unlessM (liftIO $ doesDirectoryExist dir) $
|
||||
createAnnexDirectory dir
|
||||
let remoteid = fromUUID (uuid r)
|
||||
let lck = dir P.</> remoteid <> ".lck"
|
||||
let lck = dir </> remoteid <> literalOsPath ".lck"
|
||||
if writer
|
||||
then withExclusiveLock lck a
|
||||
else withSharedLock lck a
|
||||
|
|
|
|||
|
|
@ -20,8 +20,6 @@ module Remote.GCrypt (
|
|||
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.ByteString as S
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
import qualified System.FilePath.ByteString as P
|
||||
import Data.Default
|
||||
|
||||
import Annex.Common
|
||||
|
|
@ -51,16 +49,17 @@ import Utility.Metered
|
|||
import Annex.UUID
|
||||
import Annex.Ssh
|
||||
import Annex.Perms
|
||||
import Messages.Progress
|
||||
import Types.ProposedAccepted
|
||||
import Logs.Remote
|
||||
import qualified Remote.Rsync
|
||||
import qualified Remote.Directory
|
||||
import Utility.Rsync
|
||||
import Utility.Tmp
|
||||
import Logs.Remote
|
||||
import Utility.Gpg
|
||||
import Utility.SshHost
|
||||
import Utility.Directory.Create
|
||||
import Messages.Progress
|
||||
import Types.ProposedAccepted
|
||||
import qualified Utility.FileIO as F
|
||||
|
||||
remote :: RemoteType
|
||||
remote = specialRemoteType $ RemoteType
|
||||
|
|
@ -304,10 +303,10 @@ setupRepo gcryptid r
|
|||
- which is needed for rsync of objects to it to work.
|
||||
-}
|
||||
rsyncsetup = Remote.Rsync.withRsyncScratchDir $ \tmp -> do
|
||||
createAnnexDirectory (toRawFilePath tmp P.</> objectDir)
|
||||
createAnnexDirectory (tmp </> objectDir)
|
||||
dummycfg <- liftIO dummyRemoteGitConfig
|
||||
let (rsynctransport, rsyncurl, _) = rsyncTransport r dummycfg
|
||||
let tmpconfig = tmp </> "config"
|
||||
let tmpconfig = fromOsPath $ tmp </> literalOsPath "config"
|
||||
opts <- rsynctransport
|
||||
void $ liftIO $ rsync $ opts ++
|
||||
[ Param $ rsyncurl ++ "/config"
|
||||
|
|
@ -318,7 +317,7 @@ setupRepo gcryptid r
|
|||
void $ Git.Config.changeFile tmpconfig denyNonFastForwards (Git.Config.boolConfig' False)
|
||||
ok <- liftIO $ rsync $ opts ++
|
||||
[ Param "--recursive"
|
||||
, Param $ tmp ++ "/"
|
||||
, Param $ fromOsPath tmp ++ "/"
|
||||
, Param rsyncurl
|
||||
]
|
||||
unless ok $
|
||||
|
|
@ -388,17 +387,18 @@ store' :: Git.Repo -> Remote -> Remote.Rsync.RsyncOpts -> AccessMethod -> Storer
|
|||
store' repo r rsyncopts accessmethod
|
||||
| not $ Git.repoIsUrl repo =
|
||||
byteStorer $ \k b p -> guardUsable repo (giveup "cannot access remote") $ liftIO $ do
|
||||
let tmpdir = Git.repoPath repo P.</> "tmp" P.</> keyFile k
|
||||
let tmpdir = Git.repoPath repo </> literalOsPath "tmp" </> keyFile k
|
||||
void $ tryIO $ createDirectoryUnder [Git.repoPath repo] tmpdir
|
||||
let tmpf = tmpdir P.</> keyFile k
|
||||
meteredWriteFile p (fromRawFilePath tmpf) b
|
||||
let destdir = parentDir $ toRawFilePath $ gCryptLocation repo k
|
||||
let tmpf = tmpdir </> keyFile k
|
||||
meteredWriteFile p tmpf b
|
||||
let destdir = parentDir $ gCryptLocation repo k
|
||||
Remote.Directory.finalizeStoreGeneric (Git.repoPath repo) tmpdir destdir
|
||||
| Git.repoIsSsh repo = if accessShell r
|
||||
then fileStorer $ \k f p -> do
|
||||
oh <- mkOutputHandler
|
||||
ok <- Ssh.rsyncHelper oh (Just p)
|
||||
=<< Ssh.rsyncParamsRemote r Upload k f
|
||||
=<< Ssh.rsyncParamsRemote r Upload k
|
||||
(fromOsPath f)
|
||||
unless ok $
|
||||
giveup "rsync failed"
|
||||
else storersync
|
||||
|
|
@ -416,11 +416,11 @@ retrieve' :: Git.Repo -> Remote -> Remote.Rsync.RsyncOpts -> AccessMethod -> Ret
|
|||
retrieve' repo r rsyncopts accessmethod
|
||||
| not $ Git.repoIsUrl repo = byteRetriever $ \k sink ->
|
||||
guardUsable repo (giveup "cannot access remote") $
|
||||
sink =<< liftIO (L.readFile $ gCryptLocation repo k)
|
||||
sink =<< liftIO (F.readFile $ gCryptLocation repo k)
|
||||
| Git.repoIsSsh repo = if accessShell r
|
||||
then fileRetriever $ \f k p -> do
|
||||
ps <- Ssh.rsyncParamsRemote r Download k
|
||||
(fromRawFilePath f)
|
||||
(fromOsPath f)
|
||||
oh <- mkOutputHandler
|
||||
unlessM (Ssh.rsyncHelper oh (Just p) ps) $
|
||||
giveup "rsync failed"
|
||||
|
|
@ -439,8 +439,8 @@ remove' :: Git.Repo -> Remote -> Remote.Rsync.RsyncOpts -> AccessMethod -> Remov
|
|||
remove' repo r rsyncopts accessmethod proof k
|
||||
| not $ Git.repoIsUrl repo = guardUsable repo (giveup "cannot access remote") $
|
||||
liftIO $ Remote.Directory.removeDirGeneric True
|
||||
(toRawFilePath (gCryptTopDir repo))
|
||||
(parentDir (toRawFilePath (gCryptLocation repo k)))
|
||||
(gCryptTopDir repo)
|
||||
(parentDir (gCryptLocation repo k))
|
||||
| Git.repoIsSsh repo = shellOrRsync r removeshell removersync
|
||||
| accessmethod == AccessRsyncOverSsh = removersync
|
||||
| otherwise = unsupportedUrl
|
||||
|
|
@ -465,14 +465,14 @@ checkKey' repo r rsyncopts accessmethod k
|
|||
checkrsync = Remote.Rsync.checkKey rsyncopts k
|
||||
checkshell = Ssh.inAnnex repo k
|
||||
|
||||
gCryptTopDir :: Git.Repo -> FilePath
|
||||
gCryptTopDir repo = Git.repoLocation repo </> fromRawFilePath objectDir
|
||||
gCryptTopDir :: Git.Repo -> OsPath
|
||||
gCryptTopDir repo = toOsPath (Git.repoLocation repo) </> objectDir
|
||||
|
||||
{- Annexed objects are hashed using lower-case directories for max
|
||||
- portability. -}
|
||||
gCryptLocation :: Git.Repo -> Key -> FilePath
|
||||
gCryptLocation :: Git.Repo -> Key -> OsPath
|
||||
gCryptLocation repo key = gCryptTopDir repo
|
||||
</> fromRawFilePath (keyPath key (hashDirLower def))
|
||||
</> keyPath key (hashDirLower def)
|
||||
|
||||
data AccessMethod = AccessRsyncOverSsh | AccessGitAnnexShell
|
||||
deriving (Eq)
|
||||
|
|
@ -529,8 +529,8 @@ getConfigViaRsync r gc = do
|
|||
let (rsynctransport, rsyncurl, _) = rsyncTransport r gc
|
||||
opts <- rsynctransport
|
||||
liftIO $ do
|
||||
withTmpFile (toOsPath "tmpconfig") $ \tmpconfig _ -> do
|
||||
let tmpconfig' = fromRawFilePath $ fromOsPath tmpconfig
|
||||
withTmpFile (literalOsPath "tmpconfig") $ \tmpconfig _ -> do
|
||||
let tmpconfig' = fromOsPath tmpconfig
|
||||
void $ rsync $ opts ++
|
||||
[ Param $ rsyncurl ++ "/config"
|
||||
, Param tmpconfig'
|
||||
|
|
|
|||
|
|
@ -49,6 +49,7 @@ import Logs.Cluster.Basic
|
|||
import Utility.Metered
|
||||
import Utility.Env
|
||||
import Utility.Batch
|
||||
import qualified Utility.FileIO as F
|
||||
import Remote.Helper.Git
|
||||
import Remote.Helper.Messages
|
||||
import Remote.Helper.ExportImport
|
||||
|
|
@ -324,10 +325,9 @@ tryGitConfigRead autoinit r hasuuid
|
|||
|
||||
geturlconfig = Url.withUrlOptionsPromptingCreds $ \uo -> do
|
||||
let url = Git.repoLocation r ++ "/config"
|
||||
v <- withTmpFile (toOsPath "git-annex.tmp") $ \tmpfile h -> do
|
||||
v <- withTmpFile (literalOsPath "git-annex.tmp") $ \tmpfile h -> do
|
||||
liftIO $ hClose h
|
||||
let tmpfile' = fromRawFilePath $ fromOsPath tmpfile
|
||||
Url.download' nullMeterUpdate Nothing url tmpfile' uo >>= \case
|
||||
Url.download' nullMeterUpdate Nothing url tmpfile uo >>= \case
|
||||
Right () ->
|
||||
pipedconfig Git.Config.ConfigNullList
|
||||
False url "git"
|
||||
|
|
@ -335,7 +335,7 @@ tryGitConfigRead autoinit r hasuuid
|
|||
, Param "--null"
|
||||
, Param "--list"
|
||||
, Param "--file"
|
||||
, File tmpfile'
|
||||
, File (fromOsPath tmpfile)
|
||||
] >>= return . \case
|
||||
Right r' -> Right r'
|
||||
Left exitcode -> Left $ "git config exited " ++ show exitcode
|
||||
|
|
@ -470,9 +470,9 @@ keyUrls gc repo r key = map tourl locs'
|
|||
| remoteAnnexBare remoteconfig == Just False = annexLocationsNonBare gc key
|
||||
| otherwise = annexLocationsBare gc key
|
||||
#ifndef mingw32_HOST_OS
|
||||
locs' = map fromRawFilePath locs
|
||||
locs' = map fromOsPath locs
|
||||
#else
|
||||
locs' = map (replace "\\" "/" . fromRawFilePath) locs
|
||||
locs' = map (replace "\\" "/" . fromOsPath) locs
|
||||
#endif
|
||||
remoteconfig = gitconfig r
|
||||
|
||||
|
|
@ -560,12 +560,12 @@ lockKey' repo r st@(State connpool duc _ _ _) key callback
|
|||
failedlock = giveup "can't lock content"
|
||||
|
||||
{- Tries to copy a key's content from a remote's annex to a file. -}
|
||||
copyFromRemote :: Remote -> State -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification
|
||||
copyFromRemote :: Remote -> State -> Key -> AssociatedFile -> OsPath -> MeterUpdate -> VerifyConfig -> Annex Verification
|
||||
copyFromRemote r st key file dest meterupdate vc = do
|
||||
repo <- getRepo r
|
||||
copyFromRemote'' repo r st key file dest meterupdate vc
|
||||
|
||||
copyFromRemote'' :: Git.Repo -> Remote -> State -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification
|
||||
copyFromRemote'' :: Git.Repo -> Remote -> State -> Key -> AssociatedFile -> OsPath -> MeterUpdate -> VerifyConfig -> Annex Verification
|
||||
copyFromRemote'' repo r st@(State connpool _ _ _ _) key af dest meterupdate vc
|
||||
| isP2PHttp r = copyp2phttp
|
||||
| Git.repoIsHttp repo = verifyKeyContentIncrementally vc key $ \iv -> do
|
||||
|
|
@ -603,9 +603,8 @@ copyFromRemote'' repo r st@(State connpool _ _ _ _) key af dest meterupdate vc
|
|||
<|> remoteAnnexBwLimit (gitconfig r)
|
||||
|
||||
copyp2phttp = verifyKeyContentIncrementally vc key $ \iv -> do
|
||||
startsz <- liftIO $ tryWhenExists $
|
||||
getFileSize (toRawFilePath dest)
|
||||
bracketIO (openBinaryFile dest ReadWriteMode) (hClose) $ \h -> do
|
||||
startsz <- liftIO $ tryWhenExists $ getFileSize dest
|
||||
bracketIO (F.openBinaryFile dest ReadWriteMode) (hClose) $ \h -> do
|
||||
metered (Just meterupdate) key bwlimit $ \_ p -> do
|
||||
p' <- case startsz of
|
||||
Just startsz' -> liftIO $ do
|
||||
|
|
@ -617,16 +616,18 @@ copyFromRemote'' repo r st@(State connpool _ _ _ _) key af dest meterupdate vc
|
|||
Valid -> return ()
|
||||
Invalid -> giveup "Transfer failed"
|
||||
|
||||
copyFromRemoteCheap :: State -> Git.Repo -> Maybe (Key -> AssociatedFile -> FilePath -> Annex ())
|
||||
copyFromRemoteCheap :: State -> Git.Repo -> Maybe (Key -> AssociatedFile -> OsPath -> Annex ())
|
||||
#ifndef mingw32_HOST_OS
|
||||
copyFromRemoteCheap st repo
|
||||
| not $ Git.repoIsUrl repo = Just $ \key _af file -> guardUsable repo (giveup "cannot access remote") $ do
|
||||
gc <- getGitConfigFromState st
|
||||
loc <- liftIO $ gitAnnexLocation key repo gc
|
||||
liftIO $ ifM (R.doesPathExist loc)
|
||||
liftIO $ ifM (doesFileExist loc)
|
||||
( do
|
||||
absloc <- absPath loc
|
||||
R.createSymbolicLink absloc (toRawFilePath file)
|
||||
R.createSymbolicLink
|
||||
(fromOsPath absloc)
|
||||
(fromOsPath file)
|
||||
, giveup "remote does not contain key"
|
||||
)
|
||||
| otherwise = Nothing
|
||||
|
|
@ -635,12 +636,12 @@ copyFromRemoteCheap _ _ = Nothing
|
|||
#endif
|
||||
|
||||
{- Tries to copy a key's content to a remote's annex. -}
|
||||
copyToRemote :: Remote -> State -> Key -> AssociatedFile -> Maybe FilePath -> MeterUpdate -> Annex ()
|
||||
copyToRemote :: Remote -> State -> Key -> AssociatedFile -> Maybe OsPath -> MeterUpdate -> Annex ()
|
||||
copyToRemote r st key af o meterupdate = do
|
||||
repo <- getRepo r
|
||||
copyToRemote' repo r st key af o meterupdate
|
||||
|
||||
copyToRemote' :: Git.Repo -> Remote -> State -> Key -> AssociatedFile -> Maybe FilePath -> MeterUpdate -> Annex ()
|
||||
copyToRemote' :: Git.Repo -> Remote -> State -> Key -> AssociatedFile -> Maybe OsPath -> MeterUpdate -> Annex ()
|
||||
copyToRemote' repo r st@(State connpool duc _ _ _) key af o meterupdate
|
||||
| isP2PHttp r = prepsendwith copyp2phttp
|
||||
| not $ Git.repoIsUrl repo = ifM duc
|
||||
|
|
@ -683,7 +684,7 @@ copyToRemote' repo r st@(State connpool duc _ _ _) key af o meterupdate
|
|||
Nothing -> return True
|
||||
logStatusAfter NoLiveUpdate key $ Annex.Content.getViaTmp rsp verify key af (Just sz) $ \dest ->
|
||||
metered (Just (combineMeterUpdate meterupdate p)) key bwlimit $ \_ p' ->
|
||||
copier object (fromRawFilePath dest) key p' checksuccess verify
|
||||
copier object dest key p' checksuccess verify
|
||||
)
|
||||
unless res $
|
||||
failedsend
|
||||
|
|
@ -719,10 +720,12 @@ fsckOnRemote r params
|
|||
r' <- Git.Config.read r
|
||||
environ <- getEnvironment
|
||||
let environ' = addEntries
|
||||
[ ("GIT_WORK_TREE", fromRawFilePath $ Git.repoPath r')
|
||||
, ("GIT_DIR", fromRawFilePath $ Git.localGitDir r')
|
||||
[ ("GIT_WORK_TREE", fromOsPath $ Git.repoPath r')
|
||||
, ("GIT_DIR", fromOsPath $ Git.localGitDir r')
|
||||
] environ
|
||||
batchCommandEnv program (Param "fsck" : params) (Just environ')
|
||||
batchCommandEnv (fromOsPath program)
|
||||
(Param "fsck" : params)
|
||||
(Just environ')
|
||||
|
||||
{- The passed repair action is run in the Annex monad of the remote. -}
|
||||
repairRemote :: Git.Repo -> Annex Bool -> Annex (IO Bool)
|
||||
|
|
@ -816,7 +819,7 @@ wantHardLink = (annexHardLink <$> Annex.getGitConfig)
|
|||
-- because they can be modified at any time.
|
||||
<&&> (not <$> annexThin <$> Annex.getGitConfig)
|
||||
|
||||
type FileCopier = FilePath -> FilePath -> Key -> MeterUpdate -> Annex Bool -> VerifyConfig -> Annex (Bool, Verification)
|
||||
type FileCopier = OsPath -> OsPath -> Key -> MeterUpdate -> Annex Bool -> VerifyConfig -> Annex (Bool, Verification)
|
||||
|
||||
-- If either the remote or local repository wants to use hard links,
|
||||
-- the copier will do so (falling back to copying if a hard link cannot be
|
||||
|
|
@ -829,14 +832,14 @@ type FileCopier = FilePath -> FilePath -> Key -> MeterUpdate -> Annex Bool -> Ve
|
|||
mkFileCopier :: Bool -> State -> Annex FileCopier
|
||||
mkFileCopier remotewanthardlink (State _ _ copycowtried _ _) = do
|
||||
localwanthardlink <- wantHardLink
|
||||
let linker = \src dest -> R.createLink (toRawFilePath src) (toRawFilePath dest) >> return True
|
||||
let linker = \src dest -> R.createLink (fromOsPath src) (fromOsPath dest) >> return True
|
||||
if remotewanthardlink || localwanthardlink
|
||||
then return $ \src dest k p check verifyconfig ->
|
||||
ifM (liftIO (catchBoolIO (linker src dest)))
|
||||
( ifM check
|
||||
( return (True, Verified)
|
||||
, do
|
||||
verificationOfContentFailed (toRawFilePath dest)
|
||||
verificationOfContentFailed dest
|
||||
return (False, UnVerified)
|
||||
)
|
||||
, copier src dest k p check verifyconfig
|
||||
|
|
@ -845,11 +848,11 @@ mkFileCopier remotewanthardlink (State _ _ copycowtried _ _) = do
|
|||
where
|
||||
copier src dest k p check verifyconfig = do
|
||||
iv <- startVerifyKeyContentIncrementally verifyconfig k
|
||||
liftIO (fileCopier copycowtried src dest p iv) >>= \case
|
||||
liftIO (fileCopier copycowtried (fromOsPath src) (fromOsPath dest) p iv) >>= \case
|
||||
Copied -> ifM check
|
||||
( finishVerifyKeyContentIncrementally iv
|
||||
, do
|
||||
verificationOfContentFailed (toRawFilePath dest)
|
||||
verificationOfContentFailed dest
|
||||
return (False, UnVerified)
|
||||
)
|
||||
CopiedCoW -> unVerified check
|
||||
|
|
|
|||
|
|
@ -20,6 +20,7 @@ import Types.NumCopies
|
|||
import qualified Annex
|
||||
import qualified Git
|
||||
import qualified Git.Types as Git
|
||||
import qualified Git.Config
|
||||
import qualified Git.Url
|
||||
import qualified Git.Remote
|
||||
import qualified Git.GCrypt
|
||||
|
|
@ -36,12 +37,12 @@ import Annex.Ssh
|
|||
import Annex.UUID
|
||||
import Crypto
|
||||
import Backend.Hash
|
||||
import Logs.Remote
|
||||
import Logs.RemoteState
|
||||
import Utility.Hash
|
||||
import Utility.SshHost
|
||||
import Utility.Url
|
||||
import Logs.Remote
|
||||
import Logs.RemoteState
|
||||
import qualified Git.Config
|
||||
import qualified Utility.FileIO as F
|
||||
|
||||
import qualified Network.GitLFS as LFS
|
||||
import Control.Concurrent.STM
|
||||
|
|
@ -380,7 +381,7 @@ extractKeySize k
|
|||
| isEncKey k = Nothing
|
||||
| otherwise = fromKey keySize k
|
||||
|
||||
mkUploadRequest :: RemoteStateHandle -> Key -> FilePath -> Annex (LFS.TransferRequest, LFS.SHA256, Integer)
|
||||
mkUploadRequest :: RemoteStateHandle -> Key -> OsPath -> Annex (LFS.TransferRequest, LFS.SHA256, Integer)
|
||||
mkUploadRequest rs k content = case (extractKeySha256 k, extractKeySize k) of
|
||||
(Just sha256, Just size) ->
|
||||
ret sha256 size
|
||||
|
|
@ -390,11 +391,11 @@ mkUploadRequest rs k content = case (extractKeySha256 k, extractKeySize k) of
|
|||
ret sha256 size
|
||||
_ -> do
|
||||
sha256 <- calcsha256
|
||||
size <- liftIO $ getFileSize (toRawFilePath content)
|
||||
size <- liftIO $ getFileSize content
|
||||
rememberboth sha256 size
|
||||
ret sha256 size
|
||||
where
|
||||
calcsha256 = liftIO $ T.pack . show . sha2_256 <$> L.readFile content
|
||||
calcsha256 = liftIO $ T.pack . show . sha2_256 <$> F.readFile content
|
||||
ret sha256 size = do
|
||||
let obj = LFS.TransferRequestObject
|
||||
{ LFS.req_oid = sha256
|
||||
|
|
@ -497,7 +498,7 @@ retrieve rs h = fileRetriever' $ \dest k p iv -> getLFSEndpoint LFS.RequestDownl
|
|||
Nothing -> giveup "unable to parse git-lfs server download url"
|
||||
Just req -> do
|
||||
uo <- getUrlOptions
|
||||
liftIO $ downloadConduit p iv req (fromRawFilePath dest) uo
|
||||
liftIO $ downloadConduit p iv req dest uo
|
||||
|
||||
-- Since git-lfs does not support removing content, nothing needs to be
|
||||
-- done to lock content in the remote, except for checking that the content
|
||||
|
|
|
|||
|
|
@ -53,7 +53,7 @@ storeFanout lu k logstatus remoteuuid us =
|
|||
when (u /= remoteuuid) $
|
||||
logChange lu k u logstatus
|
||||
|
||||
retrieve :: RemoteGitConfig -> (ProtoRunner (Bool, Verification)) -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification
|
||||
retrieve :: RemoteGitConfig -> (ProtoRunner (Bool, Verification)) -> Key -> AssociatedFile -> OsPath -> MeterUpdate -> VerifyConfig -> Annex Verification
|
||||
retrieve gc runner k af dest p verifyconfig = do
|
||||
iv <- startVerifyKeyContentIncrementally verifyconfig k
|
||||
let bwlimit = remoteAnnexBwLimitDownload gc <|> remoteAnnexBwLimit gc
|
||||
|
|
|
|||
|
|
@ -66,7 +66,7 @@ git_annex_shell cs r command params fields
|
|||
let params' = case (debugenabled, debugselector) of
|
||||
(True, NoDebugSelector) -> Param "--debug" : params
|
||||
_ -> params
|
||||
return (Param command : File (fromRawFilePath dir) : params')
|
||||
return (Param command : File (fromOsPath dir) : params')
|
||||
uuidcheck NoUUID = []
|
||||
uuidcheck u@(UUID _) = ["--uuid", fromUUID u]
|
||||
fieldopts
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue