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

@@ -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])

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|<input type="hidden" name="auth" value="#{secretToken webapp}">|]
+	[whamlet|<input type="hidden" name="auth" value="#{fromAuthToken (authToken webapp)}">|]
 
 {- A button with an icon, and maybe label or tooltip, that can be
  - clicked to perform some action.

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

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"

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"

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

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
 

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,

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