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

added StoreContentTo

Browse source 
This is needed in addition to StoreContent, because retrieveKeyFile can
be used to retrieve to different destination files, not only the tmp
file for a key.

This commit was sponsored by Ole-Morten Duesund on Patreon.
This commit is contained in:
Joey Hess 2016-12-06 15:05:44 -04:00
parent b29088b8dc
commit 2bd2e0880c
No known key found for this signature in database
GPG key ID: C910D9222512E3C7
2 changed files with 49 additions and 27 deletions
Download patch file Download diff file Expand all files Collapse all files

32
P2P/Annex.hs
View file

@ -16,7 +16,6 @@ module P2P.Annex
import Annex.Common
import Annex.Content
import Annex.Transfer
import Annex.Notification
import P2P.Protocol
import P2P.IO
import Logs.Location
@ -46,6 +45,9 @@ runLocal runmode runner a = case a of
tmp <- fromRepo $ gitAnnexTmpObjectLocation k
size <- liftIO $ catchDefaultIO 0 $ getFileSize tmp
runner (next (Len size))
FileSize f next -> do
size <- liftIO $ catchDefaultIO 0 $ getFileSize f
runner (next (Len size))
ContentSize k next -> do
let getsize = liftIO . catchMaybeIO . getFileSize
size <- inAnnex' isJust Nothing getsize k
@ -69,16 +71,15 @@ runLocal runmode runner a = case a of
Left _ -> return Nothing
Right b -> runner (next b)
_ -> return Nothing
WriteContent k af (Offset o) (Len l) b next -> do
StoreContent k af o l b next -> do
ok <- flip catchNonAsync (const $ return False) $
transfer download k af $
getViaTmp AlwaysVerify k $ \tmp -> liftIO $ do
withBinaryFile tmp WriteMode $ \h -> do
when (o /= 0) $
hSeek h AbsoluteSeek o
L.hPut h b
sz <- getFileSize tmp
return (toInteger sz == l, UnVerified)
getViaTmp AlwaysVerify k $ \tmp ->
unVerified $ storefile tmp o l b
runner (next ok)
StoreContentTo dest o l b next -> do
ok <- flip catchNonAsync (const $ return False) $
storefile dest o l b
runner (next ok)
SetPresent k u next -> do
v <- tryNonAsync $ logChange k u InfoPresent
@ -111,10 +112,17 @@ runLocal runmode runner a = case a of
next
Right _ -> runner next
where
transfer mk k af a = case runmode of
transfer mk k af ta = case runmode of
-- Update transfer logs when serving.
Serving theiruuid ->
mk theiruuid k af noRetry (const a) noNotification
mk theiruuid k af noRetry (const ta) noNotification
-- Transfer logs are updated higher in the stack when
-- a client.
Client -> a
Client -> ta
storefile dest (Offset o) (Len l) b = liftIO $ do
withBinaryFile dest WriteMode $ \h -> do
when (o /= 0) $
hSeek h AbsoluteSeek o
L.hPut h b
sz <- getFileSize dest
return (toInteger sz == l)