From fbaf52d7b852d02ec0b5bfe639715a29024b1a9b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 3 Jan 2013 18:50:30 -0400 Subject: restart UI Browser behavior is not ideal; a new tab is opened on restart. Browsers won't let me redirect to a file:// so I cannot use the old tab. --- Utility/FileMode.hs | 9 +++++++++ Utility/WebApp.hs | 22 ++++++++++++++++++++++ 2 files changed, 31 insertions(+) (limited to 'Utility') diff --git a/Utility/FileMode.hs b/Utility/FileMode.hs index ddb89b2aa..0f7046333 100644 --- a/Utility/FileMode.hs +++ b/Utility/FileMode.hs @@ -101,3 +101,12 @@ isSticky = checkMode stickyMode setSticky :: FilePath -> IO () setSticky f = modifyFileMode f $ addModes [stickyMode] + +{- Writes a file, ensuring that its modes do not allow it to be read + - by anyone other than the current user, before any content is written. -} +writeFileProtected :: FilePath -> String -> IO () +writeFileProtected file content = do + h <- openFile file WriteMode + modifyFileMode file $ removeModes [groupReadMode, otherReadMode] + hPutStr h content + hClose h diff --git a/Utility/WebApp.hs b/Utility/WebApp.hs index 6f64b2bdf..d3bd523a8 100644 --- a/Utility/WebApp.hs +++ b/Utility/WebApp.hs @@ -10,6 +10,8 @@ module Utility.WebApp where import Common +import Utility.TempFile +import Utility.FileMode import qualified Yesod import qualified Network.Wai as Wai @@ -188,3 +190,23 @@ insertAuthToken extractToken predicate webapp root pathbits params = params' | predicate pathbits = authparam:params | otherwise = params + +{- Creates a html shim file that's used to redirect into the webapp, + - to avoid exposing the secret token when launching the web browser. -} +writeHtmlShim :: String -> String -> FilePath -> IO () +writeHtmlShim title url file = viaTmp writeFileProtected file $ genHtmlShim title url + +{- TODO: generate this static file using Yesod. -} +genHtmlShim :: String -> String -> String +genHtmlShim title url = unlines + [ "" + , "" + , ""++ title ++ "" + , "" + , "" + , "

" + , "" ++ title ++ "" + , "

" + , "" + , "" + ] -- cgit v1.2.3