From 487bdf0e24d34135da2e53bbcd2c97d892ed817a Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 23 Aug 2012 13:42:13 -0400
Subject: [PATCH] add transfer scanned flag files

---
 Assistant/Threads/TransferScanner.hs |  1 +
 Locations.hs                         |  2 +-
 Logs/Transfer.hs                     | 33 +++++++++++++++++++++++-----
 3 files changed, 30 insertions(+), 6 deletions(-)

diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs
index 2cba0b2a78..6bef2a6f10 100644
--- a/Assistant/Threads/TransferScanner.hs
+++ b/Assistant/Threads/TransferScanner.hs
@@ -44,6 +44,7 @@ scan st dstatus transferqueue r = do
 	g <- runThreadState st $ fromRepo id
 	files <- LsFiles.inRepo [] g
 	go files
+	inRepo $ transferScanned $ uuid r
 	return True
 	where
 		go [] = return ()
diff --git a/Locations.hs b/Locations.hs
index 2606bef279..330645dfcf 100644
--- a/Locations.hs
+++ b/Locations.hs
@@ -130,7 +130,7 @@ gitAnnexUnusedLog :: FilePath -> Git.Repo -> FilePath
 gitAnnexUnusedLog prefix r = gitAnnexDir r </> (prefix ++ "unused")
 
 {- .git/annex/transfer/ is used is used to record keys currently
- - being transferred. -}
+ - being transferred, and other transfer bookkeeping info. -}
 gitAnnexTransferDir :: Git.Repo -> FilePath
 gitAnnexTransferDir r = addTrailingPathSeparator $ gitAnnexDir r </> "transfer"
 
diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs
index 590e736648..4e43929fcf 100644
--- a/Logs/Transfer.hs
+++ b/Logs/Transfer.hs
@@ -134,19 +134,18 @@ checkTransfer t = do
 {- Gets all currently running transfers. -}
 getTransfers :: Annex [(Transfer, TransferInfo)]
 getTransfers = do
-	transfers <- catMaybes . map parseTransferFile <$> findfiles
+	transfers <- catMaybes . map parseTransferFile . concat <$> findfiles
 	infos <- mapM checkTransfer transfers
 	return $ map (\(t, Just i) -> (t, i)) $
 		filter running $ zip transfers infos
 	where
-		findfiles = liftIO . dirContentsRecursive
-			=<< fromRepo gitAnnexTransferDir
+		findfiles = liftIO . mapM dirContentsRecursive
+			=<< mapM (fromRepo . transferDir) [Upload, Download]
 		running (_, i) = isJust i
 
 {- The transfer information file to use for a given Transfer. -}
 transferFile :: Transfer -> Git.Repo -> FilePath
-transferFile (Transfer direction u key) r = gitAnnexTransferDir r
-	</> showLcDirection direction 
+transferFile (Transfer direction u key) r = transferDir direction r
 	</> fromUUID u
 	</> keyFile key
 
@@ -196,3 +195,27 @@ readTransferInfo pid s =
 parsePOSIXTime :: String -> Maybe POSIXTime
 parsePOSIXTime s = utcTimeToPOSIXSeconds
 	<$> parseTime defaultTimeLocale "%s%Qs" s
+
+{- The directory holding transfer information files for a given Direction. -}
+transferDir :: Direction -> Git.Repo -> FilePath
+transferDir direction r = gitAnnexTransferDir r </> showLcDirection direction
+
+{- The directory holding remote uuids that have been scanned for transfers. -}
+transferScannedDir :: Git.Repo -> FilePath
+transferScannedDir r = gitAnnexTransferDir r </> "scanned"
+
+{- The file indicating whether a remote uuid has been scanned. -}
+transferScannedFile :: UUID -> Git.Repo -> FilePath
+transferScannedFile u r = transferScannedDir r </> show u 
+
+{- Checks if a given remote UUID has been scanned for transfers. -}
+checkTransferScanned :: UUID -> Git.Repo -> IO Bool
+checkTransferScanned u r = doesFileExist $ transferScannedFile u r
+
+{- Records that a scan has taken place. -}
+transferScanned :: UUID -> Git.Repo -> IO ()
+transferScanned u r = do
+	createDirectoryIfMissing True (parentDir f)
+	writeFile f ""
+	where
+		f = transferScannedFile u r