In --autostart mode, check for gpg keys that have not been backed up, and offer to back them up.

Only ask once per key.

This commit was sponsored by Thomas Hochstein on Patreon.

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
 
diff --git a/CHANGELOG b/CHANGELOG
index 145aa76..5748dbd 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -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
 
diff --git a/CmdLine.hs b/CmdLine.hs
index 99414ff..4011f56 100644
--- a/CmdLine.hs
+++ b/CmdLine.hs
@@ -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."
diff --git a/Gpg.hs b/Gpg.hs
index c752059..8290c2f 100644
--- a/Gpg.hs
+++ b/Gpg.hs
@@ -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 ->
diff --git a/TODO b/TODO
index ec65396..11aa26f 100644
--- a/TODO
+++ b/TODO
@@ -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:
 
diff --git a/Types.hs b/Types.hs
index c065da3..937b58c 100644
--- a/Types.hs
+++ b/Types.hs
@@ -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
diff --git a/keysafe.hs b/keysafe.hs
index a6db8ca..3da20c6 100644
--- a/keysafe.hs
+++ b/keysafe.hs
@@ -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))