summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-08-23 13:42:13 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-08-23 13:42:26 -0400
commit487bdf0e24d34135da2e53bbcd2c97d892ed817a (patch)
tree635c3c89b2440917c1eec2938df286cf8838055b
parentab8cb0598927414aa8eef0af6ea3da20aba9b78b (diff)
add transfer scanned flag files
-rw-r--r--Assistant/Threads/TransferScanner.hs1
-rw-r--r--Locations.hs2
-rw-r--r--Logs/Transfer.hs33
3 files changed, 30 insertions, 6 deletions
diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs
index 2cba0b2a7..6bef2a6f1 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 2606bef27..330645dfc 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 590e73664..4e43929fc 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