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.

1 files changed, 52 insertions, 23 deletions

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))