webapp: check that tor and magic wormhole are installed

5 files changed, 51 insertions, 8 deletions

diff --git a/Assistant/WebApp/Configurators/Pairing.hs b/Assistant/WebApp/Configurators/Pairing.hs
index 60a8ee7138..3381b4f647 100644
--- a/Assistant/WebApp/Configurators/Pairing.hs
+++ b/Assistant/WebApp/Configurators/Pairing.hs
@@ -22,6 +22,7 @@ import Assistant.DaemonStatus
 import Utility.Verifiable
 #endif
 import Utility.UserInfo
+import Utility.Tor
 import qualified Utility.MagicWormhole as Wormhole
 import Git
 
@@ -49,14 +50,15 @@ postStartTorPairSelfR :: Handler Html
 postStartTorPairSelfR = postStartTorPairR PairingWithSelf
 
 postStartTorPairR :: PairingWith -> Handler Html
-postStartTorPairR pairingwith = pairPage $ do
-	let Just ourcode = Wormhole.mkCode "11-bannana-bananna" -- XXX tmp
-	((result, form), enctype) <- liftH $
-		runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $
-			areq wormholeCodeField (bfs codeprompt) Nothing
-	case result of
-		FormSuccess v -> error "TODO"
-		_ -> showform form enctype ourcode
+postStartTorPairR pairingwith = whenTorInstalled $ whenWormholeInstalled $
+	pairPage $ do
+		let Just ourcode = Wormhole.mkCode "11-bannana-bananna" -- XXX tmp
+		((result, form), enctype) <- liftH $
+			runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $
+				areq wormholeCodeField (bfs codeprompt) Nothing
+		case result of
+			FormSuccess v -> error "TODO"
+			_ -> showform form enctype ourcode
   where
 	showform form enctype ourcode = $(widgetFile "configurators/pairing/tor/prompt")
 	codeprompt = case pairingwith of
@@ -66,6 +68,20 @@ postStartTorPairR pairingwith = pairPage $ do
 		("That does not look like a valid pairing code. Try again..." :: T.Text)
 		textField
 
+whenTorInstalled :: Handler Html -> Handler Html
+whenTorInstalled a = ifM (liftIO torIsInstalled)
+	( a
+	, page "Need Tor" (Just Configuration) $
+		$(widgetFile "configurators/needtor")
+	)
+
+whenWormholeInstalled :: Handler Html -> Handler Html
+whenWormholeInstalled a = ifM (liftIO Wormhole.isInstalled)
+	( a
+	, page "Need Magic Wormhole" (Just Configuration) $
+		$(widgetFile "configurators/needmagicwormhole")
+	)
+
 {- Starts local pairing. -}
 getStartLocalPairR :: Handler Html
 getStartLocalPairR = postStartLocalPairR
diff --git a/Utility/Tor.hs b/Utility/Tor.hs
index 4e7c0ef43f..37fbabd402 100644
--- a/Utility/Tor.hs
+++ b/Utility/Tor.hs
@@ -161,3 +161,6 @@ torLibDir = "/var/lib/tor"
 
 varLibDir :: FilePath
 varLibDir = "/var/lib"
+
+torIsInstalled :: IO Bool
+torIsInstalled = inPath "tor"
diff --git a/git-annex.cabal b/git-annex.cabal
index f6a4e16606..f2ba889793 100644
--- a/git-annex.cabal
+++ b/git-annex.cabal
@@ -227,6 +227,8 @@ Extra-Source-Files:
   templates/configurators/rsync.net/encrypt.hamlet
   templates/configurators/gitlab.com/add.hamlet
   templates/configurators/needgcrypt.hamlet
+  templates/configurators/needtor.hamlet
+  templates/configurators/needmagicwormhole.hamlet
   templates/configurators/enabledirectory.hamlet
   templates/configurators/fsck/status.hamlet
   templates/configurators/fsck/form.hamlet
diff --git a/templates/configurators/needmagicwormhole.hamlet b/templates/configurators/needmagicwormhole.hamlet
new file mode 100644
index 0000000000..c10d3a1fe8
--- /dev/null
+++ b/templates/configurators/needmagicwormhole.hamlet
@@ -0,0 +1,11 @@
+<div .col-sm-9>
+  <div .content-box>
+    <h2>
+      Need Magic Wormhole
+    <p>
+      You need to install #
+      <a href="https://github.com/warner/magic-wormhole">
+        Magic Wormhole
+    <p>
+      <a .btn .btn-primary .btn-lg href="">
+        Retry
diff --git a/templates/configurators/needtor.hamlet b/templates/configurators/needtor.hamlet
new file mode 100644
index 0000000000..808cbe9251
--- /dev/null
+++ b/templates/configurators/needtor.hamlet
@@ -0,0 +1,11 @@
+<div .col-sm-9>
+  <div .content-box>
+    <h2>
+      Need Tor
+    <p>
+      You need to install #
+      <a href="https://torproject.org/">
+        Tor
+    <p>
+      <a .btn .btn-primary .btn-lg href="">
+        Retry