webapp: Improve handling of remotes whose setup has stalled.

This includes recovery from the ssh-agent problem that led to many reporting
http://git-annex.branchable.com/bugs/Internal_Server_Error:_Unknown_UUID/
(Including fixing up .ssh/config to set IdentitiesOnly.)

Remotes that have no known uuid are now displayed in the webapp as
"unfinished". There's a link to check their status, and if the remote
has been set annex-ignore, a retry button can be used to unset that and
try again to set up the remote.

As this bug has shown, the process of adding a ssh remote has some failure
modes that are not really ideal. It would certianly be better if, when
setting up a ssh remote it would detect if it's failed to get the UUID,
and handle that in the remote setup process, rather than waiting until
later and handling it this way.

However, that's hard to do, particularly for local pairing, since the
PairListener runs as a background thread. The best it could do is pop up an
alert if there's a problem. This solution is not much different.

Also, this solution handles cases where the user has gotten their repo into
a mess manually and let's the assistant help with cleaning it up.

This commit was sponsored by Chia Shee Liang. Thanks!

Assistant/Ssh.hs

@@ -198,6 +198,36 @@ setupSshKeyPair sshkeypair sshdata = do
 	sshprivkeyfile = "git-annex" </> "key." ++ mangleSshHostName sshdata
 	sshpubkeyfile = sshprivkeyfile ++ ".pub"
 
