webapp and assistant glacier support
This commit is contained in:
parent
c282c8b492
commit
463cf58140
23 changed files with 321 additions and 185 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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 =
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue