diff options
-rw-r--r-- | Assistant/Threads/WebApp.hs | 4 | ||||
-rw-r--r-- | BuildFlags.hs | 4 | ||||
-rw-r--r-- | Utility/WebApp.hs | 60 | ||||
-rw-r--r-- | debian/changelog | 1 | ||||
-rw-r--r-- | debian/control | 2 | ||||
-rw-r--r-- | git-annex.cabal | 13 |
6 files changed, 56 insertions, 28 deletions
diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs index f90f74287..8d977194b 100644 --- a/Assistant/Threads/WebApp.hs +++ b/Assistant/Threads/WebApp.hs @@ -73,7 +73,7 @@ webAppThread assistantdata urlrenderer noannex cannotrun postfirstrun listenhost #endif webapp <- WebApp <$> pure assistantdata - <*> (pack <$> genRandomToken) + <*> genAuthToken <*> getreldir <*> pure staticRoutes <*> pure postfirstrun @@ -125,7 +125,7 @@ myUrl tlssettings webapp addr = unpack $ yesodRender webapp urlbase DashboardR [ getTlsSettings :: Annex (Maybe TLS.TLSSettings) getTlsSettings = do -#ifdef WITH_WEBAPP_HTTPS +#ifdef WITH_WEBAPP_SECURE cert <- fromRepo gitAnnexWebCertificate privkey <- fromRepo gitAnnexWebPrivKey ifM (liftIO $ allM doesFileExist [cert, privkey]) diff --git a/BuildFlags.hs b/BuildFlags.hs index d5c98aa4e..e36cf6a14 100644 --- a/BuildFlags.hs +++ b/BuildFlags.hs @@ -22,8 +22,8 @@ buildFlags = filter (not . null) #else #warning Building without the webapp. You probably need to install Yesod.. #endif -#ifdef WITH_WEBAPP_HTTPS - , "Webapp-https" +#ifdef WITH_WEBAPP_SECURE + , "Webapp-secure" #endif #ifdef WITH_PAIRING , "Pairing" diff --git a/Utility/WebApp.hs b/Utility/WebApp.hs index 31d3711f1..8e08ab9e0 100644 --- a/Utility/WebApp.hs +++ b/Utility/WebApp.hs @@ -1,6 +1,6 @@ {- Yesod webapp - - - Copyright 2012 Joey Hess <joey@kitenet.net> + - Copyright 2012-2014 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -} @@ -36,6 +36,10 @@ import Blaze.ByteString.Builder (Builder) import Data.Monoid import Control.Arrow ((***)) import Control.Concurrent +#ifdef WITH_WEBAPP_SECURE +import Data.SecureMem +import Data.Byteable +#endif #ifdef __ANDROID__ import Data.Endian #endif @@ -74,14 +78,14 @@ browserProc url = proc "xdg-open" [url] runWebApp :: Maybe TLSSettings -> Maybe HostName -> Wai.Application -> (SockAddr -> IO ()) -> IO () runWebApp tlssettings h app observer = withSocketsDo $ do sock <- getSocket h - void $ forkIO $ run webAppSettings sock app + void $ forkIO $ go webAppSettings sock app sockaddr <- fixSockAddr <$> getSocketName sock observer sockaddr where -#ifdef WITH_WEBAPP_HTTPS - run = (maybe runSettingsSocket (\ts -> runTLSSocket ts) tlssettings) +#ifdef WITH_WEBAPP_SECURE + go = (maybe runSettingsSocket (\ts -> runTLSSocket ts) tlssettings) #else - run = runSettingsSocket + go = runSettingsSocket #endif fixSockAddr :: SockAddr -> SockAddr @@ -208,15 +212,35 @@ webAppSessionBackend _ = do #endif #endif -{- Generates a random sha512 string, suitable to be used for an - - authentication secret. -} -genRandomToken :: IO String -genRandomToken = do +#ifdef WITH_WEBAPP_SECURE +type AuthToken = SecureMem +#else +type AuthToken = T.Text +#endif + +toAuthToken :: T.Text -> AuthToken +#ifdef WITH_WEBAPP_SECURE +toAuthToken = secureMemFromByteString . TE.encodeUtf8 +#else +toAuthToken = id +#endif + +fromAuthToken :: AuthToken -> T.Text +#ifdef WITH_WEBAPP_SECURE +fromAuthToken = TE.decodeLatin1 . toBytes +#else +fromAuthToken = id +#endif + +{- Generates a random sha512 string, encapsulated in a SecureMem, + - suitable to be used for an authentication secret. -} +genAuthToken :: IO AuthToken +genAuthToken = do g <- newGenIO :: IO SystemRandom return $ case genBytes 512 g of - Left e -> error $ "failed to generate secret token: " ++ show e - Right (s, _) -> show $ sha512 $ L.fromChunks [s] + Left e -> error $ "failed to generate auth token: " ++ show e + Right (s, _) -> toAuthToken $ T.pack $ show $ sha512 $ L.fromChunks [s] {- A Yesod isAuthorized method, which checks the auth cgi parameter - against a token extracted from the Yesod application. @@ -225,15 +249,15 @@ genRandomToken = do - possibly leaking the auth token in urls on that page! -} #if MIN_VERSION_yesod(1,2,0) -checkAuthToken :: (Monad m, Yesod.MonadHandler m) => (Yesod.HandlerSite m -> T.Text) -> m Yesod.AuthResult +checkAuthToken :: (Monad m, Yesod.MonadHandler m) => (Yesod.HandlerSite m -> AuthToken) -> m Yesod.AuthResult #else -checkAuthToken :: forall t sub. (t -> T.Text) -> Yesod.GHandler sub t Yesod.AuthResult +checkAuthToken :: forall t sub. (t -> AuthToken) -> Yesod.GHandler sub t Yesod.AuthResult #endif -checkAuthToken extractToken = do +checkAuthToken extractAuthToken = do webapp <- Yesod.getYesod req <- Yesod.getRequest let params = Yesod.reqGetParams req - if lookup "auth" params == Just (extractToken webapp) + if (toAuthToken <$> lookup "auth" params) == Just (extractAuthToken webapp) then return Yesod.Authorized else Yesod.sendResponseStatus unauthorized401 () @@ -243,21 +267,21 @@ checkAuthToken extractToken = do - - A typical predicate would exclude files under /static. -} -insertAuthToken :: forall y. (y -> T.Text) +insertAuthToken :: forall y. (y -> AuthToken) -> ([T.Text] -> Bool) -> y -> T.Text -> [T.Text] -> [(T.Text, T.Text)] -> Builder -insertAuthToken extractToken predicate webapp root pathbits params = +insertAuthToken extractAuthToken predicate webapp root pathbits params = fromText root `mappend` encodePath pathbits' encodedparams where pathbits' = if null pathbits then [T.empty] else pathbits encodedparams = map (TE.encodeUtf8 *** go) params' go "" = Nothing go x = Just $ TE.encodeUtf8 x - authparam = (T.pack "auth", extractToken webapp) + authparam = (T.pack "auth", fromAuthToken (extractAuthToken webapp)) params' | predicate pathbits = authparam:params | otherwise = params diff --git a/debian/changelog b/debian/changelog index 7ff502ad3..ca82d88ad 100644 --- a/debian/changelog +++ b/debian/changelog @@ -7,6 +7,7 @@ git-annex (5.20140307) UNRELEASED; urgency=medium are no longer incorrectly detected as unused. * repair: Improve memory usage when git fsck finds a great many broken objects. + * webapp: Use securemem for constant time auth token comparisons. -- Joey Hess <joeyh@debian.org> Thu, 06 Mar 2014 16:17:01 -0400 diff --git a/debian/control b/debian/control index 30840b34e..9b6e812b8 100644 --- a/debian/control +++ b/debian/control @@ -39,6 +39,8 @@ Build-Depends: libghc-warp-tls-dev [i386 amd64 kfreebsd-i386 kfreebsd-amd64 powerpc sparc], libghc-wai-dev [i386 amd64 kfreebsd-i386 kfreebsd-amd64 powerpc sparc], libghc-wai-logger-dev [i386 amd64 kfreebsd-i386 kfreebsd-amd64 powerpc sparc], + libghc-securemem-dev, + libghc-byteable-dev, libghc-dns-dev, libghc-case-insensitive-dev, libghc-http-types-dev, diff --git a/git-annex.cabal b/git-annex.cabal index a98e3e34a..ee4ff4a4a 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -43,8 +43,8 @@ Flag Assistant Flag Webapp Description: Enable git-annex webapp -Flag Webapp-https - Description: Enable git-annex webapp https +Flag Webapp-secure + Description: Secure webapp Flag Pairing Description: Enable pairing @@ -181,11 +181,12 @@ Executable git-annex yesod, yesod-default, yesod-static, yesod-form, yesod-core, http-types, transformers, wai, wai-logger, warp, warp-tls, blaze-builder, crypto-api, hamlet, clientsession, - template-haskell, data-default, aeson, network-conduit + template-haskell, data-default, aeson, network-conduit, + byteable CPP-Options: -DWITH_WEBAPP - if flag(Webapp) && flag (Webapp-https) - Build-Depends: warp-tls (>= 1.4) - CPP-Options: -DWITH_WEBAPP_HTTPS + if flag(Webapp) && flag (Webapp-secure) + Build-Depends: warp-tls (>= 1.4), securemem + CPP-Options: -DWITH_WEBAPP_SECURE if flag(Pairing) Build-Depends: network-multicast, network-info |