diff options
-rw-r--r-- | Assistant/Threads/WebApp.hs | 31 | ||||
-rw-r--r-- | Utility/WebApp.hs | 13 |
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] |