Permalink
Browse files

secure cookies

  • Loading branch information...
tianyicui committed Apr 6, 2013
1 parent 7ef1736 commit caae11167e70bac11aeca228d26cb8e2bdaad6e3
Showing with 17 additions and 4 deletions.
  1. +4 −2 Network/Gitit/Authentication.hs
  2. +3 −1 Network/Gitit/Framework.hs
  3. +9 −0 Network/Gitit/Util.hs
  4. +1 −1 gitit.cabal
@@ -374,7 +374,8 @@ loginUser params = do
if allowed
then do
key <- newSession (SessionData uname)
- addCookie (MaxAge $ sessionTimeout cfg) (mkCookie "sid" (show key))
+ cookie <- mkCookieSecure "sid" (show key)
+ addCookie (MaxAge $ sessionTimeout cfg) cookie
seeOther (encUrl destination) $ toResponse $ p << ("Welcome, " ++ uname)
else
withMessages ["Invalid username or password."] loginUserForm
@@ -466,7 +467,8 @@ loginRPXUser params = do
user <- liftIO $ mkUser (fromMaybe userId email) (fromMaybe "" email) "none"
updateGititState $ \s -> s { users = M.insert userId user (users s) }
key <- newSession (SessionData userId)
- addCookie (MaxAge $ sessionTimeout cfg) (mkCookie "sid" (show key))
+ cookie <- mkCookieSecure "sid" (show key)
+ addCookie (MaxAge $ sessionTimeout cfg) cookie
see $ fromJust $ rDestination params
where
prop pname info = lookup pname $ R.userData info
@@ -58,6 +58,7 @@ import Safe
import Network.Gitit.Server
import Network.Gitit.State
import Network.Gitit.Types
+import Network.Gitit.Util
import Data.FileStore
import Data.Char (toLower)
import Control.Monad (mzero, liftM, unless, MonadPlus)
@@ -105,7 +106,8 @@ withUserFromSession handler = withData $ \(sk :: Maybe SessionKey) -> do
mbUser <- case mbSd of
Nothing -> return Nothing
Just sd -> do
- addCookie (MaxAge $ sessionTimeout cfg) (mkCookie "sid" (show $ fromJust sk)) -- refresh timeout
+ cookie <- mkCookieSecure "sid" (show $ fromJust sk)
+ addCookie (MaxAge $ sessionTimeout cfg) cookie -- refresh timeout
getUser $! sessionUser sd
let user = maybe "" uUsername mbUser
localRq (setHeader "REMOTE_USER" user) handler
View
@@ -25,6 +25,7 @@ module Network.Gitit.Util ( readFileUTF8
, trim
, yesOrNo
, parsePageType
+ , mkCookieSecure
)
where
import System.Directory
@@ -34,6 +35,9 @@ import System.IO.Error (isAlreadyExistsError)
import Control.Monad.Trans (liftIO)
import Data.Char (toLower)
import Network.Gitit.Types
+import Happstack.Server.Cookie (Cookie(Cookie))
+import Happstack.Server.Internal.Types (rqSecure)
+import Happstack.Server.Internal.Monads (ServerMonad, askRq)
import qualified Control.Exception as E
import qualified Text.Pandoc.UTF8 as UTF8
@@ -101,3 +105,8 @@ parsePageType s =
"latex+lhs" -> (LaTeX,True)
x -> error $ "Unknown page type: " ++ x
+-- | Make a cookie from name and value, when the request is secure, make the cookie secure
+mkCookieSecure :: ServerMonad m => String -> String -> m Cookie
+mkCookieSecure key val = do
+ rq <- askRq
+ return $ Cookie "1" "/" "" key val (rqSecure rq) False
View
@@ -1,5 +1,5 @@
name: gitit
-version: 0.10.3.1
+version: 0.10.3.2
Cabal-version: >= 1.6
build-type: Simple
synopsis: Wiki using happstack, git or darcs, and pandoc.

0 comments on commit caae111

Please sign in to comment.