add support for using hashDirLower in addition to hashDirMixed
Supporting multiple directory hash types will allow converting to a different one, without a flag day. gitAnnexLocation now checks which of the possible locations have a file. This means more statting of files. Several places currently use gitAnnexLocation and immediately check if the returned file exists; those need to be optimised.
This commit is contained in:
parent
2b3c120506
commit
da9cd315be
15 changed files with 73 additions and 44 deletions
|
@ -43,12 +43,12 @@ import Annex.Exception
|
||||||
|
|
||||||
{- Checks if a given key's content is currently present. -}
|
{- Checks if a given key's content is currently present. -}
|
||||||
inAnnex :: Key -> Annex Bool
|
inAnnex :: Key -> Annex Bool
|
||||||
inAnnex = inAnnex' doesFileExist
|
inAnnex = inAnnex' $ doesFileExist
|
||||||
inAnnex' :: (FilePath -> IO a) -> Key -> Annex a
|
inAnnex' :: (FilePath -> IO a) -> Key -> Annex a
|
||||||
inAnnex' a key = do
|
inAnnex' a key = do
|
||||||
whenM (fromRepo Git.repoIsUrl) $
|
whenM (fromRepo Git.repoIsUrl) $
|
||||||
error "inAnnex cannot check remote repo"
|
error "inAnnex cannot check remote repo"
|
||||||
inRepo $ a . gitAnnexLocation key
|
inRepo $ \g -> gitAnnexLocation key g >>= a
|
||||||
|
|
||||||
{- A safer check; the key's content must not only be present, but
|
{- A safer check; the key's content must not only be present, but
|
||||||
- is not in the process of being removed. -}
|
- is not in the process of being removed. -}
|
||||||
|
@ -70,7 +70,7 @@ inAnnexSafe = inAnnex' $ \f -> openForLock f False >>= check
|
||||||
- it. (If the content is not present, no locking is done.) -}
|
- it. (If the content is not present, no locking is done.) -}
|
||||||
lockContent :: Key -> Annex a -> Annex a
|
lockContent :: Key -> Annex a -> Annex a
|
||||||
lockContent key a = do
|
lockContent key a = do
|
||||||
file <- fromRepo $ gitAnnexLocation key
|
file <- inRepo $ gitAnnexLocation key
|
||||||
bracketIO (openForLock file True >>= lock) unlock a
|
bracketIO (openForLock file True >>= lock) unlock a
|
||||||
where
|
where
|
||||||
lock Nothing = return Nothing
|
lock Nothing = return Nothing
|
||||||
|
@ -100,9 +100,8 @@ calcGitLink :: FilePath -> Key -> Annex FilePath
|
||||||
calcGitLink file key = do
|
calcGitLink file key = do
|
||||||
cwd <- liftIO getCurrentDirectory
|
cwd <- liftIO getCurrentDirectory
|
||||||
let absfile = fromMaybe whoops $ absNormPath cwd file
|
let absfile = fromMaybe whoops $ absNormPath cwd file
|
||||||
top <- fromRepo Git.workTree
|
loc <- inRepo $ gitAnnexLocation key
|
||||||
return $ relPathDirToFile (parentDir absfile)
|
return $ relPathDirToFile (parentDir absfile) loc
|
||||||
top </> ".git" </> annexLocation key
|
|
||||||
where
|
where
|
||||||
whoops = error $ "unable to normalize " ++ file
|
whoops = error $ "unable to normalize " ++ file
|
||||||
|
|
||||||
|
@ -213,7 +212,7 @@ checkDiskSpace' adjustment key = do
|
||||||
-}
|
-}
|
||||||
moveAnnex :: Key -> FilePath -> Annex ()
|
moveAnnex :: Key -> FilePath -> Annex ()
|
||||||
moveAnnex key src = do
|
moveAnnex key src = do
|
||||||
dest <- fromRepo $ gitAnnexLocation key
|
dest <- inRepo $ gitAnnexLocation key
|
||||||
let dir = parentDir dest
|
let dir = parentDir dest
|
||||||
e <- liftIO $ doesFileExist dest
|
e <- liftIO $ doesFileExist dest
|
||||||
if e
|
if e
|
||||||
|
@ -227,7 +226,7 @@ moveAnnex key src = do
|
||||||
|
|
||||||
withObjectLoc :: Key -> ((FilePath, FilePath) -> Annex a) -> Annex a
|
withObjectLoc :: Key -> ((FilePath, FilePath) -> Annex a) -> Annex a
|
||||||
withObjectLoc key a = do
|
withObjectLoc key a = do
|
||||||
file <- fromRepo $gitAnnexLocation key
|
file <- inRepo $ gitAnnexLocation key
|
||||||
let dir = parentDir file
|
let dir = parentDir file
|
||||||
a (dir, file)
|
a (dir, file)
|
||||||
|
|
||||||
|
@ -250,7 +249,7 @@ fromAnnex key dest = withObjectLoc key $ \(dir, file) -> liftIO $ do
|
||||||
- returns the file it was moved to. -}
|
- returns the file it was moved to. -}
|
||||||
moveBad :: Key -> Annex FilePath
|
moveBad :: Key -> Annex FilePath
|
||||||
moveBad key = do
|
moveBad key = do
|
||||||
src <- fromRepo $ gitAnnexLocation key
|
src <- inRepo $ gitAnnexLocation key
|
||||||
bad <- fromRepo gitAnnexBadDir
|
bad <- fromRepo gitAnnexBadDir
|
||||||
let dest = bad </> takeFileName src
|
let dest = bad </> takeFileName src
|
||||||
liftIO $ do
|
liftIO $ do
|
||||||
|
|
|
@ -99,7 +99,7 @@ keyValueE size file = keyValue size file >>= maybe (return Nothing) addE
|
||||||
checkKeyChecksum :: SHASize -> Key -> Annex Bool
|
checkKeyChecksum :: SHASize -> Key -> Annex Bool
|
||||||
checkKeyChecksum size key = do
|
checkKeyChecksum size key = do
|
||||||
fast <- Annex.getState Annex.fast
|
fast <- Annex.getState Annex.fast
|
||||||
file <- fromRepo $ gitAnnexLocation key
|
file <- inRepo $ gitAnnexLocation key
|
||||||
present <- liftIO $ doesFileExist file
|
present <- liftIO $ doesFileExist file
|
||||||
if not present || fast
|
if not present || fast
|
||||||
then return True
|
then return True
|
||||||
|
|
|
@ -60,7 +60,7 @@ undo file key e = do
|
||||||
-- fromAnnex could fail if the file ownership is weird
|
-- fromAnnex could fail if the file ownership is weird
|
||||||
tryharder :: IOException -> Annex ()
|
tryharder :: IOException -> Annex ()
|
||||||
tryharder _ = do
|
tryharder _ = do
|
||||||
src <- fromRepo $ gitAnnexLocation key
|
src <- inRepo $ gitAnnexLocation key
|
||||||
liftIO $ moveFile src file
|
liftIO $ moveFile src file
|
||||||
|
|
||||||
cleanup :: FilePath -> Key -> Bool -> CommandCleanup
|
cleanup :: FilePath -> Key -> Bool -> CommandCleanup
|
||||||
|
|
|
@ -87,7 +87,7 @@ verifyLocationLog key desc = do
|
||||||
-- Since we're checking that a key's file is present, throw
|
-- Since we're checking that a key's file is present, throw
|
||||||
-- in a permission fixup here too.
|
-- in a permission fixup here too.
|
||||||
when present $ do
|
when present $ do
|
||||||
f <- fromRepo $ gitAnnexLocation key
|
f <- inRepo $ gitAnnexLocation key
|
||||||
liftIO $ do
|
liftIO $ do
|
||||||
preventWrite f
|
preventWrite f
|
||||||
preventWrite (parentDir f)
|
preventWrite (parentDir f)
|
||||||
|
@ -118,7 +118,7 @@ verifyLocationLog key desc = do
|
||||||
- the key's metadata, if available. -}
|
- the key's metadata, if available. -}
|
||||||
checkKeySize :: Key -> Annex Bool
|
checkKeySize :: Key -> Annex Bool
|
||||||
checkKeySize key = do
|
checkKeySize key = do
|
||||||
file <- fromRepo $ gitAnnexLocation key
|
file <- inRepo $ gitAnnexLocation key
|
||||||
present <- liftIO $ doesFileExist file
|
present <- liftIO $ doesFileExist file
|
||||||
case (present, Types.Key.keySize key) of
|
case (present, Types.Key.keySize key) of
|
||||||
(_, Nothing) -> return True
|
(_, Nothing) -> return True
|
||||||
|
|
|
@ -49,7 +49,7 @@ upgradableKey key = isNothing $ Types.Key.keySize key
|
||||||
-}
|
-}
|
||||||
perform :: FilePath -> Key -> Backend Annex -> CommandPerform
|
perform :: FilePath -> Key -> Backend Annex -> CommandPerform
|
||||||
perform file oldkey newbackend = do
|
perform file oldkey newbackend = do
|
||||||
src <- fromRepo $ gitAnnexLocation oldkey
|
src <- inRepo $ gitAnnexLocation oldkey
|
||||||
tmp <- fromRepo gitAnnexTmpDir
|
tmp <- fromRepo gitAnnexTmpDir
|
||||||
let tmpfile = tmp </> takeFileName file
|
let tmpfile = tmp </> takeFileName file
|
||||||
cleantmp tmpfile
|
cleantmp tmpfile
|
||||||
|
|
|
@ -21,7 +21,7 @@ seek = [withKeys start]
|
||||||
|
|
||||||
start :: Key -> CommandStart
|
start :: Key -> CommandStart
|
||||||
start key = do
|
start key = do
|
||||||
file <- fromRepo $ gitAnnexLocation key
|
file <- inRepo $ gitAnnexLocation key
|
||||||
whenM (inAnnex key) $
|
whenM (inAnnex key) $
|
||||||
liftIO $ rsyncServerSend file -- does not return
|
liftIO $ rsyncServerSend file -- does not return
|
||||||
warning "requested key is not present"
|
warning "requested key is not present"
|
||||||
|
|
|
@ -55,7 +55,7 @@ cleanup file key = do
|
||||||
if fast
|
if fast
|
||||||
then do
|
then do
|
||||||
-- fast mode: hard link to content in annex
|
-- fast mode: hard link to content in annex
|
||||||
src <- fromRepo $ gitAnnexLocation key
|
src <- inRepo $ gitAnnexLocation key
|
||||||
liftIO $ do
|
liftIO $ do
|
||||||
createLink src file
|
createLink src file
|
||||||
allowWrite file
|
allowWrite file
|
||||||
|
|
|
@ -37,7 +37,7 @@ perform dest key = do
|
||||||
|
|
||||||
checkDiskSpace key
|
checkDiskSpace key
|
||||||
|
|
||||||
src <- fromRepo $ gitAnnexLocation key
|
src <- inRepo $ gitAnnexLocation key
|
||||||
tmpdest <- fromRepo $ gitAnnexTmpLocation key
|
tmpdest <- fromRepo $ gitAnnexTmpLocation key
|
||||||
liftIO $ createDirectoryIfMissing True (parentDir tmpdest)
|
liftIO $ createDirectoryIfMissing True (parentDir tmpdest)
|
||||||
showAction "copying"
|
showAction "copying"
|
||||||
|
|
35
Locations.hs
35
Locations.hs
|
@ -9,7 +9,7 @@ module Locations (
|
||||||
keyFile,
|
keyFile,
|
||||||
fileKey,
|
fileKey,
|
||||||
gitAnnexLocation,
|
gitAnnexLocation,
|
||||||
annexLocation,
|
annexLocations,
|
||||||
gitAnnexDir,
|
gitAnnexDir,
|
||||||
gitAnnexObjectDir,
|
gitAnnexObjectDir,
|
||||||
gitAnnexTmpDir,
|
gitAnnexTmpDir,
|
||||||
|
@ -58,17 +58,33 @@ annexDir = addTrailingPathSeparator "annex"
|
||||||
objectDir :: FilePath
|
objectDir :: FilePath
|
||||||
objectDir = addTrailingPathSeparator $ annexDir </> "objects"
|
objectDir = addTrailingPathSeparator $ annexDir </> "objects"
|
||||||
|
|
||||||
{- Annexed file's location relative to the .git directory. -}
|
{- Annexed file's possible locations relative to the .git directory.
|
||||||
annexLocation :: Key -> FilePath
|
- There are two different possibilities, using different hashes;
|
||||||
annexLocation key = objectDir </> hashDirMixed key </> f </> f
|
- the first is the default for new content. -}
|
||||||
|
annexLocations :: Key -> [FilePath]
|
||||||
|
annexLocations key = [using hashDirMixed, using hashDirLower]
|
||||||
where
|
where
|
||||||
|
using h = objectDir </> h key </> f </> f
|
||||||
f = keyFile key
|
f = keyFile key
|
||||||
|
|
||||||
{- Annexed file's absolute location in a repository. -}
|
{- Annexed file's absolute location in a repository.
|
||||||
gitAnnexLocation :: Key -> Git.Repo -> FilePath
|
- Out of the possible annexLocations, returns the one where the file
|
||||||
|
- is actually present. When the file is not present, returns the
|
||||||
|
- one where the file should be put.
|
||||||
|
-}
|
||||||
|
gitAnnexLocation :: Key -> Git.Repo -> IO FilePath
|
||||||
gitAnnexLocation key r
|
gitAnnexLocation key r
|
||||||
| Git.repoIsLocalBare r = Git.workTree r </> annexLocation key
|
| Git.repoIsLocalBare r =
|
||||||
| otherwise = Git.workTree r </> ".git" </> annexLocation key
|
go (Git.workTree r) $ annexLocations key
|
||||||
|
| otherwise =
|
||||||
|
go (Git.workTree r </> ".git") $ annexLocations key
|
||||||
|
where
|
||||||
|
go dir locs = fromMaybe (dir </> head locs) <$> check dir locs
|
||||||
|
check _ [] = return Nothing
|
||||||
|
check dir (l:ls) = do
|
||||||
|
let f = dir </> l
|
||||||
|
e <- doesFileExist f
|
||||||
|
if e then return (Just f) else check dir ls
|
||||||
|
|
||||||
{- The annex directory of a repository. -}
|
{- The annex directory of a repository. -}
|
||||||
gitAnnexDir :: Git.Repo -> FilePath
|
gitAnnexDir :: Git.Repo -> FilePath
|
||||||
|
@ -76,8 +92,7 @@ gitAnnexDir r
|
||||||
| Git.repoIsLocalBare r = addTrailingPathSeparator $ Git.workTree r </> annexDir
|
| Git.repoIsLocalBare r = addTrailingPathSeparator $ Git.workTree r </> annexDir
|
||||||
| otherwise = addTrailingPathSeparator $ Git.workTree r </> ".git" </> annexDir
|
| otherwise = addTrailingPathSeparator $ Git.workTree r </> ".git" </> annexDir
|
||||||
|
|
||||||
{- The part of the annex directory where file contents are stored.
|
{- The part of the annex directory where file contents are stored. -}
|
||||||
-}
|
|
||||||
gitAnnexObjectDir :: Git.Repo -> FilePath
|
gitAnnexObjectDir :: Git.Repo -> FilePath
|
||||||
gitAnnexObjectDir r
|
gitAnnexObjectDir r
|
||||||
| Git.repoIsLocalBare r = addTrailingPathSeparator $ Git.workTree r </> objectDir
|
| Git.repoIsLocalBare r = addTrailingPathSeparator $ Git.workTree r </> objectDir
|
||||||
|
|
|
@ -102,13 +102,13 @@ bupSplitParams r buprepo k src = do
|
||||||
|
|
||||||
store :: Git.Repo -> BupRepo -> Key -> Annex Bool
|
store :: Git.Repo -> BupRepo -> Key -> Annex Bool
|
||||||
store r buprepo k = do
|
store r buprepo k = do
|
||||||
src <- fromRepo $ gitAnnexLocation k
|
src <- inRepo $ gitAnnexLocation k
|
||||||
params <- bupSplitParams r buprepo k (File src)
|
params <- bupSplitParams r buprepo k (File src)
|
||||||
liftIO $ boolSystem "bup" params
|
liftIO $ boolSystem "bup" params
|
||||||
|
|
||||||
storeEncrypted :: Git.Repo -> BupRepo -> (Cipher, Key) -> Key -> Annex Bool
|
storeEncrypted :: Git.Repo -> BupRepo -> (Cipher, Key) -> Key -> Annex Bool
|
||||||
storeEncrypted r buprepo (cipher, enck) k = do
|
storeEncrypted r buprepo (cipher, enck) k = do
|
||||||
src <- fromRepo $ gitAnnexLocation k
|
src <- inRepo $ gitAnnexLocation k
|
||||||
params <- bupSplitParams r buprepo enck (Param "-")
|
params <- bupSplitParams r buprepo enck (Param "-")
|
||||||
liftIO $ catchBoolIO $
|
liftIO $ catchBoolIO $
|
||||||
withEncryptedHandle cipher (L.readFile src) $ \h ->
|
withEncryptedHandle cipher (L.readFile src) $ \h ->
|
||||||
|
|
|
@ -94,12 +94,12 @@ withStoredFile = withCheckedFile doesFileExist
|
||||||
|
|
||||||
store :: FilePath -> Key -> Annex Bool
|
store :: FilePath -> Key -> Annex Bool
|
||||||
store d k = do
|
store d k = do
|
||||||
src <- fromRepo $ gitAnnexLocation k
|
src <- inRepo $ gitAnnexLocation k
|
||||||
liftIO $ catchBoolIO $ storeHelper d k $ copyFileExternal src
|
liftIO $ catchBoolIO $ storeHelper d k $ copyFileExternal src
|
||||||
|
|
||||||
storeEncrypted :: FilePath -> (Cipher, Key) -> Key -> Annex Bool
|
storeEncrypted :: FilePath -> (Cipher, Key) -> Key -> Annex Bool
|
||||||
storeEncrypted d (cipher, enck) k = do
|
storeEncrypted d (cipher, enck) k = do
|
||||||
src <- fromRepo $ gitAnnexLocation k
|
src <- inRepo $ gitAnnexLocation k
|
||||||
liftIO $ catchBoolIO $ storeHelper d enck $ encrypt src
|
liftIO $ catchBoolIO $ storeHelper d enck $ encrypt src
|
||||||
where
|
where
|
||||||
encrypt src dest = do
|
encrypt src dest = do
|
||||||
|
|
|
@ -134,7 +134,14 @@ inAnnex r key
|
||||||
| Git.repoIsUrl r = checkremote
|
| Git.repoIsUrl r = checkremote
|
||||||
| otherwise = checklocal
|
| otherwise = checklocal
|
||||||
where
|
where
|
||||||
checkhttp = liftIO $ catchMsgIO $ Url.exists $ keyUrl r key
|
checkhttp = liftIO $ go undefined $ keyUrls r key
|
||||||
|
where
|
||||||
|
go e [] = return $ Left e
|
||||||
|
go _ (u:us) = do
|
||||||
|
res <- catchMsgIO $ Url.exists u
|
||||||
|
case res of
|
||||||
|
Left e -> go e us
|
||||||
|
v -> return v
|
||||||
checkremote = do
|
checkremote = do
|
||||||
showAction $ "checking " ++ Git.repoDescribe r
|
showAction $ "checking " ++ Git.repoDescribe r
|
||||||
onRemote r (check, unknown) "inannex" [Param (show key)]
|
onRemote r (check, unknown) "inannex" [Param (show key)]
|
||||||
|
@ -169,8 +176,10 @@ onLocal r a = do
|
||||||
liftIO Git.reap
|
liftIO Git.reap
|
||||||
return ret
|
return ret
|
||||||
|
|
||||||
keyUrl :: Git.Repo -> Key -> String
|
keyUrls :: Git.Repo -> Key -> [String]
|
||||||
keyUrl r key = Git.repoLocation r ++ "/" ++ annexLocation key
|
keyUrls r key = map tourl (annexLocations key)
|
||||||
|
where
|
||||||
|
tourl l = Git.repoLocation r ++ "/" ++ l
|
||||||
|
|
||||||
dropKey :: Git.Repo -> Key -> Annex Bool
|
dropKey :: Git.Repo -> Key -> Annex Bool
|
||||||
dropKey r key
|
dropKey r key
|
||||||
|
@ -185,16 +194,22 @@ copyFromRemote :: Git.Repo -> Key -> FilePath -> Annex Bool
|
||||||
copyFromRemote r key file
|
copyFromRemote r key file
|
||||||
| not $ Git.repoIsUrl r = do
|
| not $ Git.repoIsUrl r = do
|
||||||
params <- rsyncParams r
|
params <- rsyncParams r
|
||||||
rsyncOrCopyFile params (gitAnnexLocation key r) file
|
loc <- liftIO $ gitAnnexLocation key r
|
||||||
|
rsyncOrCopyFile params loc file
|
||||||
| Git.repoIsSsh r = rsyncHelper =<< rsyncParamsRemote r True key file
|
| Git.repoIsSsh r = rsyncHelper =<< rsyncParamsRemote r True key file
|
||||||
| Git.repoIsHttp r = liftIO $ Url.download (keyUrl r key) file
|
| Git.repoIsHttp r = liftIO $ downloadurls $ keyUrls r key
|
||||||
| otherwise = error "copying from non-ssh, non-http repo not supported"
|
| otherwise = error "copying from non-ssh, non-http repo not supported"
|
||||||
|
where
|
||||||
|
downloadurls [] = return False
|
||||||
|
downloadurls (u:us) = do
|
||||||
|
ok <- Url.download u file
|
||||||
|
if ok then return ok else downloadurls us
|
||||||
|
|
||||||
{- Tries to copy a key's content to a remote's annex. -}
|
{- Tries to copy a key's content to a remote's annex. -}
|
||||||
copyToRemote :: Git.Repo -> Key -> Annex Bool
|
copyToRemote :: Git.Repo -> Key -> Annex Bool
|
||||||
copyToRemote r key
|
copyToRemote r key
|
||||||
| not $ Git.repoIsUrl r = do
|
| not $ Git.repoIsUrl r = do
|
||||||
keysrc <- fromRepo $ gitAnnexLocation key
|
keysrc <- inRepo $ gitAnnexLocation key
|
||||||
params <- rsyncParams r
|
params <- rsyncParams r
|
||||||
-- run copy from perspective of remote
|
-- run copy from perspective of remote
|
||||||
liftIO $ onLocal r $ do
|
liftIO $ onLocal r $ do
|
||||||
|
@ -203,7 +218,7 @@ copyToRemote r key
|
||||||
Annex.Content.saveState
|
Annex.Content.saveState
|
||||||
return ok
|
return ok
|
||||||
| Git.repoIsSsh r = do
|
| Git.repoIsSsh r = do
|
||||||
keysrc <- fromRepo $ gitAnnexLocation key
|
keysrc <- inRepo $ gitAnnexLocation key
|
||||||
rsyncHelper =<< rsyncParamsRemote r False key keysrc
|
rsyncHelper =<< rsyncParamsRemote r False key keysrc
|
||||||
| otherwise = error "copying to non-ssh repo not supported"
|
| otherwise = error "copying to non-ssh repo not supported"
|
||||||
|
|
||||||
|
|
|
@ -97,12 +97,12 @@ runHook hooktype hook k f a = maybe (return False) run =<< lookupHook hooktype h
|
||||||
|
|
||||||
store :: String -> Key -> Annex Bool
|
store :: String -> Key -> Annex Bool
|
||||||
store h k = do
|
store h k = do
|
||||||
src <- fromRepo $ gitAnnexLocation k
|
src <- inRepo $ gitAnnexLocation k
|
||||||
runHook h "store" k (Just src) $ return True
|
runHook h "store" k (Just src) $ return True
|
||||||
|
|
||||||
storeEncrypted :: String -> (Cipher, Key) -> Key -> Annex Bool
|
storeEncrypted :: String -> (Cipher, Key) -> Key -> Annex Bool
|
||||||
storeEncrypted h (cipher, enck) k = withTmp enck $ \tmp -> do
|
storeEncrypted h (cipher, enck) k = withTmp enck $ \tmp -> do
|
||||||
src <- fromRepo $ gitAnnexLocation k
|
src <- inRepo $ gitAnnexLocation k
|
||||||
liftIO $ withEncryptedContent cipher (L.readFile src) $ L.writeFile tmp
|
liftIO $ withEncryptedContent cipher (L.readFile src) $ L.writeFile tmp
|
||||||
runHook h "store" enck (Just tmp) $ return True
|
runHook h "store" enck (Just tmp) $ return True
|
||||||
|
|
||||||
|
|
|
@ -95,11 +95,11 @@ rsyncKeyDir :: RsyncOpts -> Key -> String
|
||||||
rsyncKeyDir o k = rsyncUrl o </> hashDirMixed k </> rsyncEscape o (keyFile k)
|
rsyncKeyDir o k = rsyncUrl o </> hashDirMixed k </> rsyncEscape o (keyFile k)
|
||||||
|
|
||||||
store :: RsyncOpts -> Key -> Annex Bool
|
store :: RsyncOpts -> Key -> Annex Bool
|
||||||
store o k = rsyncSend o k =<< fromRepo (gitAnnexLocation k)
|
store o k = rsyncSend o k =<< inRepo (gitAnnexLocation k)
|
||||||
|
|
||||||
storeEncrypted :: RsyncOpts -> (Cipher, Key) -> Key -> Annex Bool
|
storeEncrypted :: RsyncOpts -> (Cipher, Key) -> Key -> Annex Bool
|
||||||
storeEncrypted o (cipher, enck) k = withTmp enck $ \tmp -> do
|
storeEncrypted o (cipher, enck) k = withTmp enck $ \tmp -> do
|
||||||
src <- fromRepo $ gitAnnexLocation k
|
src <- inRepo $ gitAnnexLocation k
|
||||||
liftIO $ withEncryptedContent cipher (L.readFile src) $ L.writeFile tmp
|
liftIO $ withEncryptedContent cipher (L.readFile src) $ L.writeFile tmp
|
||||||
rsyncSend o enck tmp
|
rsyncSend o enck tmp
|
||||||
|
|
||||||
|
|
|
@ -112,7 +112,7 @@ s3Setup u c = handlehost $ M.lookup "host" c
|
||||||
|
|
||||||
store :: Remote Annex -> Key -> Annex Bool
|
store :: Remote Annex -> Key -> Annex Bool
|
||||||
store r k = s3Action r False $ \(conn, bucket) -> do
|
store r k = s3Action r False $ \(conn, bucket) -> do
|
||||||
dest <- fromRepo $ gitAnnexLocation k
|
dest <- inRepo $ gitAnnexLocation k
|
||||||
res <- liftIO $ storeHelper (conn, bucket) r k dest
|
res <- liftIO $ storeHelper (conn, bucket) r k dest
|
||||||
s3Bool res
|
s3Bool res
|
||||||
|
|
||||||
|
@ -121,7 +121,7 @@ storeEncrypted r (cipher, enck) k = s3Action r False $ \(conn, bucket) ->
|
||||||
-- To get file size of the encrypted content, have to use a temp file.
|
-- To get file size of the encrypted content, have to use a temp file.
|
||||||
-- (An alternative would be chunking to to a constant size.)
|
-- (An alternative would be chunking to to a constant size.)
|
||||||
withTmp enck $ \tmp -> do
|
withTmp enck $ \tmp -> do
|
||||||
f <- fromRepo $ gitAnnexLocation k
|
f <- inRepo $ gitAnnexLocation k
|
||||||
liftIO $ withEncryptedContent cipher (L.readFile f) $ \s -> L.writeFile tmp s
|
liftIO $ withEncryptedContent cipher (L.readFile f) $ \s -> L.writeFile tmp s
|
||||||
res <- liftIO $ storeHelper (conn, bucket) r enck tmp
|
res <- liftIO $ storeHelper (conn, bucket) r enck tmp
|
||||||
s3Bool res
|
s3Bool res
|
||||||
|
|
Loading…
Reference in a new issue