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

record transfer information on local git remotes

Browse source 
In order to record a semi-useful filename associated with the key,
this required plumbing the filename all the way through to the remotes'
storeKey and retrieveKeyFile.

Note that there is potential for deadlock here, narrowly avoided.
Suppose the repos are A and B. A sends file foo to B, and at the same
time, B gets file foo from A. So, A locks its upload transfer info file,
and then locks B's download transfer info file. At the same time,
B is taking the two locks in the opposite order. This is only not a
deadlock because the lock code does not wait, and aborts. So one of A or
B's transfers will be aborted and the other transfer will continue.
Whew!
This commit is contained in:
Joey Hess 2012-07-01 16:59:54 -04:00
parent 8c10f37714
commit 7225c2bfc0
16 changed files with 107 additions and 76 deletions
Download patch file Download diff file Expand all files Collapse all files

33
Logs/Transfer.hs
View file

@ -8,13 +8,11 @@
module Logs.Transfer where
import Common.Annex
import Types.Remote
import Remote
import Annex.Perms
import Annex.Exception
import qualified Git
import Types.Remote
import qualified Data.Map as M
import Control.Concurrent
import System.Posix.Types
import Data.Time.Clock
@ -23,7 +21,7 @@ import Data.Time.Clock
- of the transfer information file. -}
data Transfer = Transfer
{ transferDirection :: Direction
, transferRemote :: Remote
, transferRemote :: UUID
, transferKey :: Key
}
deriving (Show, Eq, Ord)
@ -50,11 +48,11 @@ readDirection "upload" = Just Upload
readDirection "download" = Just Download
readDirection _ = Nothing
upload :: Remote -> Key -> FilePath -> Annex a -> Annex a
upload remote key file a = transfer (Transfer Upload remote key) (Just file) a
upload :: UUID -> Key -> AssociatedFile -> Annex a -> Annex a
upload u key file a = transfer (Transfer Upload u key) file a
download :: Remote -> Key -> FilePath -> Annex a -> Annex a
download remote key file a = transfer (Transfer Download remote key) (Just file) a
download :: UUID -> Key -> AssociatedFile -> Annex a -> Annex a
download u key file a = transfer (Transfer Download u key) file a
{- Runs a transfer action. Creates and locks the transfer information file
- while the action is running. Will throw an error if the transfer is
@ -83,10 +81,10 @@ transfer t file a = do
h <- fdToHandle fd
hPutStr h $ writeTransferInfo info
hFlush h
return fd
cleanup tfile fd = do
return h
cleanup tfile h = do
removeFile tfile
closeFd fd
hClose h
{- If a transfer is still running, returns its TransferInfo. -}
checkTransfer :: Transfer -> Annex (Maybe TransferInfo)
@ -114,8 +112,7 @@ checkTransfer t = do
{- Gets all currently running transfers. -}
getTransfers :: Annex [(Transfer, TransferInfo)]
getTransfers = do
uuidmap <- remoteMap id
transfers <- catMaybes . map (parseTransferFile uuidmap) <$> findfiles
transfers <- catMaybes . map parseTransferFile <$> findfiles
infos <- mapM checkTransfer transfers
return $ map (\(t, Just i) -> (t, i)) $
filter running $ zip transfers infos
@ -126,18 +123,18 @@ getTransfers = do
{- The transfer information file to use for a given Transfer. -}
transferFile :: Transfer -> Git.Repo -> FilePath
transferFile (Transfer direction remote key) r = gitAnnexTransferDir r
transferFile (Transfer direction u key) r = gitAnnexTransferDir r
</> show direction
</> fromUUID (uuid remote)
</> fromUUID u
</> keyFile key
{- Parses a transfer information filename to a Transfer. -}
parseTransferFile :: M.Map UUID Remote -> FilePath -> Maybe Transfer
parseTransferFile uuidmap file =
parseTransferFile :: FilePath -> Maybe Transfer
parseTransferFile file =
case drop (length bits - 3) bits of
[direction, u, key] -> Transfer
<$> readDirection direction
<*> M.lookup (toUUID u) uuidmap
<*> pure (toUUID u)
<*> fileKey key
_ -> Nothing
where