diff options
| -rw-r--r-- | BackupLog.hs | 4 | ||||
| -rw-r--r-- | CHANGELOG | 2 | ||||
| -rw-r--r-- | CmdLine.hs | 6 | ||||
| -rw-r--r-- | Gpg.hs | 6 | ||||
| -rw-r--r-- | ServerBackup.hs | 8 | ||||
| -rw-r--r-- | TODO | 2 | ||||
| -rw-r--r-- | Types.hs | 4 | ||||
| -rw-r--r-- | keysafe.hs | 75 |
8 files changed, 70 insertions, 37 deletions
diff --git a/BackupLog.hs b/BackupLog.hs index 802528f..70ec699 100644 --- a/BackupLog.hs +++ b/BackupLog.hs @@ -46,6 +46,10 @@ data BackupEvent } deriving (Show, Generic) +matchesSecretKeySource :: SecretKeySource -> BackupLog -> Bool +matchesSecretKeySource a (BackupLog _ (BackupSkipped b)) = a == b +matchesSecretKeySource a (BackupLog _ (BackupMade { backupSecretKeySource = b })) = a == b + instance ToJSON BackupEvent instance FromJSON BackupEvent @@ -13,6 +13,8 @@ keysafe (0.20160915) UNRELEASED; urgency=medium * Added --autostart mode, and make both keysafe --backup and the Makefile install a FDO desktop autostart file to use it. * In --autostart mode, retry any queued uploads. + * In --autostart mode, check for gpg keys that have not been + backed up, and offer to back them up. Only ask once per key. -- 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 | AutoStart | Server | GenBackup FilePath | RestoreBackup FilePath | Chaff HostName | Benchmark | Test +data Mode = Backup | Restore | UploadQueued | AutoStart | Server | BackupServer FilePath | RestoreServer FilePath | Chaff HostName | Benchmark | Test deriving (Show) data ServerConfig = ServerConfig @@ -121,12 +121,12 @@ parseMode = ( long "server" <> help "Run as a keysafe server, accepting objects and storing them to ~/.keysafe/objects/local/" ) - <|> GenBackup <$> strOption + <|> BackupServer <$> 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 + <|> RestoreServer <$> strOption ( long "restore-server" <> metavar "BACKUPDIR" <> help "Restore all objects present in the gpg-encrypted backups in the specified directory." @@ -22,13 +22,13 @@ import qualified Data.Text as T -- If there is only one gpg secret key, -- the choice is obvious. Otherwise prompt the user with a list. getKeyToBackup :: UI -> IO SecretKey -getKeyToBackup ui = go =<< Gpg.listSecretKeys +getKeyToBackup ui = go =<< listSecretKeys where go [] = do showError ui "You have no gpg secret keys to back up." error "Aborting on no gpg secret keys." - go [(_, kid)] = Gpg.getSecretKey kid - go l = maybe (error "Canceled") Gpg.getSecretKey + go [(_, kid)] = getSecretKey kid + go l = maybe (error "Canceled") getSecretKey =<< promptKeyId ui "Pick gpg secret key" "Pick gpg secret key to back up:" l diff --git a/ServerBackup.hs b/ServerBackup.hs index bf76929..1c6b6a9 100644 --- a/ServerBackup.hs +++ b/ServerBackup.hs @@ -22,8 +22,8 @@ import Data.Time.Clock.POSIX -- 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 +backupServer :: Maybe LocalStorageDirectory -> FilePath -> IO () +backupServer lsd d = do let storage = serverStorage lsd _ <- obscureShares storage topdir <- storageTopDir lsd @@ -37,8 +37,8 @@ genBackup lsd d = do -- are kept. pruneOldBackups d 7 -restoreBackup :: Maybe LocalStorageDirectory -> FilePath -> IO () -restoreBackup lsd d = do +restoreServer :: Maybe LocalStorageDirectory -> FilePath -> IO () +restoreServer lsd d = do topdir <- storageTopDir lsd bs <- findBackups d forM_ bs $ \b -> @@ -3,8 +3,6 @@ Soon: * Implement the different categories of servers in the server list. * Get some keysafe servers set up. * Run --uploadqueued periodically (systemd timer or desktop autostart?) -* In --autostart mode, check for gpg keys that have not been - backed up, and offer to back them up. Only once per key. Later: @@ -55,7 +55,7 @@ newtype Name = Name B.ByteString -- | Source of the secret key stored in keysafe. data SecretKeySource = GpgKey KeyId | KeyFile FilePath - deriving (Show, Generic) + deriving (Show, Eq, Generic) instance ToJSON SecretKeySource instance FromJSON SecretKeySource @@ -65,7 +65,7 @@ instance FromJSON SecretKeySource -- -- A gpg keyid is the obvious example. data KeyId = KeyId T.Text - deriving (Show, Generic) + deriving (Show, Eq, Generic) instance ToJSON KeyId instance FromJSON KeyId @@ -31,6 +31,7 @@ import Data.Time.Calendar import Data.Monoid import Data.List import Control.DeepSeq +import qualified Data.Text as T import qualified Data.ByteString as B import qualified Data.ByteString.UTF8 as BU8 import qualified Data.Set as S @@ -47,38 +48,35 @@ main = do "Keysafe is running in test mode. This is not secure, and should not be used with real secret keys!" return (mkt testModeTunables, [mkt testModeTunables]) else return (mkt defaultTunables, map (mkt . snd) knownTunings) - let storagelocations = if CmdLine.localstorage cmdline - then localStorageLocations (CmdLine.localstoragedirectory cmdline) - else networkStorageLocations (CmdLine.localstoragedirectory cmdline) - dispatch cmdline ui storagelocations tunables possibletunables + dispatch cmdline ui tunables possibletunables -dispatch :: CmdLine.CmdLine -> UI -> StorageLocations -> Tunables -> [Tunables] -> IO () -dispatch cmdline ui storagelocations tunables possibletunables = do +dispatch :: CmdLine.CmdLine -> UI -> Tunables -> [Tunables] -> IO () +dispatch cmdline ui tunables possibletunables = do mode <- CmdLine.selectMode cmdline go mode (CmdLine.secretkeysource cmdline) where go CmdLine.Backup (Just secretkeysource) = - backup cmdline storagelocations ui tunables secretkeysource + backup cmdline ui tunables secretkeysource =<< getSecretKey secretkeysource go CmdLine.Restore (Just secretkeydest) = - restore cmdline storagelocations ui possibletunables secretkeydest + restore cmdline ui possibletunables secretkeydest go CmdLine.Backup Nothing = - backup cmdline storagelocations ui tunables Gpg.anyKey + backup cmdline ui tunables Gpg.anyKey =<< Gpg.getKeyToBackup ui go CmdLine.Restore Nothing = - restore cmdline storagelocations ui possibletunables Gpg.anyKey + restore cmdline ui possibletunables Gpg.anyKey go CmdLine.UploadQueued _ = uploadQueued ui (CmdLine.localstoragedirectory cmdline) go CmdLine.AutoStart _ = - autoStart ui (CmdLine.localstoragedirectory cmdline) + autoStart cmdline tunables ui go (CmdLine.Server) _ = 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.BackupServer d) _ = + backupServer (CmdLine.localstoragedirectory cmdline) d + go (CmdLine.RestoreServer d) _ = + restoreServer (CmdLine.localstoragedirectory cmdline) d go (CmdLine.Chaff hn) _ = storeChaff hn (CmdLine.serverPort (CmdLine.serverConfig cmdline)) go CmdLine.Benchmark _ = @@ -86,8 +84,8 @@ dispatch cmdline ui storagelocations tunables possibletunables = do go CmdLine.Test _ = runTests -backup :: CmdLine.CmdLine -> StorageLocations -> UI -> Tunables -> SecretKeySource -> SecretKey -> IO () -backup cmdline storagelocations ui tunables secretkeysource secretkey = do +backup :: CmdLine.CmdLine -> UI -> Tunables -> SecretKeySource -> SecretKey -> IO () +backup cmdline ui tunables secretkeysource secretkey = do installAutoStartFile username <- userName Name theirname <- case CmdLine.name cmdline of @@ -115,7 +113,7 @@ backup cmdline storagelocations ui tunables secretkeysource secretkey = do _ <- esk `deepseq` addpercent 25 _ <- sis `seq` addpercent 25 let step = 50 `div` sum (map S.size shares) - storeShares storagelocations sis shares (addpercent step) + storeShares (cmdLineStorageLocations cmdline) sis shares (addpercent step) backuplog <- mkBackupLog $ backupMade (mapMaybe getServer locs) secretkeysource passwordentropy case r of StoreSuccess -> do @@ -206,8 +204,8 @@ otherNameSuggestions = unlines $ map (" * " ++) , "A place you like to visit." ] -restore :: CmdLine.CmdLine -> StorageLocations -> UI -> [Tunables] -> SecretKeySource -> IO () -restore cmdline storagelocations ui possibletunables secretkeydest = do +restore :: CmdLine.CmdLine -> UI -> [Tunables] -> SecretKeySource -> IO () +restore cmdline ui possibletunables secretkeydest = do cores <- fromMaybe 1 <$> getNumCores username <- userName Name theirname <- case CmdLine.name cmdline of @@ -241,6 +239,7 @@ restore cmdline storagelocations ui possibletunables secretkeydest = do tryDecrypt candidatekeys esk final =<< getPasswordEntropy password name where + storagelocations = cmdLineStorageLocations cmdline go tunables firstshares firstusedservers sis setpercent r = case r of DecryptFailed -> return $ \_ -> showError ui "Decryption failed! Probably you entered the wrong password." @@ -337,6 +336,13 @@ userName = do u <- getUserEntryForID =<< getEffectiveUserID return $ Name $ BU8.fromString $ takeWhile (/= ',') (userGecos u) +cmdLineStorageLocations :: CmdLine.CmdLine -> StorageLocations +cmdLineStorageLocations cmdline + | CmdLine.localstorage cmdline = localStorageLocations lsd + | otherwise = networkStorageLocations lsd + where + lsd = CmdLine.localstoragedirectory cmdline + getPasswordEntropy :: Password -> Name -> IO (Entropy UnknownPassword) getPasswordEntropy password name = do username <- userName @@ -352,6 +358,29 @@ uploadQueued ui d = do then return () else showError ui ("Problem uploading queued data to servers:\n\n" ++ unlines problems ++ "\n\nYour secret keys have not yet been backed up.") -autoStart :: UI -> Maybe LocalStorageDirectory -> IO () -autoStart ui d = do - uploadQueued ui d +autoStart :: CmdLine.CmdLine -> Tunables -> UI -> IO () +autoStart cmdline tunables ui = do + -- Upload queued first, before making any more backups that might + -- queue more. + uploadQueued ui (CmdLine.localstoragedirectory cmdline) + + -- Ask about backing up any gpg secret key that has not been backed up + -- or asked about before. If there are multiple secret keys, only + -- the first one is asked about, to avoid flooding with prompts + -- if the user for some reason generated a lot of secret keys. + ls <- readBackupLogs + ks <- Gpg.listSecretKeys + case filter (\(_, k) -> not $ any (matchesSecretKeySource (GpgKey k)) ls) ks of + [] -> return () + ((Name n,kid@(KeyId kt)):_) -> do + let kdesc = if length ks < 2 + then "gpg secret key " + else "gpg secret key for " ++ BU8.toString n ++ " (" ++ T.unpack kt ++ ") " + ans <- promptQuestion ui ("Back up gpg secret key?") + ("Your " ++ kdesc ++ " has not been backed up by keysafe yet.\n\nKeysafe can securely back up the secret key to the cloud, protected with a password.\n") + "Do you want to back up the gpg secret key now?" + if ans + then backup cmdline ui tunables (GpgKey kid) + =<< Gpg.getSecretKey kid + else storeBackupLog + =<< mkBackupLog (BackupSkipped (GpgKey kid)) |