Merge pull request #630 from kazu-yamamoto/tls-session-manager

TLS session manager

tls-session-manager/LICENSE

@@ -0,0 +1,29 @@
+Copyright (c) 2017, IIJ Innovation Institute Inc.
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+  * Redistributions of source code must retain the above copyright
+    notice, this list of conditions and the following disclaimer.
+  * Redistributions in binary form must reproduce the above copyright
+    notice, this list of conditions and the following disclaimer in
+    the documentation and/or other materials provided with the
+    distribution.
+  * Neither the name of the copyright holders nor the names of its
+    contributors may be used to endorse or promote products derived
+    from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.

tls-session-manager/Network/TLS/SessionManager.hs

@@ -0,0 +1,132 @@
+{-# LANGUAGE BangPatterns #-}
+
+-- | In-memory TLS session manager.
+--
+-- * Limitation: you can set the maximum size of the session data database.
+-- * Automatic pruning: old session data over their lifetime are pruned automatically.
+-- * Energy saving: no dedicate pruning thread is running when the size of session data database is zero.
+-- * (Replay resistance: each session data is used at most once to prevent replay attacks against 0RTT early data of TLS 1.3.)
+
+module Network.TLS.SessionManager (
+    Config(..)
+  , defaultConfig
+  , newSessionManager
+  ) where
+
+import Control.Exception (assert)
+import Control.Reaper
+import Data.IORef
+import Data.Int (Int64)
+import Data.List (foldl')
+import Data.OrdPSQ (OrdPSQ)
+import qualified Data.OrdPSQ as Q
+import Network.TLS (SessionID, SessionData, SessionManager(..))
+import qualified System.Clock as C
+
+----------------------------------------------------------------
+
+-- | Configuration for session managers.
+data Config = Config {
+    -- | Ticket lifetime in seconds.
+      ticketLifetime :: !Int
+    -- | Pruning delay in seconds. This is set to 'reaperDelay'.
+    , pruningDelay   :: !Int
+    -- | The limit size of session data entries.
+    , dbMaxSize      :: !Int
+    }
+
+-- | Lifetime: 1 day , delay: 10 minutes, limit: 10,000 entries.
+defaultConfig :: Config
+defaultConfig = Config {
+      ticketLifetime = 86400
+    , pruningDelay   = 6000
+    , dbMaxSize      = 10000
+    }
+
+----------------------------------------------------------------
+
+type Sec = Int64
+type Value = (SessionData, IORef Availability)
+type DB = OrdPSQ SessionID Sec Value
+type Item = (SessionID, Sec, Value, Operation)
+
+data Operation = Add | Del
+data Use = SingleUse | MultipleUse
+data Availability = Fresh | Used
+
+----------------------------------------------------------------
+
+-- | Creating an in-memory session manager.
+newSessionManager :: Config -> IO SessionManager
+newSessionManager conf = do
+    let lifetime = fromIntegral $ ticketLifetime conf
+        maxsiz = dbMaxSize conf
+    reaper <- mkReaper defaultReaperSettings {
+          reaperEmpty  = Q.empty
+        , reaperCons   = cons maxsiz
+        , reaperAction = clean
+        , reaperNull   = Q.null
+        , reaperDelay  = pruningDelay conf * 1000000
+        }
+    return SessionManager {
+        sessionResume     = resume reaper MultipleUse
+      , sessionEstablish  = establish reaper lifetime
+      , sessionInvalidate = invalidate reaper
+      }
+
+cons :: Int -> Item -> DB -> DB
+cons lim (k,t,v,Add) db
+  | lim <= 0            = Q.empty
+  | Q.size db == lim    = case Q.minView db of
+      Nothing          -> assert False $ Q.insert k t v Q.empty
+      Just (_,_,_,db') -> Q.insert k t v db'
+  | otherwise           = Q.insert k t v db
+cons _   (k,_,_,Del) db = Q.delete k db
+
+clean :: DB -> IO (DB -> DB)
+clean olddb = do
+    currentTime <- C.sec <$> C.getTime C.Monotonic
+    let !pruned = snd $ Q.atMostView currentTime olddb
+    return $ merge pruned
+  where
+    ins db (k,p,v) = Q.insert k p v db
+    -- There is not 'merge' API.
+    -- We hope that newdb is smaller than pruned.
+    merge pruned newdb = foldl' ins pruned entries
+      where
+        entries = Q.toList newdb
+
+----------------------------------------------------------------
+
+establish :: Reaper DB Item -> Sec
+          -> SessionID -> SessionData -> IO ()
+establish reaper lifetime k sd = do
+    ref <- newIORef Fresh
+    !p <- ((+ lifetime) . C.sec) <$> C.getTime C.Monotonic
+    let !v = (sd,ref)
+    reaperAdd reaper (k,p,v,Add)
+
+resume :: Reaper DB Item -> Use
+       -> SessionID -> IO (Maybe SessionData)
+resume reaper use k = do
+    db <- reaperRead reaper
+    case Q.lookup k db of
+      Nothing             -> return Nothing
+      Just (p,v@(sd,ref)) -> do
+           case use of
+               SingleUse -> do
+                   available <- atomicModifyIORef' ref check
+                   reaperAdd reaper (k,p,v,Del)
+                   return $ if available then Just sd else Nothing
+               MultipleUse -> return $ Just sd
+  where
+    check Fresh = (Used,True)
+    check Used  = (Used,False)
+
+invalidate :: Reaper DB Item
+           -> SessionID -> IO ()
+invalidate reaper k = do
+    db <- reaperRead reaper
+    case Q.lookup k db of
+      Nothing    -> return ()
+      Just (p,v) -> reaperAdd reaper (k,p,v,Del)

tls-session-manager/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

tls-session-manager/tls-session-manager.cabal

@@ -0,0 +1,30 @@
+-- Initial tls-session-manager.cabal generated by cabal init.  For further
+-- documentation, see http://haskell.org/cabal/users-guide/
+
+name:                tls-session-manager
+version:             0.0.0.0
+synopsis:            In-memory TLS session manager
+description:         TLS session manager with limitation, automatic pruning, replay resistance and energy saving
+license:             BSD3
+license-file:        LICENSE
+author:              Kazu Yamamoto
+maintainer:          [email protected]
+-- copyright:
+category:            Web
+build-type:          Simple
+extra-source-files:  ChangeLog.md
+cabal-version:       >= 1.10
+
+library
+  exposed-modules:     Network.TLS.SessionManager
+  -- other-modules:
+  -- other-extensions:
+  build-depends:       base >= 4.9 && < 5
+                     , auto-update
+                     , clock
+                     , psqueues >= 0.2.3
+                     , time
+                     , tls
+  -- hs-source-dirs:
+  default-language:    Haskell2010
+  ghc-options:       -Wall