diff options
author | 2012-08-23 13:42:13 -0400 | |
---|---|---|
committer | 2012-08-23 13:42:26 -0400 | |
commit | 487bdf0e24d34135da2e53bbcd2c97d892ed817a (patch) | |
tree | 635c3c89b2440917c1eec2938df286cf8838055b /Logs/Transfer.hs | |
parent | ab8cb0598927414aa8eef0af6ea3da20aba9b78b (diff) |
add transfer scanned flag files
Diffstat (limited to 'Logs/Transfer.hs')
-rw-r--r-- | Logs/Transfer.hs | 33 |
1 files changed, 28 insertions, 5 deletions
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 |