diff options
| -rw-r--r-- | Log.hs | 8 | ||||
| -rw-r--r-- | Memory.hs | 9 | ||||
| -rw-r--r-- | TODO | 16 | ||||
| -rw-r--r-- | Types.hs | 23 | ||||
| -rw-r--r-- | Val.hs | 13 | ||||
| -rw-r--r-- | debug-me.cabal | 1 | ||||
| -rw-r--r-- | debug-me.hs | 16 |
7 files changed, 65 insertions, 21 deletions
@@ -4,6 +4,7 @@ module Log where import Types import Hash +import Memory import GHC.Generics (Generic) import Data.Aeson @@ -28,6 +29,9 @@ data ActivityLog = ActivityLog } deriving (Show, Generic) +instance DataSize ActivityLog where + dataSize l = dataSize (loggedActivity l) + dataSize (loggedHash l) + 2 + instance ToJSON (ActivityLog) instance FromJSON (ActivityLog) @@ -36,6 +40,10 @@ data SomeActivity | ActivityEntered (Activity Entered) deriving (Show, Generic) +instance DataSize SomeActivity where + dataSize (ActivitySeen a) = dataSize a + dataSize (ActivityEntered a) = dataSize a + instance ToJSON SomeActivity where toJSON = genericToJSON sumOptions toEncoding = genericToEncoding sumOptions diff --git a/Memory.hs b/Memory.hs new file mode 100644 index 0000000..963acf7 --- /dev/null +++ b/Memory.hs @@ -0,0 +1,9 @@ +module Memory where + +-- | Class of things whose size in memory is known. +-- +-- (This can be an approximate size, but should be no larger than the +-- memory used to reprecent the thing.) +class DataSize t where + -- ^ Size in bytes + dataSize :: t -> Integer @@ -1,21 +1,5 @@ * loadLog should verify the hashes (and signatures) in the log, and refuse to use logs that are not valid proofs of a session. -* potential DOS where developer sends Activity Entered that all - refer back to the first Activity Seen. This requires the user - side to keep a Backlog containing all later Activity Seen, so uses - up a lot of memory. - - For this to work, the developer would need to include - in their Activity Entered echoData anticipating all the Activity Seen - that they have generated. This is doable; for example the developer - can send a stream of A's, and then needs to only include the right - amount in the echoData. - - Should probably cap the BackLog to some maximum size to prevent - this kind of DOS. Dropping old items from the BackLog after some - amount of time would also work; after eg 10 seconds it's very - unlikely that a Activity Entered will legitimately refer to an - old backlog item. * Encryption! * Add random nonce to start message, to avoid replay issues. (Or perhaps the encryption derives a RSA key in a way that avoids @@ -12,6 +12,7 @@ module Types ( ) where import Val +import Memory import GHC.Generics (Generic) import Data.Aeson @@ -23,6 +24,9 @@ data Seen = Seen } deriving (Show, Generic) +instance DataSize Seen where + dataSize = dataSize . seenData + -- | Things that the developer enters. data Entered = Entered { enteredData :: Val @@ -32,6 +36,9 @@ data Entered = Entered } deriving (Show, Generic) +instance DataSize Entered where + dataSize e = dataSize (enteredData e) + dataSize (echoData e) + -- | High level protocol. data Proto a = Proto a @@ -40,6 +47,10 @@ data Proto a -- ^ sent by user to indicate when an Entered value was rejected. deriving (Show, Generic) +instance DataSize a => DataSize (Proto a) where + dataSize (Proto a) = dataSize a + dataSize (Rejected a) = dataSize a + -- | A Proto activity (either Entered or Seen) with a pointer -- to the Activity before this one. -- @@ -51,15 +62,27 @@ data Activity a = Activity } deriving (Show, Generic) +instance DataSize a => DataSize (Activity a) where + dataSize a = dataSize (activity a) + + maybe 0 dataSize (prevActivity a) + + dataSize (signature a) + newtype Signature = Signature Val deriving (Show, Generic) +instance DataSize Signature where + dataSize _ = 42 -- FIXME real size here + data Hash = Hash { hashMethod :: HashMethod , hashValue :: Val } deriving (Show, Generic, Eq) +instance DataSize Hash where + dataSize (Hash { hashMethod = SHA256 }) = 64 + dataSize (Hash { hashMethod = SHA3 }) = 56 + -- | We use SHA256. (SHA3 is included to future proof, and because it -- improves the generated JSON.) data HashMethod = SHA256 | SHA3 @@ -2,18 +2,23 @@ module Val where -import Data.ByteString +import Memory + import GHC.Generics (Generic) import Data.Aeson import Data.Aeson.Types import qualified Codec.Binary.Base64 as B64 import qualified Data.Text as T import qualified Data.Text.Encoding as T +import qualified Data.ByteString as B -- | Newtype of ByteString so we can have JSON instances without orphans. -newtype Val = Val { val :: ByteString } +newtype Val = Val { val :: B.ByteString } deriving (Show, Generic, Eq, Monoid) +instance DataSize Val where + dataSize (Val b) = fromIntegral (B.length b) + -- | JSON instances for Val, using base64 encoding when the value -- is not utf-8 encoded, and otherwise using a more efficient encoding. instance ToJSON Val where @@ -28,10 +33,10 @@ instance FromJSON Val where Nothing -> Val <$> (unb64 =<< o .: "b64") parseJSON invalid = typeMismatch "ByteString" invalid -b64 :: ByteString -> T.Text +b64 :: B.ByteString -> T.Text b64 = T.decodeUtf8 . B64.encode -unb64 :: Monad m => T.Text -> m ByteString +unb64 :: Monad m => T.Text -> m B.ByteString unb64 t = either (\_ -> fail "bad base64 data") return diff --git a/debug-me.cabal b/debug-me.cabal index cc34c0c..62cfa4c 100644 --- a/debug-me.cabal +++ b/debug-me.cabal @@ -43,6 +43,7 @@ Executable debug-me Graphviz Hash Log + Memory Pty Replay Session diff --git a/debug-me.hs b/debug-me.hs index 3cc1f09..8ff38ed 100644 --- a/debug-me.hs +++ b/debug-me.hs @@ -5,6 +5,7 @@ module Main where import Types import Hash import Pty +import Memory import CmdLine import Log import Graphviz @@ -251,7 +252,8 @@ sendPtyInput ichan ochan p backlog logger = go bl <- readTVar backlog -- Don't need to retain backlog before the Activity -- that entered references. - let bl'@(Backlog bll) = truncateBacklog bl entered + let bl'@(Backlog bll) = reduceBacklog $ + truncateBacklog bl entered if isLegalEntered entered bl' then do let l = mkActivityLog (ActivityEntered entered) now @@ -293,6 +295,18 @@ truncateBacklog (Backlog (b :| l)) (Activity _ hp _) truncationpoint x@(ActivityLog { loggedActivity = ActivitySeen {}}) = Just (loggedHash x) == hp truncationpoint _ = False +-- | To avoid DOS attacks that try to fill up the backlog and so use all +-- memory, don't let the backlog contain more than 1000 items, or +-- more than 16 megabytes of total data. (Excluding the most recent +-- item). +reduceBacklog :: Backlog -> Backlog +reduceBacklog (Backlog (b :| l)) = Backlog (b :| go 0 (take 1000 l)) + where + go _ [] = [] + go n (x:xs) + | n > 16777216 = [] + | otherwise = x : go (n + dataSize x) xs + -- | Entered activity is legal when it points to the last Seen activvity, -- because this guarantees that the person who entered it saw -- the current state of the system before manipulating it. |