webapp: check that tor and magic wormhole are installed
This commit is contained in:
parent
de79be2ba6
commit
9e0aae036b
5 changed files with 51 additions and 8 deletions
|
@ -22,6 +22,7 @@ import Assistant.DaemonStatus
|
||||||
import Utility.Verifiable
|
import Utility.Verifiable
|
||||||
#endif
|
#endif
|
||||||
import Utility.UserInfo
|
import Utility.UserInfo
|
||||||
|
import Utility.Tor
|
||||||
import qualified Utility.MagicWormhole as Wormhole
|
import qualified Utility.MagicWormhole as Wormhole
|
||||||
import Git
|
import Git
|
||||||
|
|
||||||
|
@ -49,14 +50,15 @@ postStartTorPairSelfR :: Handler Html
|
||||||
postStartTorPairSelfR = postStartTorPairR PairingWithSelf
|
postStartTorPairSelfR = postStartTorPairR PairingWithSelf
|
||||||
|
|
||||||
postStartTorPairR :: PairingWith -> Handler Html
|
postStartTorPairR :: PairingWith -> Handler Html
|
||||||
postStartTorPairR pairingwith = pairPage $ do
|
postStartTorPairR pairingwith = whenTorInstalled $ whenWormholeInstalled $
|
||||||
let Just ourcode = Wormhole.mkCode "11-bannana-bananna" -- XXX tmp
|
pairPage $ do
|
||||||
((result, form), enctype) <- liftH $
|
let Just ourcode = Wormhole.mkCode "11-bannana-bananna" -- XXX tmp
|
||||||
runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $
|
((result, form), enctype) <- liftH $
|
||||||
areq wormholeCodeField (bfs codeprompt) Nothing
|
runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $
|
||||||
case result of
|
areq wormholeCodeField (bfs codeprompt) Nothing
|
||||||
FormSuccess v -> error "TODO"
|
case result of
|
||||||
_ -> showform form enctype ourcode
|
FormSuccess v -> error "TODO"
|
||||||
|
_ -> showform form enctype ourcode
|
||||||
where
|
where
|
||||||
showform form enctype ourcode = $(widgetFile "configurators/pairing/tor/prompt")
|
showform form enctype ourcode = $(widgetFile "configurators/pairing/tor/prompt")
|
||||||
codeprompt = case pairingwith of
|
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)
|
("That does not look like a valid pairing code. Try again..." :: T.Text)
|
||||||
textField
|
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. -}
|
{- Starts local pairing. -}
|
||||||
getStartLocalPairR :: Handler Html
|
getStartLocalPairR :: Handler Html
|
||||||
getStartLocalPairR = postStartLocalPairR
|
getStartLocalPairR = postStartLocalPairR
|
||||||
|
|
|
@ -161,3 +161,6 @@ torLibDir = "/var/lib/tor"
|
||||||
|
|
||||||
varLibDir :: FilePath
|
varLibDir :: FilePath
|
||||||
varLibDir = "/var/lib"
|
varLibDir = "/var/lib"
|
||||||
|
|
||||||
|
torIsInstalled :: IO Bool
|
||||||
|
torIsInstalled = inPath "tor"
|
||||||
|
|
|
@ -227,6 +227,8 @@ Extra-Source-Files:
|
||||||
templates/configurators/rsync.net/encrypt.hamlet
|
templates/configurators/rsync.net/encrypt.hamlet
|
||||||
templates/configurators/gitlab.com/add.hamlet
|
templates/configurators/gitlab.com/add.hamlet
|
||||||
templates/configurators/needgcrypt.hamlet
|
templates/configurators/needgcrypt.hamlet
|
||||||
|
templates/configurators/needtor.hamlet
|
||||||
|
templates/configurators/needmagicwormhole.hamlet
|
||||||
templates/configurators/enabledirectory.hamlet
|
templates/configurators/enabledirectory.hamlet
|
||||||
templates/configurators/fsck/status.hamlet
|
templates/configurators/fsck/status.hamlet
|
||||||
templates/configurators/fsck/form.hamlet
|
templates/configurators/fsck/form.hamlet
|
||||||
|
|
11
templates/configurators/needmagicwormhole.hamlet
Normal file
11
templates/configurators/needmagicwormhole.hamlet
Normal 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
|
11
templates/configurators/needtor.hamlet
Normal file
11
templates/configurators/needtor.hamlet
Normal 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
|
Loading…
Add table
Add a link
Reference in a new issue