summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Assistant/Threads/WebApp.hs31
-rw-r--r--Utility/WebApp.hs13
2 files changed, 33 insertions, 11 deletions
diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs
index 4e6fea6b1..06909fd53 100644
--- a/Assistant/Threads/WebApp.hs
+++ b/Assistant/Threads/WebApp.hs
@@ -14,17 +14,19 @@ import Assistant.ThreadedMonad
import Assistant.DaemonStatus
import Utility.WebApp
import Utility.Yesod
+import Utility.FileMode
+import Utility.TempFile
import Git
import Yesod
import Yesod.Static
import Text.Hamlet
import Network.Socket (PortNumber)
-import Text.Blaze.Renderer.Utf8
-import Data.ByteString.Lazy as L
+import Text.Blaze.Renderer.String
data WebApp = WebApp
{ daemonStatus :: DaemonStatusHandle
+ , secretToken :: String
, baseTitle :: String
, getStatic :: Static
}
@@ -61,7 +63,7 @@ webAppThread st dstatus = do
( return $ httpDebugLogger app
, return app
)
- runWebApp app' $ \port -> runThreadState st $ writeHtmlShim port
+ runWebApp app' $ \port -> runThreadState st $ writeHtmlShim webapp port
mkWebApp :: ThreadState -> DaemonStatusHandle -> IO WebApp
mkWebApp st dstatus = do
@@ -70,21 +72,28 @@ mkWebApp st dstatus = do
let reldir = if dirContains home dir
then relPathDirToFile home dir
else dir
- let s = $(embed "static")
+ token <- genRandomToken
return $ WebApp
{ daemonStatus = dstatus
+ , secretToken = token
, baseTitle = reldir
- , getStatic = s
+ , getStatic = $(embed "static")
}
{- Creates a html shim file that's used to redirect into the webapp. -}
-writeHtmlShim :: PortNumber -> Annex ()
-writeHtmlShim port = do
+writeHtmlShim :: WebApp -> PortNumber -> Annex ()
+writeHtmlShim webapp port = do
htmlshim <- fromRepo gitAnnexHtmlShim
- liftIO $ L.writeFile htmlshim $ genHtmlShim port
+ liftIO $ viaTmp go htmlshim $ genHtmlShim webapp port
+ where
+ go file content = do
+ h <- openFile file WriteMode
+ modifyFileMode file $ removeModes [groupReadMode, otherReadMode]
+ hPutStr h content
+ hClose h
{- TODO: generate this static file using Yesod. -}
-genHtmlShim :: PortNumber -> L.ByteString
-genHtmlShim port = renderHtml $(shamletFile $ hamletTemplate "htmlshim")
+genHtmlShim :: WebApp -> PortNumber -> String
+genHtmlShim webapp port = renderHtml $(shamletFile $ hamletTemplate "htmlshim")
where
- url = "http://localhost:" ++ show port ++ "/"
+ url = "http://localhost:" ++ show port ++ "/?" ++ secretToken webapp
diff --git a/Utility/WebApp.hs b/Utility/WebApp.hs
index 614a57cea..cded83229 100644
--- a/Utility/WebApp.hs
+++ b/Utility/WebApp.hs
@@ -22,6 +22,9 @@ import Data.ByteString.Lazy
import Data.CaseInsensitive as CI
import Network.Socket
import Control.Exception
+import Crypto.Random
+import Data.Digest.Pure.SHA
+import Data.ByteString.Lazy as L
localhost :: String
localhost = "localhost"
@@ -102,3 +105,13 @@ logRequest req = do
lookupRequestField :: CI Ascii -> Request -> Ascii
lookupRequestField k req = fromMaybe "" . lookup k $ requestHeaders req
+
+{- Generates a 512 byte random token, suitable to be used for an
+ - authentication secret. -}
+genRandomToken :: IO String
+genRandomToken = do
+ g <- newGenIO :: IO SystemRandom
+ return $
+ case genBytes 512 g of
+ Left e -> error $ "failed to generate secret token: " ++ show e
+ Right (s, _) -> showDigest $ sha512 $ L.fromChunks [s]