move content from remote when user asks to delete it

Assistant/WebApp/Configurators/Delete.hs

@@ -12,14 +12,16 @@ module Assistant.WebApp.Configurators.Delete where
 import Assistant.WebApp.Common
 import Assistant.WebApp.Utility
 import Assistant.DaemonStatus
+import Assistant.ScanRemotes
 import qualified Remote
-import qualified Types.Remote as Remote
 import Remote.List (remoteListRefresh)
-import Command.Dead (markDead)
 import qualified Git.Command
 import qualified Git
 import Locations.UserConfig
 import Utility.FileMode
+import Logs.Trust
+import Logs.PreferredContent
+import Types.StandardGroups
 
 import qualified Data.Text as T
 import System.IO.HVFS (SystemFS(..))
@@ -28,7 +30,7 @@ getDeleteRepositoryR :: UUID -> Handler RepHtml
 getDeleteRepositoryR uuid = go =<< liftAnnex (Remote.remoteFromUUID uuid)
   where
   	go Nothing = redirect DeleteCurrentRepositoryR
-	go (Just r) = page "Delete repository" (Just Configuration) $ do
+	go (Just r) = deletionPage $ do
 		reponame <- liftAnnex $ concat <$> Remote.prettyListUUIDs [uuid]
 		$(widgetFile "configurators/delete/choose")
 
@@ -51,24 +53,17 @@ removeRemote uuid = do
 	updateSyncRemotes
 	return remote
 
-getDeleteRepositoryContentsR :: UUID -> Handler RepHtml
+getStartDeleteRepositoryContentsR :: UUID -> Handler RepHtml
-getDeleteRepositoryContentsR = deleteRepositoryContents
+getStartDeleteRepositoryContentsR uuid = deletionPage $ do
+	remote <- fromMaybe (error "unknown remote")
+		<$> liftAnnex (Remote.remoteFromUUID uuid)
+	liftAnnex $ do
+		trustSet uuid UnTrusted
+		setStandardGroup uuid UnwantedGroup
+	liftAssistant $ addScanRemotes True [remote]
 
-postDeleteRepositoryContentsR :: UUID -> Handler RepHtml
-postDeleteRepositoryContentsR = deleteRepositoryContents
-
-deleteRepositoryContents :: UUID -> Handler RepHtml
-deleteRepositoryContents uuid = dangerPage $ do
 	reponame <- liftAnnex $ concat <$> Remote.prettyListUUIDs [uuid]
-	((result, form), enctype) <- lift $
+	$(widgetFile "configurators/delete/started")
-		runFormPost $ renderBootstrap $ sanityVerifierAForm $
-			SanityVerifier magicphrase
-	case result of
-		FormSuccess _ -> do
-			liftAnnex $ markDead uuid
-			oldremote <- liftAssistant $ removeRemote uuid
-			$(widgetFile "configurators/delete/repositorycontents/nextstep")
-		_ -> $(widgetFile "configurators/delete/repositorycontents")
 
 getDeleteCurrentRepositoryR :: Handler RepHtml
 getDeleteCurrentRepositoryR = deleteCurrentRepository
@@ -122,6 +117,9 @@ sanityVerifierAForm template = SanityVerifier
 	
 	insane = "Maybe this is not a good idea..." :: Text
 
+deletionPage :: Widget -> Handler RepHtml
+deletionPage = page "Delete repository" (Just Configuration)
+
 dangerPage :: Widget -> Handler RepHtml
 dangerPage = page "Danger danger danger" (Just Configuration)
 

Assistant/WebApp/routes

@@ -31,7 +31,7 @@
 /config/repository/sync/enable/#UUID EnableSyncR GET
 /config/repository/delete/choose/#UUID DeleteRepositoryR GET
 /config/repository/delete/fromlist/#UUID DeleteRepositoryFromListR GET
-/config/repository/delete/contents/#UUID DeleteRepositoryContentsR GET POST
+/config/repository/delete/contents/start/#UUID StartDeleteRepositoryContentsR GET
 /config/repository/delete/here DeleteCurrentRepositoryR GET POST
 
 /config/repository/add/drive AddDriveR GET POST

Types/StandardGroups.hs

@@ -51,26 +51,27 @@ descStandardGroup SmallArchiveGroup = "small archive: archives files located in
 descStandardGroup FullArchiveGroup = "full archive: archives all files not archived elsewhere"
 descStandardGroup SourceGroup = "file source: moves files on to other repositories"
 descStandardGroup ManualGroup = "manual mode: only stores files you manually choose"
-descStandardGroup UnwantedGroup "unwanted: a repository in the process of being removed"
+descStandardGroup UnwantedGroup = "unwanted: remove content from this repository"
 
 {- See doc/preferred_content.mdwn for explanations of these expressions. -}
 preferredContent :: StandardGroup -> String
-preferredContent ClientGroup = normal
+preferredContent ClientGroup = lastResort
 	"exclude=*/archive/* and exclude=archive/*"
-preferredContent TransferGroup = normal $
+preferredContent TransferGroup = lastResort $
 	"not (inallgroup=client and copies=client:2) and " ++ preferredContent ClientGroup
 preferredContent BackupGroup = "include=*"
