Added --backup-server and --restore-server

To aid in backing up keysafe servers with minimal information leakage.

This commit was sponsored by Andrea Rota.

1 files changed, 62 insertions, 0 deletions

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"