blob: 2e06d52cd15da89a38c28623634033a1150a75e9 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
|
{- 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.Command
import qualified Git.BuildVersion
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.Command.run
[ Param "remote"
-- name of this subcommand changed
, Param $
if Git.BuildVersion.older "1.8.0"
then "rm"
else "remove"
, Param (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
|
