diff options
Diffstat (limited to 'keysafe.hs')
| -rw-r--r-- | keysafe.hs | 75 |
1 files changed, 52 insertions, 23 deletions
@@ -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)) |