8062f6337f
When adding a removable drive, it's now detected if the drive contains a gcrypt special remote, and that's all handled nicely. This includes fetching the git-annex branch from the gcrypt repo in order to find out how to set up the special remote. Note that gcrypt repos that are not git-annex special remotes are not supported. It will attempt to detect such a gcrypt repo and refuse to use it. (But this is hard to do any may fail; see https://github.com/blake2-ppc/git-remote-gcrypt/issues/6) The problem with supporting regular gcrypt repos is that we don't know what the gcrypt.participants setting is intended to be for the repo. So even if we can decrypt it, if we push changes to it they might not be visible to other participants. Anyway, encrypted sneakernet (or mailnet) is now fully possible with the git-annex assistant! Assuming that the gpg key distribution is handled somehow, which the assistant doesn't yet help with. This commit was sponsored by Navishkar Rao.
89 lines
2.6 KiB
Haskell
89 lines
2.6 KiB
Haskell
{- git-annex assistant remote deletion utilities
|
|
-
|
|
- Copyright 2012 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE CPP #-}
|
|
|
|
module Assistant.DeleteRemote where
|
|
|
|
import Assistant.Common
|
|
import Assistant.Types.UrlRenderer
|
|
import Assistant.TransferQueue
|
|
import Logs.Transfer
|
|
import Logs.Location
|
|
import Assistant.DaemonStatus
|
|
import qualified Remote
|
|
import Remote.List
|
|
import qualified Git.Remote
|
|
import Logs.Trust
|
|
import qualified Annex
|
|
|
|
#ifdef WITH_WEBAPP
|
|
import Assistant.WebApp.Types
|
|
import Assistant.Alert
|
|
import qualified Data.Text as T
|
|
#endif
|
|
|
|
{- Removes a remote (but leave the repository as-is), and returns the old
|
|
- Remote data. -}
|
|
disableRemote :: UUID -> Assistant Remote
|
|
disableRemote uuid = do
|
|
remote <- fromMaybe (error "unknown remote")
|
|
<$> liftAnnex (Remote.remoteFromUUID uuid)
|
|
liftAnnex $ do
|
|
inRepo $ Git.Remote.remove (Remote.name remote)
|
|
void $ remoteListRefresh
|
|
updateSyncRemotes
|
|
return remote
|
|
|
|
{- Removes a remote, marking it dead .-}
|
|
removeRemote :: UUID -> Assistant Remote
|
|
removeRemote uuid = do
|
|
liftAnnex $ trustSet uuid DeadTrusted
|
|
disableRemote uuid
|
|
|
|
{- Called when a Remote is probably empty, to remove it.
|
|
-
|
|
- This does one last check for any objects remaining in the Remote,
|
|
- and if there are any, queues Downloads of them, and defers removing
|
|
- the remote for later. This is to catch any objects not referred to
|
|
- in keys in the current branch.
|
|
-}
|
|
removableRemote :: UrlRenderer -> UUID -> Assistant ()
|
|
removableRemote urlrenderer uuid = do
|
|
keys <- getkeys
|
|
if null keys
|
|
then finishRemovingRemote urlrenderer uuid
|
|
else do
|
|
r <- fromMaybe (error "unknown remote")
|
|
<$> liftAnnex (Remote.remoteFromUUID uuid)
|
|
mapM_ (queueremaining r) keys
|
|
where
|
|
queueremaining r k =
|
|
queueTransferWhenSmall "remaining object in unwanted remote"
|
|
Nothing (Transfer Download uuid k) r
|
|
{- Scanning for keys can take a long time; do not tie up
|
|
- the Annex monad while doing it, so other threads continue to
|
|
- run. -}
|
|
getkeys = do
|
|
a <- liftAnnex $ Annex.withCurrentState $ loggedKeysFor uuid
|
|
liftIO a
|
|
|
|
{- With the webapp, this asks the user to click on a button to finish
|
|
- removing the remote.
|
|
-
|
|
- Without the webapp, just do the removal now.
|
|
-}
|
|
finishRemovingRemote :: UrlRenderer -> UUID -> Assistant ()
|
|
#ifdef WITH_WEBAPP
|
|
finishRemovingRemote urlrenderer uuid = do
|
|
desc <- liftAnnex $ Remote.prettyUUID uuid
|
|
button <- mkAlertButton (T.pack "Finish deletion process") urlrenderer $
|
|
FinishDeleteRepositoryR uuid
|
|
void $ addAlert $ remoteRemovalAlert desc button
|
|
#else
|
|
finishRemovingRemote _ uuid = void $ removeRemote uuid
|
|
#endif
|