webapp and assistant glacier support

This commit is contained in:
Joey Hess 2012-11-24 16:30:15 -04:00
parent c282c8b492
commit 463cf58140
23 changed files with 321 additions and 185 deletions

View file

@ -119,7 +119,7 @@ expensiveScan rs = unless onlyweb $ do
locs <- loggedLocations key
present <- inAnnex key
handleDrops' locs syncrs present key (Just f)
handleDrops' locs syncrs present key (Just f) Nothing
let slocs = S.fromList locs
let use a = return $ catMaybes $ map (a key slocs) syncrs

View file

@ -102,11 +102,11 @@ onDel file = case parseTransferFile file of
threadDelay 10000000 -- 10 seconds
finished t minfo
{- Queue uploads of files we successfully downloaded, spreading them
{- Queue uploads of files downloaded to us, spreading them
- out to other reachable remotes.
-
- Downloading a file may have caused a remote to not want it;
- so drop it from the remote.
- so check for drops from remotes.
-
- Uploading a file may cause the local repo, or some other remote to not
- want it; handle that too.
@ -115,9 +115,9 @@ finishedTransfer :: Transfer -> Maybe TransferInfo -> Assistant ()
finishedTransfer t (Just info)
| transferDirection t == Download =
whenM (liftAnnex $ inAnnex $ transferKey t) $ do
handleDrops False (transferKey t) (associatedFile info)
handleDrops False (transferKey t) (associatedFile info) Nothing
queueTransfersMatching (/= transferUUID t) Later
(transferKey t) (associatedFile info) Upload
| otherwise = handleDrops True (transferKey t) (associatedFile info)
| otherwise = handleDrops True (transferKey t) (associatedFile info) Nothing
finishedTransfer _ _ = noop

View file

@ -13,6 +13,7 @@ import Assistant.TransferQueue
import Assistant.TransferSlots
import Assistant.Alert
import Assistant.Commits
import Assistant.Drop
import Logs.Transfer
import Logs.Location
import Annex.Content
@ -65,6 +66,10 @@ startTransfer program t info = case (transferRemote info, associatedFile info) o
- so there's no point in bothering the user about
- those. The assistant should recover.
-
- After a successful upload, handle dropping it from
- here, if desired. In this case, the remote it was
- uploaded to is known to have it.
-
- Also, after a successful transfer, the location
- log has changed. Indicate that a commit has been
- made, in order to queue a push of the git-annex
@ -74,6 +79,10 @@ startTransfer program t info = case (transferRemote info, associatedFile info) o
whenM (liftIO $ (==) ExitSuccess <$> waitForProcess pid) $ do
void $ addAlert $ makeAlertFiller True $
transferFileAlert direction True file
unless isdownload $
handleDrops True (transferKey t)
(associatedFile info)
(Just remote)
recordCommit
where
params =

View file

@ -187,7 +187,7 @@ onAddSymlink file filestatus = go =<< liftAnnex (Backend.lookupFile file)
if present
then queueTransfers Next key (Just file) Upload
else queueTransfers Next key (Just file) Download
handleDrops present key (Just file)
handleDrops present key (Just file) Nothing
| otherwise = noop
onDel :: Handler

View file

@ -21,9 +21,7 @@ import Assistant.WebApp.Configurators.Edit
import Assistant.WebApp.Configurators.Local
import Assistant.WebApp.Configurators.Ssh
import Assistant.WebApp.Configurators.Pairing
#ifdef WITH_S3
import Assistant.WebApp.Configurators.S3
#endif
import Assistant.WebApp.Configurators.AWS
#ifdef WITH_WEBDAV
import Assistant.WebApp.Configurators.WebDAV
#endif