diff options
-rw-r--r-- | CHANGELOG | 2 | ||||
-rw-r--r-- | Gpg.hs | 10 | ||||
-rw-r--r-- | SecretKey.hs | 9 | ||||
-rw-r--r-- | keysafe.hs | 17 |
4 files changed, 19 insertions, 19 deletions
@@ -10,6 +10,8 @@ keysafe (0.20161023) UNRELEASED; urgency=medium delay between 1 and 2 hours and try again. * Better suggestion when user is having difficulty thinking of a strong enough password. + * Defer requesting secret key from gpg until just before backup, so the + user knows why gpg is asking for this secret key to be backed up. -- Joey Hess <id@joeyh.name> Sun, 23 Oct 2016 15:30:02 -0400 @@ -21,19 +21,17 @@ 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 (SecretKeySource, SecretKey) +getKeyToBackup :: UI -> IO SecretKeySource 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)] = mkret kid - go l = maybe (error "Canceled") mkret + go [(_, kid)] = selected kid + go l = maybe (error "Canceled") selected =<< promptKeyId ui "Pick gpg secret key" "Pick gpg secret key to back up:" l - mkret kid = do - sk <- getSecretKey kid - return (GpgKey kid, sk) + selected = return . GpgKey listSecretKeys :: IO [(Name, KeyId)] listSecretKeys = map mk . parse . lines <$> readProcess "gpg" diff --git a/SecretKey.hs b/SecretKey.hs index 8dc2ada..15256d0 100644 --- a/SecretKey.hs +++ b/SecretKey.hs @@ -12,12 +12,9 @@ import qualified Data.ByteString as B import System.IO import System.Posix.IO -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) +getSecretKey :: SecretKeySource -> IO SecretKey +getSecretKey (GpgKey kid) = Gpg.getSecretKey kid +getSecretKey (KeyFile f) = SecretKey <$> B.readFile f -- | Can throw exception if the secret key already exists. writeSecretKey :: Distinguisher -> SecretKey -> IO () @@ -65,7 +65,7 @@ dispatch cmdline ui tunables possibletunables = do where go CmdLine.Backup (Just secretkeysource) = backup cmdline ui tunables (Distinguisher secretkeysource) - =<< getSecretKey secretkeysource + secretkeysource go CmdLine.Restore (Just secretkeydest) = restore cmdline ui possibletunables (Distinguisher secretkeydest) go CmdLine.Backup Nothing = @@ -97,8 +97,8 @@ dispatch cmdline ui tunables possibletunables = do go CmdLine.Test _ = runTests -backup :: CmdLine.CmdLine -> UI -> Tunables -> Distinguisher -> (SecretKeySource, SecretKey) -> IO () -backup cmdline ui tunables distinguisher (secretkeysource, secretkey) = do +backup :: CmdLine.CmdLine -> UI -> Tunables -> Distinguisher -> SecretKeySource -> IO () +backup cmdline ui tunables distinguisher secretkeysource = do installAutoStartFile let m = totalObjects (shareParams tunables) @@ -122,9 +122,9 @@ backup cmdline ui tunables distinguisher (secretkeysource, secretkey) = do Nothing -> fromMaybe (error "Aborting on no username") <$> promptName ui "Enter your name" usernamedesc (Just username) validateName - go theirname locs + go theirname locs Nothing where - go theirname locs = do + go theirname locs msecretkey = do cores <- fromMaybe 1 <$> getNumCores Name othername <- case CmdLine.name cmdline of Just n -> pure n @@ -135,6 +135,9 @@ backup cmdline ui tunables distinguisher (secretkeysource, secretkey) = do (kek, passwordentropy) <- promptpassword name let sis = shareIdents tunables name distinguisher let cost = getCreationCost kek <> getCreationCost sis + secretkey <- case msecretkey of + Just sk -> pure sk + Nothing -> getSecretKey secretkeysource (r, queued, usedlocs) <- withProgressIncremental ui "Encrypting and storing data" (encryptdesc cost cores) $ \addpercent -> do let esk = encrypt tunables kek secretkey @@ -159,7 +162,7 @@ backup cmdline ui tunables distinguisher (secretkeysource, secretkey) = do [ "Another secret key is already being stored under the name you entered." , "Please try again with a different name." ] - go theirname locs + go theirname locs (Just secretkey) promptpassword name = do password <- fromMaybe (error "Aborting on no password") <$> promptPassword ui True "Enter password" passworddesc @@ -427,7 +430,7 @@ autoStart cmdline tunables ui = do "Do you want to back up the gpg secret key now?" if ans then backup cmdline ui tunables AnyGpgKey - =<< getSecretKey (GpgKey kid) + (GpgKey kid) else storeBackupLog =<< mkBackupLog (BackupSkipped (GpgKey kid)) |