diff options
| -rw-r--r-- | BackupRecord.hs | 79 | ||||
| -rw-r--r-- | CHANGELOG | 4 | ||||
| -rw-r--r-- | CmdLine.hs | 2 | ||||
| -rw-r--r-- | Entropy.hs | 8 | ||||
| -rw-r--r-- | HTTP/Client.hs | 3 | ||||
| -rw-r--r-- | Servers.hs | 8 | ||||
| -rw-r--r-- | Storage.hs | 7 | ||||
| -rw-r--r-- | Storage/Local.hs | 1 | ||||
| -rw-r--r-- | Storage/Network.hs | 3 | ||||
| -rw-r--r-- | TODO | 6 | ||||
| -rw-r--r-- | Types/Server.hs | 16 | ||||
| -rw-r--r-- | Types/Storage.hs | 2 | ||||
| -rw-r--r-- | keysafe.cabal | 2 | ||||
| -rw-r--r-- | keysafe.hs | 26 |
14 files changed, 134 insertions, 33 deletions
diff --git a/BackupRecord.hs b/BackupRecord.hs new file mode 100644 index 0000000..39e07fa --- /dev/null +++ b/BackupRecord.hs @@ -0,0 +1,79 @@ +{- Copyright 2016 Joey Hess <id@joeyh.name> + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +{-# LANGUAGE DeriveGeneric, BangPatterns #-} + +module BackupRecord where + +import Types +import Types.Cost +import Types.Server +import GHC.Generics +import Data.Time.Clock.POSIX +import Data.Aeson +import Data.Maybe +import System.FilePath +import System.Directory +import System.Posix.User +import System.Posix.Files +import qualified Data.ByteString.Lazy as B + +-- | Record of a backup. +-- +-- If an attacker cracks the user's system and finds this stored +-- on it, it should not help them recover keys from keysafe. +-- +-- That's why the Name used is not included; as knowing the name lets +-- an attacker download shards and start password cracking. +-- +-- Including the password entropy does let an attacker avoid trying +-- weak passwords and go right to passwords that are strong enough, but +-- this should only half the password crack time at worst. +data BackupRecord = BackupRecord + { backupDate :: POSIXTime + , backupServers :: [HostName] + , secretKeySource :: String + , passwordEntropy :: Int + } deriving (Show, Generic) + +-- BackupRecord is serialized as JSON. +instance ToJSON BackupRecord +instance FromJSON BackupRecord + +mkBackupRecord :: [Server] -> SecretKeySource -> Entropy UnknownPassword -> IO BackupRecord +mkBackupRecord servers sks (Entropy n) = BackupRecord + <$> getPOSIXTime + <*> pure (map serverName servers) + <*> pure (show sks) + <*> pure n + +backupRecordFile :: IO FilePath +backupRecordFile = do + u <- getUserEntryForID =<< getEffectiveUserID + return $ homeDirectory u </> ".keysafe/backup.log" + +readBackupRecords :: IO [BackupRecord] +readBackupRecords = do + f <- backupRecordFile + e <- doesFileExist f + if e + then fromMaybe [] . decode <$> B.readFile f + else return [] + +storeBackupRecord :: BackupRecord -> IO () +storeBackupRecord r = do + !rs <- readBackupRecords + f <- backupRecordFile + let d = takeDirectory f + createDirectoryIfMissing True d + setFileMode d $ + ownerReadMode + `unionFileModes` ownerWriteMode + `unionFileModes` ownerExecuteMode + setPermissions d + $ setOwnerReadable True + $ setOwnerWritable True + $ setOwnerExecutable True emptyPermissions + B.writeFile f $ encode (r:rs) @@ -15,6 +15,10 @@ keysafe (0.20160832) UNRELEASED; urgency=medium This is useful both to test the server throttling of uploads, and to make it harder for servers to know if an object actually contains secret key information. + * Store information about backed up keys in ~/.keysafe/backup.log + This can be deleted by the user at any time, but it's useful + in case a server is known to be compromised, or a problem is found + with keysafe's implementation that makes a backup insecure. -- Joey Hess <id@joeyh.name> Thu, 01 Sep 2016 11:42:27 -0400 @@ -7,8 +7,8 @@ module CmdLine where import Types import Types.Storage +import Types.Server (HostName) import Tunables -import Servers (HostName) import qualified Gpg import Options.Applicative import qualified Data.ByteString.UTF8 as BU8 @@ -13,12 +13,12 @@ import Text.Password.Strength (estimate, UserDict) -- | Calculation of the entropy of a password. -- Uses zxcvbn so takes word lists, and other entropy weakening problems -- into account. -passwordEntropy :: Password -> UserDict -> Entropy UnknownPassword -passwordEntropy (Password p) userdict = Entropy $ floor $ +calcPasswordEntropy :: Password -> UserDict -> Entropy UnknownPassword +calcPasswordEntropy (Password p) userdict = Entropy $ floor $ estimate (B.toString p) userdict -- | Naive calculation of the entropy of a name. -- Assumes that the attacker is not targeting a particular list of names. -nameEntropy :: Name -> Entropy UnknownName -nameEntropy (Name n) = Entropy $ floor $ +calcNameEntropy :: Name -> Entropy UnknownName +calcNameEntropy (Name n) = Entropy $ floor $ estimate (B.toString n) [] diff --git a/HTTP/Client.hs b/HTTP/Client.hs index 19cfe9b..b582fe7 100644 --- a/HTTP/Client.hs +++ b/HTTP/Client.hs @@ -7,8 +7,9 @@ module HTTP.Client where import HTTP import HTTP.ProofOfWork -import Servers import Types +import Types.Server +import Servers import Types.Storage import Types.Cost import Servant.API @@ -5,16 +5,10 @@ module Servers where +import Types.Server import Network.Wai.Handler.Warp (Port) import Servant.Client -type HostName = String - -data Server = Server - { serverName :: HostName - , serverPort :: Port - } - serverUrl :: Server -> BaseUrl serverUrl srv = BaseUrl Http (serverName srv) (serverPort srv) "" @@ -9,6 +9,7 @@ module Storage (module Storage, module Types.Storage) where import Types import Types.Storage +import Types.Server import Share import Storage.Local import Storage.Network @@ -45,11 +46,11 @@ type UpdateProgress = IO () -- -- TODO: Add shuffling and queueing/chaffing to prevent -- correlation of related shares. -storeShares :: StorageLocations -> ShareIdents -> [S.Set Share] -> UpdateProgress -> IO (StoreResult, Bool) +storeShares :: StorageLocations -> ShareIdents -> [S.Set Share] -> UpdateProgress -> IO (StoreResult, Bool, [Storage]) storeShares (StorageLocations locs) allsis shares updateprogress = do - (r, usedlocs) <- go allsis shares [] False + ((r, anyqueued), usedlocs) <- go allsis shares [] False _ <- mapM_ obscureShares usedlocs - return r + return (r, anyqueued, usedlocs) where go sis (s:rest) usedlocs anyqueued = do let (is, sis') = nextShareIdents sis diff --git a/Storage/Local.hs b/Storage/Local.hs index 49ed311..6a952fa 100644 --- a/Storage/Local.hs +++ b/Storage/Local.hs @@ -41,6 +41,7 @@ localStorage getsharedir n = Storage , countShares = count section getsharedir , moveShares = move section getsharedir , uploadQueue = Nothing + , getServer = Nothing } where section = Section n diff --git a/Storage/Network.hs b/Storage/Network.hs index ff33e3f..dec6d57 100644 --- a/Storage/Network.hs +++ b/Storage/Network.hs @@ -11,8 +11,8 @@ module Storage.Network ( import Types import Types.Storage +import Types.Server import Storage.Local -import Servers import HTTP.Client import HTTP.ProofOfWork import System.FilePath @@ -26,6 +26,7 @@ networkStorage localdir server = Storage , moveShares = move server , uploadQueue = Just $ localStorage (storageDir localdir) ("uploadqueue" </> serverName server) + , getServer = Just server } store :: Server -> StorableObjectIdent -> Share -> IO StoreResult @@ -4,11 +4,7 @@ Soon: harder for traffic analysis to tell that it's keysafe traffic. * Implement the different categories of servers in the server list. * Get some keysafe servers set up. -* Keep a local record of keys that have been backed up, and the tunables - and password entropy. This will allow warning later if the crack estimate - has to be revised downward for some reason, or if a server is - compromised. -* Run --uploadqueued periodically (systemd timer?) +* Run --uploadqueued periodically (systemd timer or desktop autostart?) Later: diff --git a/Types/Server.hs b/Types/Server.hs new file mode 100644 index 0000000..dd06909 --- /dev/null +++ b/Types/Server.hs @@ -0,0 +1,16 @@ +{- Copyright 2016 Joey Hess <id@joeyh.name> + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +module Types.Server where + +import Network.Wai.Handler.Warp (Port) + +type HostName = String + +data Server = Server + { serverName :: HostName + , serverPort :: Port + } + deriving (Show) diff --git a/Types/Storage.hs b/Types/Storage.hs index 2dabcac..d9db853 100644 --- a/Types/Storage.hs +++ b/Types/Storage.hs @@ -9,6 +9,7 @@ module Types.Storage where import Types +import Types.Server import GHC.Generics import Data.Aeson.Types @@ -34,6 +35,7 @@ data Storage = Storage , moveShares :: Storage -> IO [StoreResult] -- ^ Tries to move all shares from this storage to another one. , uploadQueue :: Maybe Storage + , getServer :: Maybe Server } data StoreResult = StoreSuccess | StoreAlreadyExists | StoreFailure String diff --git a/keysafe.cabal b/keysafe.cabal index b99bbf6..f8d5e26 100644 --- a/keysafe.cabal +++ b/keysafe.cabal @@ -74,6 +74,7 @@ Executable keysafe -- argon2 == 1.1.* Extra-Libraries: argon2 Other-Modules: + BackupRecord Benchmark ByteStrings Crypto.Argon2.FFI @@ -101,6 +102,7 @@ Executable keysafe Tunables Types Types.Cost + Types.Server Types.Storage Types.UI UI @@ -19,6 +19,7 @@ import Cost import SecretKey import Share import Storage +import BackupRecord import HTTP.Server import qualified Gpg import Data.Maybe @@ -96,10 +97,10 @@ backup cmdline storagelocations ui tunables secretkeysource secretkey = do <$> promptName ui "Enter other name" othernamedesc Nothing validateName let name = Name (theirname <> " " <> othername) - kek <- promptkek name + (kek, passwordentropy) <- promptpassword name let sis = shareIdents tunables name secretkeysource let cost = getCreationCost kek <> getCreationCost sis - (r, queued) <- withProgressIncremental ui "Encrypting and storing data" + (r, queued, locs) <- withProgressIncremental ui "Encrypting and storing data" (encryptdesc cost cores) $ \addpercent -> do let esk = encrypt tunables kek secretkey shares <- genShares esk tunables @@ -107,10 +108,13 @@ backup cmdline storagelocations ui tunables secretkeysource secretkey = do _ <- sis `seq` addpercent 25 let step = 50 `div` sum (map S.size shares) storeShares storagelocations sis shares (addpercent step) + backuprecord <- mkBackupRecord (mapMaybe getServer locs) secretkeysource passwordentropy case r of - StoreSuccess - | queued -> showInfo ui "Backup queued" "Some data was not sucessfully uploaded to servers, and has been queued for later upload. Run keysafe --uploadqueued at a later point to finish the backup." - | otherwise -> showInfo ui "Backup success" "Your secret key was successfully encrypted and backed up." + StoreSuccess -> do + storeBackupRecord backuprecord + if queued + then showInfo ui "Backup queued" "Some data was not sucessfully uploaded to servers, and has been queued for later upload. Run keysafe --uploadqueued at a later point to finish the backup." + else showInfo ui "Backup success" "Your secret key was successfully encrypted and backed up." StoreFailure s -> showError ui ("There was a problem storing your encrypted secret key: " ++ s) StoreAlreadyExists -> do showError ui $ unlines @@ -118,20 +122,20 @@ backup cmdline storagelocations ui tunables secretkeysource secretkey = do , "Please try again with a different name." ] go theirname - promptkek name = do + promptpassword name = do password <- fromMaybe (error "Aborting on no password") <$> promptPassword ui True "Enter password" passworddesc kek <- genKeyEncryptionKey tunables name password username <- userName let badwords = concatMap namewords [name, username] + let passwordentropy = calcPasswordEntropy password badwords let crackcost = estimateAttackCost spotAWS $ - estimateBruteforceOf kek $ - passwordEntropy password badwords + estimateBruteforceOf kek passwordentropy let mincost = Dollars 100000 if crackcost < mincost then do showError ui $ "Weak password! It would cost only " ++ show crackcost ++ " to crack the password. Please think of a better one. More words would be good.." - promptkek name + promptpassword name else do (thisyear, _, _) <- toGregorian . utctDay <$> getCurrentTime @@ -139,8 +143,8 @@ backup cmdline storagelocations ui tunables secretkeysource secretkey = do (crackdesc crackcost thisyear) "Is your password strong enough?" if ok - then return kek - else promptkek name + then return (kek, passwordentropy) + else promptpassword name namewords (Name nb) = words (BU8.toString nb) keydesc = case secretkeysource of GpgKey _ -> "gpg secret key" |