+{- Fixes git-annex ssh key pairs configured in .ssh/config 
+ - by old versions to set IdentitiesOnly. -}
+fixSshKeyPair :: IO ()
+fixSshKeyPair = do
+	sshdir <- sshDir
+	let configfile = sshdir </> "config"
+	whenM (doesFileExist configfile) $ do
+		ls <- lines <$> readFileStrict configfile
+		let ls' = fixSshKeyPair' ls
+		when (ls /= ls') $
+			viaTmp writeFile configfile $ unlines ls'
+
+{- Strategy: Search for IdentityFile lines in for files with key.git-annex
+ - in their names. These are for git-annex ssh key pairs.
+ - Add the IdentitiesOnly line immediately after them, if not already
+ - present. -}
+fixSshKeyPair' :: [String] -> [String]
+fixSshKeyPair' = go []
+  where
+  	go c [] = reverse c
+	go c (l:[])
+		| all (`isInfixOf` l) indicators = go (fixedline l:l:c) []
+		| otherwise = go (l:c) []
+	go c (l:next:rest)
+		| all (`isInfixOf` l) indicators && not ("IdentitiesOnly" `isInfixOf` next) = 
+			go (fixedline l:l:c) (next:rest)
+		| otherwise = go (l:c) (next:rest)
+  	indicators = ["IdentityFile", "key.git-annex"]
+	fixedline tmpl = takeWhile isSpace tmpl ++ "IdentitiesOnly yes"
+
 {- Setups up a ssh config with a mangled hostname.
  - Returns a modified SshData containing the mangled hostname. -}
 setSshConfig :: SshData -> [(String, String)] -> IO SshData

Assistant/WebApp/RepoList.hs

@@ -13,6 +13,7 @@ import Assistant.WebApp.Common
 import Assistant.DaemonStatus
 import Assistant.WebApp.Notifications
 import Assistant.WebApp.Utility
+import Assistant.Ssh
 import qualified Annex
 import qualified Remote
 import qualified Types.Remote as Remote
@@ -22,6 +23,8 @@ import Logs.Remote
 import Logs.Trust
 import Logs.Group
 import Config
+import Git.Config
+import Assistant.Sync
 import Config.Cost
 import qualified Git
 #ifdef WITH_XMPP
@@ -177,8 +180,7 @@ repoList reposelector
 	  where
 		val iscloud r = Just (iscloud, (u, DisabledRepoActions $ r u))
 	list l = liftAnnex $ do
-		let l' = filter (\(u, _) -> u /= NoUUID) $
+		let l' = nubBy (\x y -> fst x == fst y) l
-			nubBy (\x y -> fst x == fst y) l
 		l'' <- zip
 			<$> Remote.prettyListUUIDs (map fst l')
 			<*> pure l'
@@ -223,3 +225,30 @@ reorderCosts remote rs = zip rs'' (insertCostAfter costs i)
 	rs' = filter (\r -> Remote.uuid r /= Remote.uuid remote) rs
 	costs = map Remote.cost rs'
 	rs'' = (\(x, y) -> x ++ [remote] ++ y) $ splitAt (i + 1) rs'
+
+{- Checks to see if any repositories with NoUUID have annex-ignore set.
+ - That could happen if there's a problem contacting a ssh remote
+ - soon after it was added. -}
+getCheckUnfinishedRepositoriesR :: Handler Html
+getCheckUnfinishedRepositoriesR = page "Unfinished repositories" (Just Configuration) $ do
+	stalled <- liftAnnex findStalled
+	$(widgetFile "configurators/checkunfinished")
+
+findStalled :: Annex [Remote]
+findStalled = filter isstalled <$> remoteListRefresh
+  where
+  	isstalled r = Remote.uuid r == NoUUID
+		&& remoteAnnexIgnore (Remote.gitconfig r)
+
+getRetryUnfinishedRepositoriesR :: Handler ()
+getRetryUnfinishedRepositoriesR = do
+	liftAssistant $ mapM_ unstall =<< liftAnnex findStalled
+	redirect DashboardR
+  where
+	unstall r = do
+		liftIO $ fixSshKeyPair
+		liftAnnex $ setConfig 
+			(remoteConfig (Remote.repo r) "ignore")
+			(boolConfig False)
+		syncRemote r
+		liftAnnex $ void remoteListRefresh

Assistant/WebApp/routes

@@ -32,6 +32,8 @@
 /config/repository/edit/new/cloud/#UUID EditNewCloudRepositoryR GET POST
 /config/repository/sync/disable/#UUID DisableSyncR GET
 /config/repository/sync/enable/#UUID EnableSyncR GET
+/config/repository/unfinished/check CheckUnfinishedRepositoriesR GET
+/config/repository/unfinished/retry RetryUnfinishedRepositoriesR GET
 
 /config/repository/add/drive AddDriveR GET POST
 /config/repository/add/drive/confirm/#RemovableDrive ConfirmAddDriveR GET

debian/changelog

@@ -15,6 +15,7 @@ git-annex (4.20130724) UNRELEASED; urgency=low
     on a host, set IdentitiesOnly to prevent the ssh-agent from forcing
     use of a different ssh key. That could result in unncessary password
     prompts, or prevent git-annex-shell from being run on the remote host.
+  * webapp: Improve handling of remotes whose setup has stalled.
   * Add status message to XMPP presence tag, to identify to others that
     the client is a git-annex client. Closes: #717652
   * webapp: When creating a repository on a removable drive, set

templates/configurators/checkunfinished.hamlet

@@ -0,0 +1,16 @@
+<div .span9 .hero-unit>
+  $if null stalled
+    <h2>
+      The repository is still not finished being set up. Patience..
+    <p>
+      If you suspect something is wrong, you might want to take a look #
+      at the 
+      <a href="@{LogR}">
+        Log
+  $else
+    <h2>
+      Setting up this repository seems to have stalled!
+    <p>
+      Make sure the remote system is available and
+      <a .btn .btn-primary href="@{RetryUnfinishedRepositoriesR}">
+        Retry

templates/repolist.hamlet

@@ -12,41 +12,52 @@
   <table .table .table-condensed>
     <tbody #costsortable>
       $forall (name, uuid, actions) <- repolist
-        <tr .repoline ##{fromUUID uuid}>
+        $if uuid == NoUUID
-          <td .handle>
+          <tr .repoline>
-            <a .btn .btn-mini .disabled>
+            <td>
-              <i .icon-resize-vertical></i>
+              <a .btn .btn-mini .disabled>
-            &nbsp; #{name}
+                <i .icon-time></i>
-          <td .draghide>
+              &nbsp; unfinished repository
-            $if needsEnabled actions
+            <td>
-              <a href="@{setupRepoLink actions}">
+              <a href="@{CheckUnfinishedRepositoriesR}">
-                <i .icon-warning-sign></i> not enabled
+                <i .icon-question-sign></i> check status
-            $else
+            <td>
-              $if notWanted actions
+        $else
-                <i .icon-trash></i> cleaning out..
+          <tr .repoline ##{fromUUID uuid}>
+            <td .handle>
+              <a .btn .btn-mini .disabled>
+                <i .icon-resize-vertical></i>
+              &nbsp; #{name}
+            <td .draghide>
+              $if needsEnabled actions
+                <a href="@{setupRepoLink actions}">
+                  <i .icon-warning-sign></i> not enabled
               $else
-                <a href="@{syncToggleLink actions}">
+                $if notWanted actions
-                  $if notSyncing actions
+                  <i .icon-trash></i> cleaning out..
-                    <i .icon-ban-circle></i> syncing disabled
+                $else
-                  $else
+                  <a href="@{syncToggleLink actions}">
-                    <i .icon-refresh></i> syncing enabled
+                    $if notSyncing actions
-          <td .draghide>
+                      <i .icon-ban-circle></i> syncing disabled
-            $if needsEnabled actions
+                    $else
-              <a href="@{setupRepoLink actions}">
+                      <i .icon-refresh></i> syncing enabled
-                enable
+            <td .draghide>
-            $else
+              $if needsEnabled actions
-              <span .dropdown #menu-#{fromUUID uuid}>
+                <a href="@{setupRepoLink actions}">
-                <a .dropdown-toggle data-toggle="dropdown" href="#menu-#{fromUUID uuid}">
+                  enable
-                  <i .icon-cog></i> settings
+              $else
-                  <b .caret></b>
+                <span .dropdown #menu-#{fromUUID uuid}>
-                <ul .dropdown-menu>
+                  <a .dropdown-toggle data-toggle="dropdown" href="#menu-#{fromUUID uuid}">
-                  <li>
+                    <i .icon-cog></i> settings
-                    <a href="@{setupRepoLink actions}">
+                    <b .caret></b>
-                      <i .icon-pencil></i> Edit
+                  <ul .dropdown-menu>
-                    <a href="@{DisableRepositoryR uuid}">
+                    <li>
-                      <i .icon-minus></i> Disable
+                      <a href="@{setupRepoLink actions}">
-                    <a href="@{DeleteRepositoryR uuid}">
+                        <i .icon-pencil></i> Edit
-                      <i .icon-trash></i> Delete
+                      <a href="@{DisableRepositoryR uuid}">
+                        <i .icon-minus></i> Disable
+                      <a href="@{DeleteRepositoryR uuid}">
+                        <i .icon-trash></i> Delete
       $if addmore
         <tr>
           <td colspan="3">