From 15ea23acdb00fa964d91d440274e3a78bd115083 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 30 Aug 2016 16:29:22 -0400 Subject: Added basic test suite. --- CHANGELOG | 1 + CmdLine.hs | 8 +++- HTTP/Server.hs | 2 +- Storage.hs | 2 +- Storage/Local.hs | 59 ++++++++++++----------- TODO | 1 - Tests.hs | 142 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ Tunables.hs | 1 + Types.hs | 1 + keysafe.cabal | 1 + keysafe.hs | 5 +- 11 files changed, 190 insertions(+), 33 deletions(-) create mode 100644 Tests.hs diff --git a/CHANGELOG b/CHANGELOG index 093e037..e9dc8c2 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -8,6 +8,7 @@ keysafe (0.20160820) UNRELEASED; urgency=medium * Fix gpg secret key list parser to support gpg 2. * Tuned argon2 hash parameters on better hardware than my fanless laptop. * Improve time estimates, taking into account the number of cores. + * Added basic test suite. -- Joey Hess Mon, 22 Aug 2016 13:56:16 -0400 diff --git a/CmdLine.hs b/CmdLine.hs index 62f6887..a8201c8 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -23,7 +23,7 @@ data CmdLine = CmdLine , serverConfig :: ServerConfig } -data Mode = Backup | Restore | UploadQueued | Server | Benchmark +data Mode = Backup | Restore | UploadQueued | Server | Benchmark | Test deriving (Show) data ServerConfig = ServerConfig @@ -33,7 +33,7 @@ data ServerConfig = ServerConfig parse :: Parser CmdLine parse = CmdLine - <$> optional (backup <|> restore <|> uploadqueued <|> server <|> benchmark) + <$> optional (backup <|> restore <|> uploadqueued <|> server <|> benchmark <|> test) <*> optional (gpgswitch <|> fileswitch) <*> localstorageswitch <*> guiswitch @@ -61,6 +61,10 @@ parse = CmdLine ( long "benchmark" <> help "Benchmark speed of keysafe's cryptographic primitives." ) + test = flag' Test + ( long "test" + <> help "Run test suite." + ) gpgswitch = GpgKey . KeyId . BU8.fromString <$> strOption ( long "gpgkeyid" <> metavar "KEYID" diff --git a/HTTP/Server.hs b/HTTP/Server.hs index fa2e8da..3e0b9aa 100644 --- a/HTTP/Server.hs +++ b/HTTP/Server.hs @@ -40,7 +40,7 @@ runServer bindaddress port = do host = fromString bindaddress serverStorage :: Storage -serverStorage = localStorage "server" +serverStorage = localStorage userStorageDir "server" app :: ServerState -> Application app st = serve userAPI (server st) diff --git a/Storage.hs b/Storage.hs index 85e52a6..c9446c5 100644 --- a/Storage.hs +++ b/Storage.hs @@ -24,7 +24,7 @@ allStorageLocations = do localStorageLocations :: StorageLocations localStorageLocations = StorageLocations $ - map (localStorage . ("local" ) . show) + map (localStorage userStorageDir . ("local" ) . show) [1..100 :: Int] type UpdateProgress = IO () diff --git a/Storage/Local.hs b/Storage/Local.hs index e8f6010..d0a1d15 100644 --- a/Storage/Local.hs +++ b/Storage/Local.hs @@ -3,7 +3,7 @@ - Licensed under the GNU AGPL version 3 or higher. -} -module Storage.Local (localStorage, uploadQueue) where +module Storage.Local (localStorage, userStorageDir, testStorageDir, uploadQueue) where import Types import Types.Storage @@ -23,25 +23,27 @@ import Control.DeepSeq import Control.Exception import Control.Monad +type GetShareDir = Section -> IO FilePath + newtype Section = Section String -localStorage :: String -> Storage -localStorage n = Storage - { storeShare = store section - , retrieveShare = retrieve section - , obscureShares = obscure section - , countShares = count section - , moveShares = move section +localStorage :: GetShareDir -> String -> Storage +localStorage getsharedir n = Storage + { storeShare = store section getsharedir + , retrieveShare = retrieve section getsharedir + , obscureShares = obscure section getsharedir + , countShares = count section getsharedir + , moveShares = move section getsharedir } where section = Section n uploadQueue :: Server -> Storage -uploadQueue s = localStorage ("uploadqueue" serverName s) +uploadQueue s = localStorage userStorageDir ("uploadqueue" serverName s) -store :: Section -> StorableObjectIdent -> Share -> IO StoreResult -store section i s = onError (StoreFailure . show) $ do - dir <- shareDir section +store :: Section -> GetShareDir -> StorableObjectIdent -> Share -> IO StoreResult +store section getsharedir i s = onError (StoreFailure . show) $ do + dir <- getsharedir section createDirectoryIfMissing True dir let dest = dir shareFile i exists <- doesFileExist dest @@ -57,9 +59,9 @@ store section i s = onError (StoreFailure . show) $ do renameFile tmp dest return StoreSuccess -retrieve :: Section -> ShareNum -> StorableObjectIdent -> IO RetrieveResult -retrieve section n i = onError (RetrieveFailure . show) $ do - dir <- shareDir section +retrieve :: Section -> GetShareDir -> ShareNum -> StorableObjectIdent -> IO RetrieveResult +retrieve section getsharedir n i = onError (RetrieveFailure . show) $ do + dir <- getsharedir section fd <- openFd (dir shareFile i) ReadOnly Nothing defaultFileFlags h <- fdToHandle fd b <- B.hGetContents h @@ -75,22 +77,22 @@ retrieve section n i = onError (RetrieveFailure . show) $ do -- -- Note that the contents of shares is never changed, so it's ok to set the -- mtime to the epoch; backup programs won't be confused. -obscure :: Section -> IO ObscureResult -obscure section = onError (ObscureFailure . show) $ do - dir <- shareDir section +obscure :: Section -> GetShareDir -> IO ObscureResult +obscure section getsharedir = onError (ObscureFailure . show) $ do + dir <- getsharedir section fs <- filter isShareFile <$> getDirectoryContents dir mapM_ (\f -> setFileTimes (dir f) 0 0) fs return ObscureSuccess -count :: Section -> IO CountResult -count section = onError (CountFailure . show) $ do - dir <- shareDir section +count :: Section -> GetShareDir -> IO CountResult +count section getsharedir = onError (CountFailure . show) $ do + dir <- getsharedir section CountResult . genericLength . filter isShareFile <$> getDirectoryContents dir -move :: Section -> Storage -> IO () -move section storage = do - dir <- shareDir section +move :: Section -> GetShareDir -> Storage -> IO () +move section getsharedir storage = do + dir <- getsharedir section fs <- getDirectoryContents dir forM_ fs $ \f -> case fromShareFile f of Nothing -> return () @@ -99,7 +101,7 @@ move section storage = do -- matter because we're not going to be -- recombining the share, just sending its contents -- on the the server. - r <- retrieve section 0 i + r <- retrieve section getsharedir 0 i case r of RetrieveFailure _ -> return () RetrieveSuccess share -> do @@ -115,11 +117,14 @@ onError f a = do Left e -> f e Right r -> r -shareDir :: Section -> IO FilePath -shareDir (Section section) = do +userStorageDir :: GetShareDir +userStorageDir (Section section) = do u <- getUserEntryForID =<< getEffectiveUserID return $ homeDirectory u dotdir section +testStorageDir :: FilePath -> GetShareDir +testStorageDir tmpdir (Section section) = pure $ tmpdir section + -- | The takeFileName ensures that, if the StorableObjectIdent somehow -- contains a path (eg starts with "../" or "/"), it is not allowed -- to point off outside the shareDir. diff --git a/TODO b/TODO index d0f2615..4abdb42 100644 --- a/TODO +++ b/TODO @@ -1,4 +1,3 @@ -* test suite (eg, test basic storage and restore of various size data) * improve restore progress bar points (update after every hash try) * If we retrieved enough shares successfully, but decrypt failed, must be a wrong password, so prompt for re-entry and retry with those shares. diff --git a/Tests.hs b/Tests.hs new file mode 100644 index 0000000..c0d1f56 --- /dev/null +++ b/Tests.hs @@ -0,0 +1,142 @@ +{-# LANGUAGE OverloadedStrings #-} + +{- Copyright 2016 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +module Tests where + +import Types +import Tunables +import Encryption +import Share +import Storage +import Storage.Local +import Control.Exception +import System.Directory +import System.Posix.Temp +import System.IO +import qualified Data.ByteString.UTF8 as BU8 +import qualified Data.ByteString as B +import qualified Data.Set as S + +type TestDesc = B.ByteString + +type TestResult = Either String () + +type Test = (TestDesc, IO TestResult) + +testSuccess :: IO TestResult +testSuccess = return $ Right () + +testFailed :: String -> IO TestResult +testFailed = return . Left + +runTest :: Test -> IO Bool +runTest (d, t) = do + putStr $ "testing: " ++ show d ++ " ..." + hFlush stdout + r <- t + case r of + Right () -> do + putStrLn "ok" + return True + Left e -> do + putStrLn $ "failed: " ++ show e + return False + +runTests :: IO () +runTests = do + r <- mapM runTest tests + if all (== True) r + then putStrLn "All tests succeeded." + else error "Tests failed. Report a bug!" + +tests :: [Test] +tests = + [ backupRestoreTest "very small" $ + testSecretKey 1 + , backupRestoreTest "full size" $ + testSecretKey (objectSize testModeTunables) + , backupRestoreTest "two chunks" $ + testSecretKey (objectSize testModeTunables + 1) + , backupRestoreTest "many chunks" $ + testSecretKey (objectSize testModeTunables * 10) + , stableNamingTest "stable naming" + ] + +testSecretKey :: Int -> SecretKey +testSecretKey sz = SecretKey $ BU8.fromString $ take sz $ concatMap show [1..sz] + +withTestStorageLocations :: (StorageLocations -> IO a) -> IO a +withTestStorageLocations a = bracket setup cleanup go + where + setup = mkdtemp "keysafe-test" + cleanup = removeDirectoryRecursive + go tmpdir = a $ StorageLocations $ + map (localStorage (testStorageDir tmpdir) . show) + [1..100 :: Int] + +-- | Test of backup and restore of a SecretKey. +backupRestoreTest :: TestDesc -> SecretKey -> Test +backupRestoreTest testdesc secretkey = + ("backup and restore (" ++ testdesc ++ ")", runtest) + where + runtest = withTestStorageLocations $ \storagelocations -> do + backup storagelocations + restore storagelocations + + backup storagelocations = do + kek <- genKeyEncryptionKey tunables name password + let esk = encrypt tunables kek secretkey + shares <- genShares esk tunables + let sis = shareIdents tunables name secretkeysource + _ <- storeShares storagelocations sis shares (return ()) + return () + + restore storagelocations = do + let sis = shareIdents tunables name secretkeysource + (shares, sis') <- retrieveShares storagelocations sis (return ()) + let candidatekeys = candidateKeyEncryptionKeys tunables name password + case combineShares tunables [shares] of + Left e -> testFailed e + Right esk -> restorerest storagelocations [shares] sis' $ + tryDecrypt candidatekeys esk + + restorerest storagelocations firstshares sis r = case r of + DecryptFailed -> testFailed "DecryptFailed" + DecryptSuccess restoredsecretkey -> + if restoredsecretkey == secretkey + then testSuccess + else testFailed "restore yielded different value than was backed up" + DecryptIncomplete kek -> do + (nextshares, sis') <- retrieveShares storagelocations sis (return ()) + let shares = firstshares ++ [nextshares] + case combineShares tunables shares of + Left e -> testFailed e + Right esk -> restorerest storagelocations shares sis' $ + decrypt kek esk + + name = Name testdesc + password = Password "password" + secretkeysource = GpgKey (KeyId "dummy") + -- testModeTunables is used, to avoid this taking a very + -- long time to run. + tunables = testModeTunables + +-- | It's important that StorableObjectIdent generation be stable; +-- any change to it will cause shards to get lost. +stableNamingTest :: TestDesc -> Test +stableNamingTest testdesc = (testdesc, runtest $ map snd knownTunings) + where + runtest [] = testFailed "not stable!" + runtest (tunables:rest) = do + let sis = shareIdents tunables name secretkeysource + if S.member knownvalue (head (identsStream sis)) + then testSuccess + else runtest rest + + name = Name "stable name" + secretkeysource = GpgKey (KeyId "stable keyid") + knownvalue = StorableObjectIdent "18b112da9108b4b5e21fa07cfc672e11688110e4c2dc56c8365f0de488cca8cb" diff --git a/Tunables.hs b/Tunables.hs index 3356516..0a317c5 100644 --- a/Tunables.hs +++ b/Tunables.hs @@ -81,6 +81,7 @@ data KeyEncryptionKeyTunable = KeyEncryptionKeyTunable data EncryptionTunable = UseAES256 deriving (Show) +-- | Tunables used by default to backup. defaultTunables :: Tunables defaultTunables = Tunables { shareParams = ShareParams { totalObjects = 3, neededObjects = 2 } diff --git a/Types.hs b/Types.hs index a132f26..e129ea3 100644 --- a/Types.hs +++ b/Types.hs @@ -15,6 +15,7 @@ import GHC.Generics (Generic) -- | keysafe stores secret keys. newtype SecretKey = SecretKey B.ByteString + deriving (Eq) -- | The secret key, encrypted with a password, in fixed size chunks. data EncryptedSecretKey = EncryptedSecretKey [B.ByteString] (CostCalc BruteForceOp UnknownPassword) diff --git a/keysafe.cabal b/keysafe.cabal index 8648437..fa530dd 100644 --- a/keysafe.cabal +++ b/keysafe.cabal @@ -77,6 +77,7 @@ Executable keysafe Storage Storage.Local Storage.Network + Tests Tunables Types Types.Cost diff --git a/keysafe.hs b/keysafe.hs index 0f32ac1..3bb5793 100644 --- a/keysafe.hs +++ b/keysafe.hs @@ -14,6 +14,7 @@ import UI import Encryption import Entropy import ExpensiveHash +import Tests import Cost import SecretKey import Share @@ -69,6 +70,8 @@ dispatch cmdline ui storagelocations tunables possibletunables = do (CmdLine.serverPort $ CmdLine.serverConfig cmdline) go CmdLine.Benchmark _ = benchmarkTunables tunables + go CmdLine.Test _ = + runTests backup :: StorageLocations -> UI -> Tunables -> SecretKeySource -> SecretKey -> IO () backup storagelocations ui tunables secretkeysource secretkey = do @@ -253,7 +256,7 @@ restore storagelocations ui possibletunables secretkeydest = do ] -- | Try each possible tunable until the initial set of --- shares are found, the return the shares, and +-- shares are found, and return the shares, and -- ShareIdents to download subsequent sets. downloadInitialShares :: StorageLocations -- cgit v1.2.3