From 66b8b9c094a71bd1ae584ccbbca139ba003f24f9 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 12 Mar 2014 21:21:10 -0400 Subject: [PATCH] webapp: Use securemem for constant time auth token comparisons. Debian stable does not have securemem, but neither does it have warp-tls, so just disable use of securemem when not building with https support. --- Assistant/Threads/WebApp.hs | 4 +-- Assistant/WebApp.hs | 3 +- Assistant/WebApp/Notifications.hs | 3 +- Assistant/WebApp/Types.hs | 6 ++-- BuildFlags.hs | 4 +-- Utility/WebApp.hs | 60 +++++++++++++++++++++---------- debian/changelog | 1 + debian/control | 2 ++ git-annex.cabal | 13 +++---- 9 files changed, 63 insertions(+), 33 deletions(-) diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs index f90f742870..8d977194b2 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/Assistant/WebApp.hs b/Assistant/WebApp.hs index ece75d7ba6..e81a1d7120 100644 --- a/Assistant/WebApp.hs +++ b/Assistant/WebApp.hs @@ -14,6 +14,7 @@ import Assistant.WebApp.Types import Assistant.Common import Utility.NotificationBroadcaster import Utility.Yesod +import Utility.WebApp import Data.Text (Text) import Control.Concurrent @@ -36,7 +37,7 @@ newNotifier getbroadcaster = liftAssistant $ do webAppFormAuthToken :: Widget webAppFormAuthToken = do webapp <- liftH getYesod - [whamlet||] + [whamlet||] {- A button with an icon, and maybe label or tooltip, that can be - clicked to perform some action. diff --git a/Assistant/WebApp/Notifications.hs b/Assistant/WebApp/Notifications.hs index 9183709573..9108805c30 100644 --- a/Assistant/WebApp/Notifications.hs +++ b/Assistant/WebApp/Notifications.hs @@ -22,6 +22,7 @@ import Assistant.DaemonStatus import Assistant.Types.Buddies import Utility.NotificationBroadcaster import Utility.Yesod +import Utility.WebApp import Data.Text (Text) import qualified Data.Text as T @@ -64,7 +65,7 @@ notifierUrl route broadcaster = do [ "/" , T.intercalate "/" urlbits , "?auth=" - , secretToken webapp + , fromAuthToken (authToken webapp) ] getNotifierTransfersR :: Handler RepPlain diff --git a/Assistant/WebApp/Types.hs b/Assistant/WebApp/Types.hs index 7a23e4f58d..5d117bc3ae 100644 --- a/Assistant/WebApp/Types.hs +++ b/Assistant/WebApp/Types.hs @@ -41,7 +41,7 @@ mkYesodData "WebApp" $(parseRoutesFile "Assistant/WebApp/routes") data WebApp = WebApp { assistantData :: AssistantData - , secretToken :: Text + , authToken :: AuthToken , relDir :: Maybe FilePath , getStatic :: Static , postFirstRun :: Maybe (IO String) @@ -52,11 +52,11 @@ data WebApp = WebApp instance Yesod WebApp where {- Require an auth token be set when accessing any (non-static) route -} - isAuthorized _ _ = checkAuthToken secretToken + isAuthorized _ _ = checkAuthToken authToken {- Add the auth token to every url generated, except static subsite - urls (which can show up in Permission Denied pages). -} - joinPath = insertAuthToken secretToken excludeStatic + joinPath = insertAuthToken authToken excludeStatic where excludeStatic [] = True excludeStatic (p:_) = p /= "static" diff --git a/BuildFlags.hs b/BuildFlags.hs index d5c98aa4ec..e36cf6a14c 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 31d3711f18..8e08ab9e0a 100644 --- a/Utility/WebApp.hs +++ b/Utility/WebApp.hs @@ -1,6 +1,6 @@ {- Yesod webapp - - - Copyright 2012 Joey Hess + - Copyright 2012-2014 Joey Hess - - 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 7ff502ad35..ca82d88ad7 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 Thu, 06 Mar 2014 16:17:01 -0400 diff --git a/debian/control b/debian/control index 30840b34e4..9b6e812b87 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 a98e3e34a6..ee4ff4a4ad 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