webapp: check that tor and magic wormhole are installed

This commit is contained in:
Joey Hess 2016-12-24 17:08:03 -04:00
parent de79be2ba6
commit 9e0aae036b
No known key found for this signature in database
GPG key ID: C910D9222512E3C7
5 changed files with 51 additions and 8 deletions

View file

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

View file

@ -161,3 +161,6 @@ torLibDir = "/var/lib/tor"
varLibDir :: FilePath
varLibDir = "/var/lib"
torIsInstalled :: IO Bool
torIsInstalled = inPath "tor"

View file

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

View file

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

View file

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