blob: 1c6b6a9c026834e1121ffda4159f825c086412af (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
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!
backupServer :: Maybe LocalStorageDirectory -> FilePath -> IO ()
backupServer lsd d = do
let storage = serverStorage lsd
_ <- obscureShares storage
topdir <- storageTopDir lsd
createDirectoryIfMissing True d
dest <- backupFile d <$> getPOSIXTime
callCommand ("tar -C " ++ topdir ++ " -c . | 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
restoreServer :: Maybe LocalStorageDirectory -> FilePath -> IO ()
restoreServer 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"
|
