adding removable drive improvements

diff --git a/Assistant/WebApp/Configurators/Local.hs b/Assistant/WebApp/Configurators/Local.hs
index a05952a6c4eb33422a649dd3c4733dd456f99792..1021c85a9a9e8b89f1481866471a0e1e707a4a0e 100644 (file)
--- a/Assistant/WebApp/Configurators/Local.hs
+++ b/Assistant/WebApp/Configurators/Local.hs
@@ -31,10 +31,12 @@ import Remote (prettyListUUIDs)
 import Annex.UUID
 import Types.StandardGroups
 import Logs.PreferredContent
+import Logs.UUID
 import Utility.UserInfo
 import Config
 
 import qualified Data.Text as T
+import qualified Data.Map as M
 import Data.Char
 import System.Posix.Directory
 
@@ -169,16 +171,12 @@ getCombineRepositoryR (FilePathAndUUID newrepopath newrepouuid) = do
   where
        remotename = takeFileName newrepopath
 
-data RemovableDrive = RemovableDrive 
-       { diskFree :: Maybe Integer
-       , mountPoint :: Text
-       }
-       deriving (Show, Eq, Ord)
-
-selectDriveForm :: [RemovableDrive] -> Maybe RemovableDrive -> Form RemovableDrive
-selectDriveForm drives def = renderBootstrap $ RemovableDrive
+selectDriveForm :: [RemovableDrive] -> Form RemovableDrive
+selectDriveForm drives = renderBootstrap $ RemovableDrive
        <$> pure Nothing
-       <*> areq (selectFieldList pairs) "Select drive:" (mountPoint <$> def)
+       <*> areq (selectFieldList pairs) "Select drive:" Nothing
+       <*> areq textField "Use this directory on the drive:"
+               (Just $ T.pack gitAnnexAssistantDefaultDir)
   where
        pairs = zip (map describe drives) (map mountPoint drives)
        describe drive = case diskFree drive of
@@ -191,11 +189,11 @@ selectDriveForm drives def = renderBootstrap $ RemovableDrive
                                , "free)"
                                ]
 
-{- Adding a removable drive.
- -
- - The repo may already exist, when adding removable media
- - that has already been used elsewhere.
- -}
+removableDriveRepository :: RemovableDrive -> FilePath
+removableDriveRepository drive =
+       T.unpack (mountPoint drive) </> T.unpack (driveRepoPath drive)
+
+{- Adding a removable drive. -}
 getAddDriveR :: Handler RepHtml
 getAddDriveR = postAddDriveR
 postAddDriveR :: Handler RepHtml
@@ -204,13 +202,43 @@ postAddDriveR = page "Add a removable drive" (Just Configuration) $ do
        writabledrives <- liftIO $
                filterM (canWrite . T.unpack . mountPoint) removabledrives
        ((res, form), enctype) <- lift $ runFormPost $
-               selectDriveForm (sort writabledrives) Nothing
+               selectDriveForm (sort writabledrives)
        case res of
-               FormSuccess (RemovableDrive { mountPoint = d }) -> lift $
-                       make (T.unpack d) >>= redirect . EditNewRepositoryR
+               FormSuccess drive -> lift $ redirect $ ConfirmAddDriveR drive
                _ -> $(widgetFile "configurators/adddrive")
+
+{- The repo may already exist, when adding removable media
+ - that has already been used elsewhere. If so, check
+ - the UUID of the repo and see if it's one we know. If not,
+ - the user must confirm the repository merge. -}
+getConfirmAddDriveR :: RemovableDrive -> Handler RepHtml
+getConfirmAddDriveR drive = do
+       ifM (needconfirm)
+               ( page "Combine repositories?" (Just Configuration) $
+                       $(widgetFile "configurators/adddrive/confirm")
+               , do
+                       getFinishAddDriveR drive
+               )
+  where
+       dir = removableDriveRepository drive
+       needconfirm = ifM (liftIO $ doesDirectoryExist dir)
+               ( liftAnnex $ do
+                       mu <- liftIO $ catchMaybeIO $
+                               inDir dir $ getUUID
+                       case mu of
+                               Nothing -> return False
+                               Just driveuuid -> not .
+                                       M.member driveuuid <$> uuidMap
+               , return False
+               )
+
+cloneModal :: Widget
+cloneModal = $(widgetFile "configurators/adddrive/clonemodal")
+
+getFinishAddDriveR :: RemovableDrive -> Handler RepHtml
+getFinishAddDriveR drive = make >>= redirect . EditNewRepositoryR
   where
-       make mountpoint = do
+       make = do
                liftIO $ createDirectoryIfMissing True dir
                isnew <- liftIO $ makeRepo dir True
                u <- liftIO $ initRepo isnew False dir $ Just remotename
@@ -218,9 +246,9 @@ postAddDriveR = page "Add a removable drive" (Just Configuration) $ do
                liftAnnex $ setStandardGroup u TransferGroup
                syncRemote r
                return u
-         where
-               dir = mountpoint </> gitAnnexAssistantDefaultDir
-               remotename = takeFileName mountpoint
+       mountpoint = T.unpack (mountPoint drive)
+       dir = removableDriveRepository drive
+       remotename = takeFileName mountpoint
 
 {- Each repository is made a remote of the other.
  - Next call syncRemote to get them in sync. -}
@@ -245,6 +273,7 @@ driveList = mapM (gen . mnt_dir) =<< filter sane <$> getMounts
        gen dir = RemovableDrive
                <$> getDiskFree dir
                <*> pure (T.pack dir)
