Gpg keyid bugs

Fix bugs with entry of gpg keyid in the keysafe.log. Gpg.anyKey was being
used in writing the log, which made the log contain gpg keys with an empty
keyid.

Fix bug in --autostart that caused the full gpg keyid to be
used in the name, so restores would only work when --gpgkeyid was
specifid.

Added a Distinguisher data type rather than the Gpg.anyKey hack.

This commit was sponsored by Thom May on Patreon.

8 files changed, 63 insertions, 38 deletions

diff --git a/CHANGELOG b/CHANGELOG
index fa535a9..2dfb0a2 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -4,6 +4,10 @@ keysafe (0.20160928) UNRELEASED; urgency=medium
   * New --add-storage-directory and --add-server options, which can be used
     to make keysafe backup/restore using additional locations.
   * Removed --store-local option; use --add-storage-directory instead.
+  * Fix bugs with entry of gpg keyid in the keysafe.log.
+  * Fix bug in --autostart that caused the full gpg keyid to be
+    used to generate object names, which made restores would only work
+    when --gpgkeyid was specifid.
 
  -- Joey Hess <id@joeyh.name>  Wed, 05 Oct 2016 20:54:51 -0400
 
diff --git a/Gpg.hs b/Gpg.hs
index 8290c2f..91b53cd 100644
--- a/Gpg.hs
+++ b/Gpg.hs
@@ -21,20 +21,19 @@ 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 -> IO (SecretKeySource, SecretKey)
 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)] = getSecretKey kid
-	go l = maybe (error "Canceled") getSecretKey
+	go [(_, kid)] = mkret kid
+	go l = maybe (error "Canceled") mkret
 		=<< promptKeyId ui "Pick gpg secret key"
 			"Pick gpg secret key to back up:" l
-
--- | Use when the gpg keyid will not be known at restore time.
-anyKey :: SecretKeySource
-anyKey = GpgKey (KeyId "")
+	mkret kid = do
+		sk <- getSecretKey kid
+		return (GpgKey kid, sk)
 
 listSecretKeys :: IO [(Name, KeyId)]
 listSecretKeys = map mk . parse . lines <$> readProcess "gpg"
diff --git a/SecretKey.hs b/SecretKey.hs
index 45d9680..8dc2ada 100644
--- a/SecretKey.hs
+++ b/SecretKey.hs
@@ -6,19 +6,24 @@
 module SecretKey where
 
 import Types
+import Share
 import qualified Gpg
 import qualified Data.ByteString as B
 import System.IO
 import System.Posix.IO
 
-getSecretKey :: SecretKeySource -> IO SecretKey
-getSecretKey (GpgKey kid) = Gpg.getSecretKey kid
-getSecretKey (KeyFile f) = SecretKey <$> B.readFile f
+getSecretKey :: SecretKeySource -> IO (SecretKeySource, SecretKey)
+getSecretKey sks = do
+	sk <- case sks of
+		GpgKey kid -> Gpg.getSecretKey kid
+		KeyFile f -> SecretKey <$> B.readFile f
+	return (sks, sk)
 
 -- | Can throw exception if the secret key already exists.
-writeSecretKey :: SecretKeySource -> SecretKey -> IO ()
-writeSecretKey (GpgKey _) secretkey = Gpg.writeSecretKey secretkey
-writeSecretKey (KeyFile f) (SecretKey b) = do
+writeSecretKey :: Distinguisher -> SecretKey -> IO ()
+writeSecretKey (Distinguisher (GpgKey _)) secretkey = Gpg.writeSecretKey secretkey
+writeSecretKey AnyGpgKey secretkey = Gpg.writeSecretKey secretkey
+writeSecretKey (Distinguisher (KeyFile f)) (SecretKey b) = do
 	fd <- openFd f WriteOnly (Just 0o666)
 		(defaultFileFlags { exclusive = True } )
 	h <- fdToHandle fd
diff --git a/Share.hs b/Share.hs
index e511afd..2d848b9 100644
--- a/Share.hs
+++ b/Share.hs
@@ -41,18 +41,28 @@ instance HasCreationCost ShareIdents where
 instance Bruteforceable ShareIdents UnknownName where
 	getBruteCostCalc = identsBruteForceCalc
 
+data Distinguisher 
+	= Distinguisher SecretKeySource
+	| AnyGpgKey
+	-- ^ Use to avoid the gpg keyid needing to be provided 
+	-- at restore time.
+	deriving (Eq)
+
 -- | Generates identifiers to use for storing shares.
 --
 -- This is an expensive operation, to make it difficult for an attacker
 -- to brute force known/guessed names and find matching shares.
 -- The keyid or filename is used as a salt, to avoid collisions
 -- when the same name is chosen for multiple keys.
