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 @@ +
+
+

+ Need Magic Wormhole +

+ You need to install # + + Magic Wormhole +

+ + 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 @@ +

+
+

+ Need Tor +

+ You need to install # + + Tor +

+ + Retry