diff options
| -rw-r--r-- | CHANGELOG | 2 | ||||
| -rw-r--r-- | CmdLine.hs | 123 | ||||
| -rw-r--r-- | HTTP/Server.hs | 18 | ||||
| -rw-r--r-- | ServerBackup.hs | 62 | ||||
| -rw-r--r-- | Storage/Local.hs | 8 | ||||
| -rw-r--r-- | keysafe.cabal | 1 | ||||
| -rw-r--r-- | keysafe.hs | 5 |
7 files changed, 153 insertions, 66 deletions
@@ -5,6 +5,8 @@ keysafe (0.20160915) UNRELEASED; urgency=medium * Make rate limiter adapt to ongoing load more quickly -- every 15 minutes instead of every 60. * Change format of ~/.keysafe/backup.log + * Added --backup-server and --restore-server to aid in backing up keysafe + servers with minimal information leakage. -- Joey Hess <id@joeyh.name> Wed, 14 Sep 2016 20:19:43 -0400 @@ -29,7 +29,7 @@ data CmdLine = CmdLine , serverConfig :: ServerConfig } -data Mode = Backup | Restore | UploadQueued | Server | Chaff HostName | Benchmark | Test +data Mode = Backup | Restore | UploadQueued | Server | GenBackup FilePath | RestoreBackup FilePath | Chaff HostName | Benchmark | Test deriving (Show) data ServerConfig = ServerConfig @@ -40,7 +40,7 @@ data ServerConfig = ServerConfig parse :: Parser CmdLine parse = CmdLine - <$> optional (backup <|> restore <|> uploadqueued <|> server <|> chaff <|> benchmark <|> test) + <$> optional parseMode <*> optional (gpgswitch <|> fileswitch) <*> localstorageswitch <*> localstoragedirectoryopt @@ -49,37 +49,8 @@ parse = CmdLine <*> optional (ShareParams <$> totalobjects <*> neededobjects) <*> nameopt <*> othernameopt - <*> serverconfig + <*> parseServerConfig where - backup = flag' Backup - ( long "backup" - <> help "Store a secret key in keysafe." - ) - restore = flag' Restore - ( long "restore" - <> help "Retrieve a secret key from keysafe." - ) - uploadqueued = flag' UploadQueued - ( long "uploadqueued" - <> help "Upload any data to servers that was queued by a previous --backup run." - ) - server = flag' Server - ( long "server" - <> help "Run as a keysafe server, accepting objects and storing them to ~/.keysafe/objects/local/" - ) - chaff = Chaff <$> strOption - ( long "chaff" - <> metavar "HOSTNAME" - <> help "Upload random data to a keysafe server." - ) - benchmark = flag' Benchmark - ( long "benchmark" - <> help "Benchmark speed of keysafe's cryptographic primitives." - ) - test = flag' Test - ( long "test" - <> help "Run test suite." - ) gpgswitch = GpgKey . KeyId . T.pack <$> strOption ( long "gpgkeyid" <> metavar "KEYID" @@ -127,28 +98,72 @@ parse = CmdLine <> metavar "N" <> help "Specify other name used for key backup/restore, avoiding the usual prompt." ) - serverconfig = ServerConfig - <$> option auto - ( long "port" - <> metavar "P" - <> value 80 - <> showDefault - <> help "Port for server to listen on." - ) - <*> option str - ( long "address" - <> metavar "A" - <> value "127.0.0.1" - <> showDefault - <> help "Address for server to bind to. (Use \"*\" to bind to all addresses.)" - ) - <*> option auto - ( long "months-to-fill-half-disk" - <> metavar "N" - <> value 12 - <> showDefault - <> help "Server rate-limits requests and requires proof of work, to avoid too many objects being stored. This is an lower bound on how long it could possibly take for half of the current disk space to be filled." - ) + +parseMode :: Parser Mode +parseMode = + flag' Backup + ( long "backup" + <> help "Store a secret key in keysafe." + ) + <|> flag' Restore + ( long "restore" + <> help "Retrieve a secret key from keysafe." + ) + <|> flag' UploadQueued + ( long "uploadqueued" + <> help "Upload any data to servers that was queued by a previous --backup run." + ) + <|> flag' Server + ( long "server" + <> help "Run as a keysafe server, accepting objects and storing them to ~/.keysafe/objects/local/" + ) + <|> GenBackup <$> strOption + ( long "backup-server" + <> metavar "BACKUPDIR" + <> help "Run on a server, populates the directory with a gpg encrypted backup of all objects stored in the --store-directory. This is designed to be rsynced offsite (with --delete) to back up the a keysafe server with minimal information leakage." + ) + <|> RestoreBackup <$> strOption + ( long "restore-server" + <> metavar "BACKUPDIR" + <> help "Restore all objects present in the gpg-encrypted backups in the specified directory." + ) + <|> Chaff <$> strOption + ( long "chaff" + <> metavar "HOSTNAME" + <> help "Upload random data to a keysafe server." + ) + <|> flag' Benchmark + ( long "benchmark" + <> help "Benchmark speed of keysafe's cryptographic primitives." + ) + <|> flag' Test + ( long "test" + <> help "Run test suite." + ) + +parseServerConfig :: Parser ServerConfig +parseServerConfig = ServerConfig + <$> option auto + ( long "port" + <> metavar "P" + <> value 80 + <> showDefault + <> help "Port for server to listen on." + ) + <*> option str + ( long "address" + <> metavar "A" + <> value "127.0.0.1" + <> showDefault + <> help "Address for server to bind to. (Use \"*\" to bind to all addresses.)" + ) + <*> option auto + ( long "months-to-fill-half-disk" + <> metavar "N" + <> value 12 + <> showDefault + <> help "Server rate-limits requests and requires proof of work, to avoid too many objects being stored. This is an lower bound on how long it could possibly take for half of the current disk space to be filled." + ) get :: IO CmdLine get = execParser opts diff --git a/HTTP/Server.hs b/HTTP/Server.hs index e2165eb..c667601 100644 --- a/HTTP/Server.hs +++ b/HTTP/Server.hs @@ -5,7 +5,7 @@ - Licensed under the GNU AGPL version 3 or higher. -} -module HTTP.Server (runServer) where +module HTTP.Server (runServer, serverStorage) where import HTTP import HTTP.ProofOfWork @@ -29,7 +29,7 @@ import qualified Data.ByteString as B data ServerState = ServerState { obscurerRequest :: TMVar () - , storageDirectory :: Maybe LocalStorageDirectory + , storage :: Storage , rateLimiter :: RateLimiter , logger :: Logger } @@ -39,7 +39,7 @@ newServerState d cfg = do l <- newLogger ServerState <$> newEmptyTMVarIO - <*> pure d + <*> pure (serverStorage d) <*> newRateLimiter cfg d l <*> pure l @@ -52,8 +52,8 @@ runServer d cfg = do settings = setHost host $ setPort (serverPort cfg) $ defaultSettings host = fromString (serverAddress cfg) -serverStorage :: ServerState -> Storage -serverStorage st = localStorage (storageDir $ storageDirectory st) "server" +serverStorage :: Maybe LocalStorageDirectory -> Storage +serverStorage d = localStorage (storageDir d) "server" app :: ServerState -> Application app st = serve userAPI (server st) @@ -72,7 +72,7 @@ motd = return $ Motd "Hello World!" getObject :: ServerState -> StorableObjectIdent -> Maybe ProofOfWork -> Handler (POWGuarded StorableObject) getObject st i pow = rateLimit (rateLimiter st) (logger st) pow i $ do - r <- liftIO $ retrieveShare (serverStorage st) dummyShareNum i + r <- liftIO $ retrieveShare (storage st) dummyShareNum i liftIO $ requestObscure st case r of RetrieveSuccess (Share _n o) -> return o @@ -82,7 +82,7 @@ putObject :: ServerState -> StorableObjectIdent -> Maybe ProofOfWork -> Storable putObject st i pow o = rateLimit (rateLimiter st) (logger st) pow i $ do if validObjectsize o then do - r <- liftIO $ storeShare (serverStorage st) i (Share dummyShareNum o) + r <- liftIO $ storeShare (storage st) i (Share dummyShareNum o) liftIO $ requestObscure st return r else return $ StoreFailure "invalid object size" @@ -94,7 +94,7 @@ validObjectsize o = any (sz ==) knownObjectSizes countObjects :: ServerState -> Maybe ProofOfWork -> Handler (POWGuarded CountResult) countObjects st pow = rateLimit (rateLimiter st) (logger st) pow NoPOWIdent $ - liftIO $ countShares $ serverStorage st + liftIO $ countShares $ storage st -- | 1 is a dummy value; the server does not know the actual share numbers. dummyShareNum :: ShareNum @@ -105,7 +105,7 @@ dummyShareNum = 1 -- the thread runs a maximum of once per half-hour. obscurerThread :: ServerState -> IO () obscurerThread st = do - _ <- obscureShares (serverStorage st) + _ <- obscureShares (storage st) logStdout (logger st) "obscured shares" delay (1000000*60*30) _ <- atomically $ takeTMVar (obscurerRequest st) diff --git a/ServerBackup.hs b/ServerBackup.hs new file mode 100644 index 0000000..9506ccf --- /dev/null +++ b/ServerBackup.hs @@ -0,0 +1,62 @@ +{- Copyright 2016 Joey Hess <id@joeyh.name> + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +module ServerBackup where + +import Storage +import Storage.Local +import HTTP.Server +import System.Process +import System.FilePath +import System.Directory +import Data.List +import Control.Monad +import Data.Time.Clock.POSIX + +-- | Storing all shards in one gpg encrypted file avoids a problem with +-- modern incremental backup programs such as obnam: Access to an obnam +-- repository allows one to see the date when a chunk first enters the +-- repository, which can allow dating when objects were first stored +-- in keysafe, and so help in a correlation attack. +-- +-- Of course, it's not at all efficient for offsite backups! +genBackup :: Maybe LocalStorageDirectory -> FilePath -> IO () +genBackup lsd d = do + let storage = serverStorage lsd + _ <- obscureShares storage + topdir <- storageTopDir lsd + createDirectoryIfMissing True d + dest <- backupFile d <$> getPOSIXTime + callCommand ("tar c " ++ topdir ++ " | gpg --encrypt --default-recipient-self > " ++ dest) + -- Keep the past 7 backup files, in case an object file somehow + -- gets deleted, this avoids the backup losing it too. + -- These backup files can be used to determine eg, what day + -- chunks were uploaded to the server, which is why only a few + -- are kept. + pruneOldBackups d 7 + +restoreBackup :: Maybe LocalStorageDirectory -> FilePath -> IO () +restoreBackup lsd d = do + topdir <- storageTopDir lsd + bs <- findBackups d + forM_ bs $ \b -> + callCommand ("gpg --decrypt " ++ b ++ " | tar -C " ++ topdir ++ " x") + let storage = serverStorage lsd + _ <- obscureShares storage + return () + +findBackups :: FilePath -> IO [FilePath] +findBackups d = map (d </>) . filter isBackup <$> getDirectoryContents d + +pruneOldBackups :: FilePath -> Int -> IO () +pruneOldBackups d keep = do + fs <- findBackups d + mapM_ removeFile (drop keep (reverse (sort fs))) + +isBackup :: FilePath -> Bool +isBackup f = "keysafe-backup" `isPrefixOf` f + +backupFile :: FilePath -> POSIXTime -> FilePath +backupFile d t = d </> "keysafe-backup." ++ show t ++ ".gpg" diff --git a/Storage/Local.hs b/Storage/Local.hs index 6a952fa..90da7b8 100644 --- a/Storage/Local.hs +++ b/Storage/Local.hs @@ -6,6 +6,7 @@ module Storage.Local ( localStorage , storageDir + , storageTopDir , testStorageDir , localDiskUsage ) where @@ -147,13 +148,14 @@ storageDir Nothing (Section section) = do storageDir (Just (LocalStorageDirectory d)) (Section section) = pure $ d </> section +storageTopDir :: Maybe LocalStorageDirectory -> IO FilePath +storageTopDir lsd = storageDir lsd (Section ".") + testStorageDir :: FilePath -> GetShareDir testStorageDir tmpdir = storageDir (Just (LocalStorageDirectory tmpdir)) localDiskUsage :: Maybe LocalStorageDirectory -> IO DiskUsage -localDiskUsage lsd = do - dir <- storageDir lsd (Section ".") - getDiskUsage dir +localDiskUsage lsd = getDiskUsage =<< storageTopDir lsd -- | The takeFileName ensures that, if the StorableObjectIdent somehow -- contains a path (eg starts with "../" or "/"), it is not allowed diff --git a/keysafe.cabal b/keysafe.cabal index c3e7489..a01983d 100644 --- a/keysafe.cabal +++ b/keysafe.cabal @@ -93,6 +93,7 @@ Executable keysafe HTTP.RateLimit SecretKey Serialization + ServerBackup Servers Share Storage @@ -21,6 +21,7 @@ import Share import Storage import BackupRecord import HTTP.Server +import ServerBackup import qualified Gpg import Data.Maybe import Data.Time.Clock @@ -72,6 +73,10 @@ dispatch cmdline ui storagelocations tunables possibletunables = do runServer (CmdLine.localstoragedirectory cmdline) (CmdLine.serverConfig cmdline) + go (CmdLine.GenBackup d) _ = + genBackup (CmdLine.localstoragedirectory cmdline) d + go (CmdLine.RestoreBackup d) _ = + restoreBackup (CmdLine.localstoragedirectory cmdline) d go (CmdLine.Chaff hn) _ = storeChaff hn (CmdLine.serverPort (CmdLine.serverConfig cmdline)) go CmdLine.Benchmark _ = |