diff options
| -rw-r--r-- | CmdLine.hs | 14 | ||||
| -rw-r--r-- | Storage.hs | 15 | ||||
| -rw-r--r-- | Storage/Local.hs (renamed from Storage/LocalFiles.hs) | 6 | ||||
| -rw-r--r-- | Storage/Network.hs | 33 | ||||
| -rw-r--r-- | TODO | 1 | ||||
| -rw-r--r-- | keysafe.cabal | 3 | ||||
| -rw-r--r-- | keysafe.hs | 66 |
7 files changed, 93 insertions, 45 deletions
@@ -10,14 +10,17 @@ import qualified Gpg import Options.Applicative import qualified Data.ByteString.UTF8 as BU8 import System.Directory +import Storage +import Storage.Local +import Storage.Network data CmdLine = CmdLine { mode :: Maybe Mode , secretkeysource :: Maybe SecretKeySource - , testMode :: Bool + , storage :: Storage , gui :: Bool + , testMode :: Bool } - deriving (Show) data Mode = Backup | Restore | Benchmark deriving (Show) @@ -26,8 +29,9 @@ parse :: Parser CmdLine parse = CmdLine <$> optional (backup <|> restore <|> benchmark) <*> optional (gpgswitch <|> fileswitch) - <*> testmodeswitch + <*> localstorageflag <*> guiswitch + <*> testmodeswitch where backup = flag' Backup ( long "backup" @@ -49,6 +53,10 @@ parse = CmdLine ( long "keyfile" <> help "Specify secret key file to back up or restore. (The same filename must be used to restore a key as was used to back it up.)" ) + localstorageflag = flag networkStorage localStorage + ( long "store-local" + <> help "Store data locally, in ~/.keysafe/objects. (The default is to store data in the cloud.)" + ) testmodeswitch = switch ( long "testmode" <> help "Avoid using expensive cryptographic operation to secure key. Use for testing only, not with real secret keys." @@ -6,6 +6,7 @@ module Storage where import Types +import Shard data Storage = Storage { storeShard :: StorableObjectIdent -> Shard -> IO StoreResult @@ -26,3 +27,17 @@ data ObscureResult = ObscureSuccess | ObscureFailure String data CountResult = CountResult Integer | CountFailure String deriving (Show) + +storeShards :: Storage -> ShardIdents -> [(IO (), Shard)] -> IO StoreResult +storeShards storage sis shards = do + r <- go (zip (getIdents sis) shards) + _ <- obscureShards storage + return r + where + go [] = return StoreSuccess + go ((i,(showprogress, s)):rest) = do + r <- storeShard storage i s + _ <- showprogress + case r of + StoreSuccess -> go rest + _ -> return r diff --git a/Storage/LocalFiles.hs b/Storage/Local.hs index ebcc492..93647df 100644 --- a/Storage/LocalFiles.hs +++ b/Storage/Local.hs @@ -5,7 +5,7 @@ {-# LANGUAGE OverloadedStrings #-} -module Storage.LocalFiles (localFiles) where +module Storage.Local (localStorage) where import Types import Storage @@ -23,8 +23,8 @@ import Raaz.Core.Encode import Control.DeepSeq import Control.Exception -localFiles :: Storage -localFiles = Storage +localStorage :: Storage +localStorage = Storage { storeShard = store , retrieveShard = retrieve , obscureShards = obscure diff --git a/Storage/Network.hs b/Storage/Network.hs new file mode 100644 index 0000000..06b7545 --- /dev/null +++ b/Storage/Network.hs @@ -0,0 +1,33 @@ +{- Copyright 2016 Joey Hess <id@joeyh.name> + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +{-# LANGUAGE OverloadedStrings #-} + +module Storage.Network (networkStorage) where + +import Types +import Storage + +networkStorage :: Storage +networkStorage = Storage + { storeShard = store + , retrieveShard = retrieve + , obscureShards = obscure + , countShards = count + } + +store :: StorableObjectIdent -> Shard -> IO StoreResult +store _i _s = return $ StoreFailure "network storage not implemented yet" + +retrieve :: ShardNum -> StorableObjectIdent -> IO RetrieveResult +retrieve _n _i = return $ RetrieveFailure "network storage not implemented yet" + +-- | Servers should automatically obscure, so do nothing. +-- (Could upload chaff.) +obscure :: IO ObscureResult +obscure = return ObscureSuccess + +count :: IO CountResult +count = return $ CountFailure "network storage not implemented yet" @@ -1,3 +1,4 @@ * splitting large secret keys * prompt for name that is less obviously connected to user * tune hashes on more powerful hardware than thermal throttling laptop +* store to servers diff --git a/keysafe.cabal b/keysafe.cabal index e690cf5..dd06d3a 100644 --- a/keysafe.cabal +++ b/keysafe.cabal @@ -64,7 +64,8 @@ Executable keysafe Serialization Shard Storage - Storage.LocalFiles + Storage.Local + Storage.Network Tunables Types Types.Cost @@ -17,7 +17,6 @@ import ExpensiveHash import Cost import Shard import Storage -import Storage.LocalFiles import qualified Gpg import Data.Maybe import Data.Time.Clock @@ -41,25 +40,30 @@ main = do "Keysafe is running in test mode. This is not secure, and should not be used with real secret keys!" return testModeTunables else return defaultTunables + dispatch cmdline ui tunables + +dispatch :: CmdLine.CmdLine -> UI -> Tunables -> IO () +dispatch cmdline ui tunables = do mode <- CmdLine.selectMode cmdline - go mode (CmdLine.secretkeysource cmdline) tunables ui + go mode (CmdLine.secretkeysource cmdline) where - go CmdLine.Backup (Just secretkeysource@(GpgKey kid)) tunables ui = do + storage = CmdLine.storage cmdline + go CmdLine.Backup (Just secretkeysource@(GpgKey kid)) = do ok <- Gpg.knownByKeyServer kid unless ok $ showError ui "Your gpg public key has to be stored on the keyservers before you can back it up by keyid. Either use gpg --send-key to store the public key on the keyservers, or omit the --gpgkeyid option" - backup ui tunables secretkeysource + backup storage ui tunables secretkeysource =<< getSecretKey secretkeysource - go CmdLine.Backup (Just secretkeysource) tunables ui = - backup ui tunables secretkeysource + go CmdLine.Backup (Just secretkeysource) = + backup storage ui tunables secretkeysource =<< getSecretKey secretkeysource - go CmdLine.Backup Nothing tunables ui = - backup ui tunables anyGpgKey =<< pickGpgKeyToBackup ui - go CmdLine.Restore (Just secretkeydest) _ ui = - restore ui secretkeydest - go CmdLine.Restore Nothing _ ui = - restore ui anyGpgKey - go CmdLine.Benchmark _ tunables _ = + go CmdLine.Backup Nothing = + backup storage ui tunables anyGpgKey =<< pickGpgKeyToBackup ui + go CmdLine.Restore (Just secretkeydest) = + restore storage ui secretkeydest + go CmdLine.Restore Nothing = + restore storage ui anyGpgKey + go CmdLine.Benchmark _ = benchmarkTunables tunables getSecretKey :: SecretKeySource -> IO SecretKey @@ -85,8 +89,8 @@ pickGpgKeyToBackup ui = go =<< Gpg.listSecretKeys anyGpgKey :: SecretKeySource anyGpgKey = GpgKey (KeyId "") -backup :: UI -> Tunables -> SecretKeySource -> SecretKey -> IO () -backup ui tunables secretkeysource secretkey = do +backup :: Storage -> UI -> Tunables -> SecretKeySource -> SecretKey -> IO () +backup storage ui tunables secretkeysource secretkey = do username <- userName name <- fromMaybe (error "Aborting on no name") <$> promptName ui "Enter name" @@ -102,7 +106,7 @@ backup ui tunables secretkeysource secretkey = do _ <- sis `deepseq` setpercent 50 let step = 50 `div` length shards let percentsteps = map setpercent [50+step, 50+step*2..100] - storeShards sis (zip percentsteps shards) + storeShards storage sis (zip percentsteps shards) case r of StoreSuccess -> showInfo ui "Success" "Your secret key successfully encrypted and backed up." StoreFailure s -> showError ui ("There was a problem storing your encrypted secret key: " ++ s) @@ -111,7 +115,7 @@ backup ui tunables secretkeysource secretkey = do [ "Another secret key is already being stored under the name you entered." , "Please try again with a different name." ] - backup ui tunables secretkeysource secretkey + backup storage ui tunables secretkeysource secretkey where promptkek name = do password <- fromMaybe (error "Aborting on no password") @@ -166,8 +170,8 @@ backup ui tunables secretkeysource secretkey = do , "Please wait..." ] -restore :: UI -> SecretKeySource -> IO () -restore ui secretkeydest = do +restore :: Storage -> UI -> SecretKeySource -> IO () +restore storage ui secretkeydest = do username <- userName name <- fromMaybe (error "Aborting on no name") <$> promptName ui "Enter name" @@ -176,7 +180,7 @@ restore ui secretkeydest = do <$> promptPassword ui True "Enter password" passworddesc let sis = shardIdents tunables name secretkeydest - shards <- catMaybes <$> downloadShards ui sis + shards <- catMaybes <$> downloadShards storage ui sis let candidatekeys = candidateKeyEncryptionKeys tunables name password let cost = getCreationCost candidatekeys <> castCost (getDecryptionCost candidatekeys) @@ -212,22 +216,8 @@ restore ui secretkeydest = do , "Please wait..." ] -storeShards :: ShardIdents -> [(IO (), Shard)] -> IO StoreResult -storeShards sis shards = do - r <- go (zip (getIdents sis) shards) - _ <- obscureShards localFiles - return r - where - go [] = return StoreSuccess - go ((i,(showprogress, s)):rest) = do - r <- storeShard localFiles i s - _ <- showprogress - case r of - StoreSuccess -> go rest - _ -> return r - -downloadShards :: UI -> ShardIdents -> IO [Maybe Shard] -downloadShards ui sis = bracket_ (return ()) cleanup +downloadShards :: Storage -> UI -> ShardIdents -> IO [Maybe Shard] +downloadShards storage ui sis = bracket_ (return ()) cleanup (withProgress ui "Downloading encrypted data" message go) where go setpercent = do @@ -239,7 +229,7 @@ downloadShards ui sis = bracket_ (return ()) cleanup let percentsteps = [50+step, 50+step*2..100] forM (zip percentsteps l) $ \(pct, (n, i)) -> do - r <- retrieveShard localFiles n i + r <- retrieveShard storage n i _ <- setpercent pct case r of RetrieveSuccess s -> do @@ -248,7 +238,7 @@ downloadShards ui sis = bracket_ (return ()) cleanup hPutStrLn stderr $ "warning: retrieval of shard " ++ show n ++ " failed: " ++ f return Nothing - cleanup = obscureShards localFiles + cleanup = obscureShards storage message = unlines [ "This will probably take around " ++ showCostMinutes (getCreationCost sis) |