mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

generate random token and launch webapp using it

Browse source
This commit is contained in:
Joey Hess 2012-07-26 03:38:20 -04:00
parent 3ac2cf09e5
commit b36804d648
2 changed files with 33 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

31
Assistant/Threads/WebApp.hs
View file

@ -14,17 +14,19 @@ import Assistant.ThreadedMonad
import Assistant.DaemonStatus import Assistant.DaemonStatus
import Utility.WebApp import Utility.WebApp
import Utility.Yesod import Utility.Yesod
import Utility.FileMode
import Utility.TempFile
import Git import Git
import Yesod import Yesod
import Yesod.Static import Yesod.Static
import Text.Hamlet import Text.Hamlet
import Network.Socket (PortNumber) import Network.Socket (PortNumber)
import Text.Blaze.Renderer.Utf8 import Text.Blaze.Renderer.String
import Data.ByteString.Lazy as L
data WebApp = WebApp data WebApp = WebApp
{ daemonStatus :: DaemonStatusHandle { daemonStatus :: DaemonStatusHandle
, secretToken :: String
, baseTitle :: String , baseTitle :: String
, getStatic :: Static , getStatic :: Static
} }
@ -61,7 +63,7 @@ webAppThread st dstatus = do
( return $ httpDebugLogger app ( return $ httpDebugLogger app
, return app , return app
) )
runWebApp app' $ \port -> runThreadState st $ writeHtmlShim port runWebApp app' $ \port -> runThreadState st $ writeHtmlShim webapp port
mkWebApp :: ThreadState -> DaemonStatusHandle -> IO WebApp mkWebApp :: ThreadState -> DaemonStatusHandle -> IO WebApp
mkWebApp st dstatus = do mkWebApp st dstatus = do
@ -70,21 +72,28 @@ mkWebApp st dstatus = do
let reldir = if dirContains home dir let reldir = if dirContains home dir
then relPathDirToFile home dir then relPathDirToFile home dir
else dir else dir
let s = $(embed "static") token <- genRandomToken
return $ WebApp return $ WebApp
{ daemonStatus = dstatus { daemonStatus = dstatus
, secretToken = token
, baseTitle = reldir , baseTitle = reldir
, getStatic = s , getStatic = $(embed "static")
} }
{- Creates a html shim file that's used to redirect into the webapp. -} {- Creates a html shim file that's used to redirect into the webapp. -}
writeHtmlShim :: PortNumber -> Annex () writeHtmlShim :: WebApp -> PortNumber -> Annex ()
writeHtmlShim port = do writeHtmlShim webapp port = do
htmlshim <- fromRepo gitAnnexHtmlShim 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. -} {- TODO: generate this static file using Yesod. -}
genHtmlShim :: PortNumber -> L.ByteString genHtmlShim :: WebApp -> PortNumber -> String
genHtmlShim port = renderHtml $(shamletFile $ hamletTemplate "htmlshim") genHtmlShim webapp port = renderHtml $(shamletFile $ hamletTemplate "htmlshim")
where where
url = "http://localhost:" ++ show port ++ "/" url = "http://localhost:" ++ show port ++ "/?" ++ secretToken webapp

13
Utility/WebApp.hs
View file

@ -22,6 +22,9 @@ import Data.ByteString.Lazy
import Data.CaseInsensitive as CI import Data.CaseInsensitive as CI
import Network.Socket import Network.Socket
import Control.Exception import Control.Exception
import Crypto.Random
import Data.Digest.Pure.SHA
import Data.ByteString.Lazy as L
localhost :: String localhost :: String
localhost = "localhost" localhost = "localhost"
@ -102,3 +105,13 @@ logRequest req = do
lookupRequestField :: CI Ascii -> Request -> Ascii lookupRequestField :: CI Ascii -> Request -> Ascii
lookupRequestField k req = fromMaybe "" . lookup k $ requestHeaders req 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]