-preferredContent IncrementalBackupGroup = normal $
+preferredContent IncrementalBackupGroup = lastResort $
 	"include=* and (not copies=incrementalbackup:1)"
-preferredContent SmallArchiveGroup = normal $
+preferredContent SmallArchiveGroup = lastResort $
 	"(include=*/archive/* or include=archive/*) and " ++ preferredContent FullArchiveGroup
-preferredContent FullArchiveGroup = normal $
+preferredContent FullArchiveGroup = lastResort $
 	"not (copies=archive:1 or copies=smallarchive:1)"
 preferredContent SourceGroup = "not (copies=1)"
-preferredContent ManualGroup = normal $
+preferredContent ManualGroup = lastResort $
 	"present and exclude=*/archive/* and exclude=archive/*"
 preferredContent UnwantedGroup = "exclude=*"
-  where
+  	
-  	{- Most repositories want any content that is only on untrusted
+{- Most repositories want any content that is only on untrusted
-	 - or dead repositories. -}
+ - or dead repositories. -}
-	normal s = "(" ++ s ++ ") or (not copies=semitrusted:1)"
+lastResort :: String -> String
+lastResort s = "(" ++ s ++ ") or (not copies=semitrusted:1)"

debian/changelog

@@ -20,8 +20,8 @@ git-annex (4.20130324) UNRELEASED; urgency=low
     Thanks, guilhem for the patch.
   * webapp: Added UI to delete repositories. Closes: #689847
   * Adjust built-in preferred content expressions to make most types
-    of repositories want content that is only located on untrusted or dead
+    of repositories want content that is only located on untrusted, dead,
-    repositories.
+    and unwanted repositories.
 
  -- Joey Hess <joeyh@debian.org>  Mon, 25 Mar 2013 10:21:46 -0400
 

templates/configurators/delete/choose.hamlet

@@ -10,12 +10,14 @@
     but its contents left as-is. This prevents further syncing #
     to the repository. You can add the repository back at any time.
     <br>
-    <a .btn .btn-default href="@{DeleteRepositoryFromListR uuid}">
+    <a .btn .btn-primary href="@{DeleteRepositoryFromListR uuid}">
       <i .icon-minus></i> Remove repository from list
   <p style="text-align: center">
     -or-
   <p>
-    All data in the repository can be deleted. This is dangerous!
+    All data in the repository can be moved off it, to other repositories. #
+    Once all the data has been transferred, the repository can be safely #
+    deleted.
     <br>
-     <a .btn .btn-danger  href="@{DeleteRepositoryContentsR uuid}">
+     <a .btn .btn-primary href="@{StartDeleteRepositoryContentsR uuid}">
-       <i .icon-warning-sign></i> Remove repository and all its contents
+       <i .icon-minus></i> Start deletion process

templates/configurators/delete/repositorycontents.hamlet

@@ -1,20 +0,0 @@
-<div .span9 .hero-unit>
-  <h2>
-    Delete repository contents?
-  <p>
-    Deleting the contents of the repository "#{reponame}" could cause #
-    you to lose data. Some files might <em>only</em> be stored in #
-    that repository.
-  <p>
-    If you choose to delete the repository, and potentially lose #
-    data, enter "#{magicphrase}" into the box.
-  <p>
-    <form method="post" .form-horizontal enctype=#{enctype}>
-      <fieldset>
-        ^{form}
-        ^{webAppFormAuthToken}
-        <div .form-actions>
-          <button .btn .btn-danger type=submit>
-            <i .icon-warning-sign></i> Delete repository #
-          <a .btn .btn-primary href="@{DashboardR}">
-            Cancel

templates/configurators/delete/repositorycontents/nextstep.hamlet

@@ -1,23 +0,0 @@
-<div .span9 .hero-unit>
-  <h2>
-    Deleting repository contents
-  <p>
-    The repository "#{reponame}" has now been removed from the list, and #
-    marked as a dead repository. But, this program is not currently #
-    able to delete the contents of remote repositories.
-  $maybe path <- Remote.localpath oldremote
-    <p>
-      <i .icon-warning-sign></i> #
-      To delete the repository, remove everything in <tt>#{path}</tt>
-    <p>
-      (If the repository is on a removable drive, make sure it's mounted #
-      first.)
-  $nothing
-    $if Git.repoIsUrl (Remote.repo oldremote)
-      <p>
-        <i .icon-warning-sign></i> #
-        To delete the repository, remove everything in <tt>#{Git.repoLocation (Remote.repo oldremote)}</tt>
-    $else
-      <p>
-        <i .icon-warning-sign></i> #
-        It's up to you to finish deleting the contents of the repository.

templates/configurators/delete/started.hamlet

@@ -0,0 +1,10 @@
+<div .span9 .hero-unit>
+  <h2>
+    Deletion process started
+  <p>
+    All files located on the repository "#{reponame}" are being #
+    removed from it. Any files that were only located there will #
+    be moved to other repositories.
+  <p>
+    This could take a while. You can continue using git-annex as usual #
+    while this process is under way.