From 7225c2bfc0c7149e646fa9af998da983e3fa8bc8 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sun, 1 Jul 2012 16:59:54 -0400
Subject: record transfer information on local git remotes

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!
---
 Logs/Transfer.hs | 33 +++++++++++++++------------------
 1 file changed, 15 insertions(+), 18 deletions(-)

(limited to 'Logs')

diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs
index fe93b90b4..526241f93 100644
--- a/Logs/Transfer.hs
+++ b/Logs/Transfer.hs
@@ -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
-- 
cgit v1.2.3