-shareIdents :: Tunables -> Name -> SecretKeySource -> ShareIdents
-shareIdents tunables (Name name) keyid =
+shareIdents :: Tunables -> Name -> Distinguisher -> ShareIdents
+shareIdents tunables (Name name) shareident =
 	ShareIdents (segmentbyshare idents) creationcost bruteforcecalc
   where
 	(ExpensiveHash creationcost basename) =
-		expensiveHash hashtunables (Salt keyid) name
+		expensiveHash hashtunables salt name
+	salt = case shareident of
+		Distinguisher sks -> Salt sks
+		AnyGpgKey -> Salt (GpgKey (KeyId ""))
 	mk n = StorableObjectIdent $ Raaz.toByteString $ mksha $
 		E.encodeUtf8 $ basename <> T.pack (show n)
 	mksha :: B.ByteString -> Raaz.Base16
diff --git a/Storage.hs b/Storage.hs
index 428dc6f..5ad1408 100644
--- a/Storage.hs
+++ b/Storage.hs
@@ -176,7 +176,7 @@ storeChaff hn port delayseconds = forever $ do
 	-- the randomname is not something that can be feasibly guessed.
 	-- Prefix "random chaff" to the name to avoid ever using a name
 	-- that a real user might want to use.
-	let sis = shareIdents testModeTunables (Name $ "random chaff:" <> randomname) (KeyFile "random")
+	let sis = shareIdents testModeTunables (Name $ "random chaff:" <> randomname) AnyGpgKey
 	mapConcurrently (go sis rng')
 		[1..totalObjects (shareParams testModeTunables)]
   where
diff --git a/Tests.hs b/Tests.hs
index 7294cfb..bbc9dcd 100644
--- a/Tests.hs
+++ b/Tests.hs
@@ -91,12 +91,12 @@ backupRestoreTest testdesc secretkey =
 		kek <- genKeyEncryptionKey tunables name password
 		let esk = encrypt tunables kek secretkey
 		shares <- genShares esk tunables
-		let sis = shareIdents tunables name secretkeysource
+		let sis = shareIdents tunables name AnyGpgKey
 		_ <- storeShares storagelocations sis shares (return ())
 		return ()
 
 	restore storagelocations = do
-		let sis = shareIdents tunables name secretkeysource
+		let sis = shareIdents tunables name AnyGpgKey
 		(shares, sis', _) <- retrieveShares storagelocations sis (return ())
 		let candidatekeys = candidateKeyEncryptionKeys tunables name password
 		case combineShares tunables [shares] of
@@ -120,7 +120,6 @@ backupRestoreTest testdesc secretkey =
 	
 	name = Name testdesc
 	password = Password "password"
-	secretkeysource = GpgKey (KeyId "dummy")
 	-- testModeTunables is used, to avoid this taking a very
 	-- long time to run.
 	tunables = testModeTunables
@@ -132,7 +131,7 @@ stableNamingTest testdesc = (testdesc, runtest $ map snd knownTunings)
   where
 	runtest [] = testFailed "not stable!"
 	runtest (tunables:rest) = do
-		let sis = shareIdents tunables name secretkeysource
+		let sis = shareIdents tunables name (Distinguisher secretkeysource)
 		if S.member knownvalue (head (identsStream sis))
 			then testSuccess
 			else runtest rest
diff --git a/Types.hs b/Types.hs
index 937b58c..2f97c61 100644
--- a/Types.hs
+++ b/Types.hs
@@ -51,7 +51,7 @@ newtype Password = Password B.ByteString
 
 -- | A name associated with a key stored in keysafe.
 newtype Name = Name B.ByteString
-	deriving (Show, Monoid)
+	deriving (Eq, Show, Monoid)
 
 -- | Source of the secret key stored in keysafe.
 data SecretKeySource = GpgKey KeyId | KeyFile FilePath
diff --git a/keysafe.hs b/keysafe.hs
index 4c93251..ae99879 100644
--- a/keysafe.hs
+++ b/keysafe.hs
@@ -61,15 +61,15 @@ dispatch cmdline ui tunables possibletunables = do
 	go mode (CmdLine.secretkeysource cmdline)
   where
 	go CmdLine.Backup (Just secretkeysource) =
-		backup cmdline ui tunables secretkeysource
+		backup cmdline ui tunables (Distinguisher secretkeysource)
 			=<< getSecretKey secretkeysource
 	go CmdLine.Restore (Just secretkeydest) =
-		restore cmdline ui possibletunables secretkeydest
+		restore cmdline ui possibletunables (Distinguisher secretkeydest)
 	go CmdLine.Backup Nothing =
-		backup cmdline ui tunables Gpg.anyKey
+		backup cmdline ui tunables AnyGpgKey
 			=<< Gpg.getKeyToBackup ui
 	go CmdLine.Restore Nothing =
-		restore cmdline ui possibletunables Gpg.anyKey
+		restore cmdline ui possibletunables AnyGpgKey
 	go CmdLine.UploadQueued _ =
 		uploadQueued ui (CmdLine.localstoragedirectory cmdline)
 	go CmdLine.AutoStart _ =
@@ -91,8 +91,8 @@ dispatch cmdline ui tunables possibletunables = do
 	go CmdLine.Test _ =
 		runTests
 
-backup :: CmdLine.CmdLine -> UI -> Tunables -> SecretKeySource -> SecretKey -> IO ()
-backup cmdline ui tunables secretkeysource secretkey = do
+backup :: CmdLine.CmdLine -> UI -> Tunables -> Distinguisher -> (SecretKeySource, SecretKey) -> IO ()
+backup cmdline ui tunables distinguisher (secretkeysource, secretkey) = do
 	installAutoStartFile
 
 	let m = totalObjects (shareParams tunables)
@@ -127,7 +127,7 @@ backup cmdline ui tunables secretkeysource secretkey = do
 					othernamedesc Nothing validateName
 		let name = Name (theirname <> " " <> othername)
 		(kek, passwordentropy) <- promptpassword name
-		let sis = shareIdents tunables name secretkeysource
+		let sis = shareIdents tunables name distinguisher
 		let cost = getCreationCost kek <> getCreationCost sis
 		(r, queued, usedlocs) <- withProgressIncremental ui "Encrypting and storing data"
 			(encryptdesc cost cores) $ \addpercent -> do
@@ -227,8 +227,8 @@ otherNameSuggestions = unlines $ map ("  * " ++)
 	, "A place you like to visit."
 	]
 
-restore :: CmdLine.CmdLine -> UI -> [Tunables] -> SecretKeySource -> IO ()
-restore cmdline ui possibletunables secretkeydest = do
+restore :: CmdLine.CmdLine -> UI -> [Tunables] -> Distinguisher -> IO ()
+restore cmdline ui possibletunables distinguisher = do
 	cores <- fromMaybe 1 <$> getNumCores
 	username <- userName
 	Name theirname <- case CmdLine.name cmdline of
@@ -245,7 +245,7 @@ restore cmdline ui possibletunables secretkeydest = do
 	password <- fromMaybe (error "Aborting on no password") 
 		<$> promptPassword ui True "Enter password" passworddesc
 	
-	let mksis tunables = shareIdents tunables name secretkeydest
+	let mksis tunables = shareIdents tunables name distinguisher
 	locs <- cmdLineStorageLocations cmdline
 	r <- downloadInitialShares locs ui mksis possibletunables
 	case r of
@@ -268,14 +268,22 @@ restore cmdline ui possibletunables secretkeydest = do
 			showError ui "Decryption failed! Probably you entered the wrong password."
 		DecryptSuccess secretkey -> do
 			_ <- setpercent 100
-			writeSecretKey secretkeydest secretkey
+			oldgpgkeys <- if distinguisher == AnyGpgKey then Gpg.listSecretKeys else return []
+			writeSecretKey distinguisher secretkey
+			newgpgkeys <- if distinguisher == AnyGpgKey then Gpg.listSecretKeys else return []
 			return $ \passwordentropy -> do
 				showInfo ui "Success" "Your secret key was successfully restored!"
 				-- Since the key was restored, we know it's
 				-- backed up; log that.
-				backuplog <- mkBackupLog $ 
-					backupMade firstusedservers secretkeydest passwordentropy
-				storeBackupLog backuplog
+				let updatelog restored = do
+					backuplog <- mkBackupLog $ 
+						backupMade firstusedservers restored passwordentropy
+					storeBackupLog backuplog
+				case distinguisher of
+					AnyGpgKey -> case filter (`notElem` oldgpgkeys) newgpgkeys of
+						[(_n, k)] -> updatelog (GpgKey k)
+						_ -> return ()
+					Distinguisher sks -> updatelog sks
 		DecryptIncomplete kek -> do
 			-- Download shares for another chunk.
 			(nextshares, sis', nextusedservers) 
@@ -405,8 +413,8 @@ autoStart cmdline tunables ui = do
 				("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
+				then backup cmdline ui tunables AnyGpgKey
+					=<< getSecretKey (GpgKey kid)
 				else storeBackupLog
 					=<< mkBackupLog (BackupSkipped (GpgKey kid))