diff options
author | Joey Hess <joey@kitenet.net> | 2012-08-23 13:42:13 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-08-23 13:42:26 -0400 |
commit | 487bdf0e24d34135da2e53bbcd2c97d892ed817a (patch) | |
tree | 635c3c89b2440917c1eec2938df286cf8838055b | |
parent | ab8cb0598927414aa8eef0af6ea3da20aba9b78b (diff) |
add transfer scanned flag files
-rw-r--r-- | Assistant/Threads/TransferScanner.hs | 1 | ||||
-rw-r--r-- | Locations.hs | 2 | ||||
-rw-r--r-- | Logs/Transfer.hs | 33 |
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 |