+               <*> pure (T.pack gitAnnexAssistantDefaultDir)
        -- filter out some things that are surely not removable drives
        sane Mntent { mnt_dir = dir, mnt_fsname = dev }
                {- We want real disks like /dev/foo, not

diff --git a/Assistant/WebApp/Types.hs b/Assistant/WebApp/Types.hs
index f5454466e55c2d58171e41ddde14c585c9e23f1a..693cf0e4a0e2038b39686c71f2dc1e473160917d 100644 (file)
--- a/Assistant/WebApp/Types.hs
+++ b/Assistant/WebApp/Types.hs
@@ -112,6 +112,13 @@ data RepoSelector = RepoSelector
 data RepoListNotificationId = RepoListNotificationId NotificationId RepoSelector
        deriving (Read, Show, Eq)
 
+data RemovableDrive = RemovableDrive 
+       { diskFree :: Maybe Integer
+       , mountPoint :: Text
+       , driveRepoPath :: Text
+       }
+       deriving (Read, Show, Eq, Ord)
+
 {- Only needed to work around old-yesod bug that emits a warning message
  - when a route has two parameters. -}
 data FilePathAndUUID = FilePathAndUUID FilePath UUID
@@ -121,6 +128,10 @@ instance PathPiece FilePathAndUUID where
        toPathPiece = pack . show
        fromPathPiece = readish . unpack
 
+instance PathPiece RemovableDrive where
+       toPathPiece = pack . show
+       fromPathPiece = readish . unpack
+
 instance PathPiece SshData where
        toPathPiece = pack . show
        fromPathPiece = readish . unpack

diff --git a/Assistant/WebApp/routes b/Assistant/WebApp/routes
index 61a53569c4b53930d35df6f005c3822fece09930..24af53bea39aa3864a0986e41732da56b4969c7a 100644 (file)
--- a/Assistant/WebApp/routes
+++ b/Assistant/WebApp/routes
@@ -31,6 +31,8 @@
 /config/repository/sync/enable/#UUID EnableSyncR GET
 
 /config/repository/add/drive AddDriveR GET POST
+/config/repository/add/drive/confirm/#RemovableDrive ConfirmAddDriveR GET
+/config/repository/add/drive/finish/#RemovableDrive FinishAddDriveR GET
 /config/repository/add/ssh AddSshR GET POST
 /config/repository/add/ssh/confirm/#SshData ConfirmSshR GET
 /config/repository/add/ssh/retry/#SshData RetrySshR GET

diff --git a/debian/changelog b/debian/changelog
index c1a2b8229f105b6de2d00b1fed7e9e33b3155214..c5d612ffb2e64544e678f01bdea58cbd8ed91a94 100644 (file)
--- a/debian/changelog
+++ b/debian/changelog
@@ -31,6 +31,10 @@ git-annex (4.20130315) UNRELEASED; urgency=low
   * assistant: Several optimisations to file transfers.
   * OSX app and standalone Linux tarball now both support being added to
     PATH; no need to use runshell to start git-annex.
+  * webapp: When adding a removable drive, you can now specify the
+    directory inside it to use.
+  * webapp: Confirm whether user wants to combine repositories when
+    adding a removable drive that already has a repository on it.
 
  -- Joey Hess <joeyh@debian.org>  Fri, 15 Mar 2013 00:10:07 -0400
 

diff --git a/templates/configurators/adddrive.hamlet b/templates/configurators/adddrive.hamlet
index 67e300690e3e7faaeecc108bb4767e0bebb0737d..99ebabd930dd2d2f88c04710d26d84afa07feba0 100644 (file)
--- a/templates/configurators/adddrive.hamlet
+++ b/templates/configurators/adddrive.hamlet
@@ -29,11 +29,4 @@
         <button .btn .btn-primary type=submit onclick="$('#clonemodal').modal('show');">Use this drive</button> #
         <a .btn href="@{AddDriveR}">
           Rescan for removable drives
-<div .modal .fade #clonemodal>
-  <div .modal-header>
-    <h3>
-      Cloning to drive
-  <div .modal-body>
-    <p>
-      Cloning the repository to the drive. This may take a few minutes; #
-      do not remove the drive.
+^{cloneModal}

diff --git a/templates/configurators/adddrive/clonemodal.hamlet b/templates/configurators/adddrive/clonemodal.hamlet
new file mode 100644 (file)
index 0000000..1a7a954
--- /dev/null
+++ b/templates/configurators/adddrive/clonemodal.hamlet
@@ -0,0 +1,8 @@
+<div .modal .fade #clonemodal>
+  <div .modal-header>
+    <h3>
+      Cloning to drive
+  <div .modal-body>
+    <p>
+      Cloning the repository to the drive. This may take a few minutes; #
+      do not remove the drive.

diff --git a/templates/configurators/adddrive/confirm.hamlet b/templates/configurators/adddrive/confirm.hamlet
new file mode 100644 (file)
index 0000000..fc92f47
--- /dev/null
+++ b/templates/configurators/adddrive/confirm.hamlet
@@ -0,0 +1,19 @@
+<div .span9 .hero-unit>
+  <h2>
+    Combine repositories?
+  <p>
+    The removable drive at <tt>#{mountPoint drive}</tt> already
+    has files in its repository <tt>#{driveRepoPath drive}</tt>
+  <p>
+    Do you want to combine these files into your repository?
+  <p>
+    <a .btn href="@{FinishAddDriveR drive}">
+      <i .icon-resize-small></i> Combine the repositories #
+    The combined repositories will sync and share their files.
+  <p>
+  <p>
+    <a .btn href="@{AddDriveR}">
+      <i .icon-resize-full></i> Go back #
+    Use a different directory than <tt>#{driveRepoPath drive}</tt> to #
+    avoid combining the repositories.
+^{cloneModal}