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
|
||||
#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
|
||||
|
|
|
@ -161,3 +161,6 @@ torLibDir = "/var/lib/tor"
|
|||
|
||||
varLibDir :: FilePath
|
||||
varLibDir = "/var/lib"
|
||||
|
||||
torIsInstalled :: IO Bool
|
||||
torIsInstalled = inPath "tor"
|
||||
|
|
|
@ -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
|
||||
|
|
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