From 61ab8bd1f576e633a2eea4b63033c368a6645602 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 6 Oct 2016 14:38:59 -0400 Subject: New --add-storage-directory and --add-server options * 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. This commit was sponsored by Thomas Hochstein on Patreon. --- CHANGELOG | 3 +++ CmdLine.hs | 36 +++++++++++++++++++++++++++--------- HTTP/Client.hs | 1 - Storage.hs | 9 ++++----- Storage/Local.hs | 4 ++++ Storage/Network.hs | 8 ++++++++ TODO | 7 ------- Types/Server.hs | 2 +- keysafe.hs | 8 +++++++- 9 files changed, 54 insertions(+), 24 deletions(-) diff --git a/CHANGELOG b/CHANGELOG index b1184fd..fa535a9 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -1,6 +1,9 @@ keysafe (0.20160928) UNRELEASED; urgency=medium * Remove embedded copy of argon2 binding, depend on fixed version of package. + * 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. -- Joey Hess Wed, 05 Oct 2016 20:54:51 -0400 diff --git a/CmdLine.hs b/CmdLine.hs index 702c97d..ef593a2 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -7,26 +7,27 @@ module CmdLine where import Types import Types.Storage -import Types.Server (HostName) +import Types.Server (HostName, Port) import Types.Cost (Seconds(..)) +import Storage.Local +import Storage.Network import Tunables import qualified Gpg import Options.Applicative import qualified Data.ByteString.UTF8 as BU8 import qualified Data.Text as T import System.Directory -import Network.Wai.Handler.Warp (Port) data CmdLine = CmdLine { mode :: Maybe Mode , secretkeysource :: Maybe SecretKeySource - , localstorage :: Bool , localstoragedirectory :: Maybe LocalStorageDirectory , gui :: Bool , testMode :: Bool , customShareParams :: Maybe ShareParams , name :: Maybe Name , othername :: Maybe Name + , preferredStorage :: [Maybe LocalStorageDirectory -> Storage] , serverConfig :: ServerConfig , chaffMaxDelay :: Maybe Seconds } @@ -45,13 +46,13 @@ parse :: Parser CmdLine parse = CmdLine <$> optional parseMode <*> optional (gpgswitch <|> fileswitch) - <*> localstorageswitch <*> optional localstoragedirectoryopt <*> guiswitch <*> testmodeswitch <*> optional parseShareParams <*> optional nameopt <*> optional othernameopt + <*> many (addstoragedirectory <|> addserver) <*> parseServerConfig <*> optional chaffmaxdelayopt where @@ -65,14 +66,10 @@ parse = CmdLine <> metavar "FILE" <> 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.)" ) - localstorageswitch = switch - ( long "store-local" - <> help "Store data locally. (The default is to store data in the cloud.)" - ) localstoragedirectoryopt = LocalStorageDirectory <$> option str ( long "store-directory" <> metavar "DIR" - <> help "Where to store data locally. (default: ~/.keysafe/objects/)" + <> help "Where to store data locally. For the client, data is stored here before it is uploaded to the server. For the server, this is where it stores its data. (default: ~/.keysafe/objects/)" ) testmodeswitch = switch ( long "testmode" @@ -97,6 +94,18 @@ parse = CmdLine <> metavar "SECONDS" <> help "Specify a delay between chaff uploads. Will delay a random amount between 0 and this many seconds." ) + addstoragedirectory = (\d _lsd -> localStorageOverride d) + <$> strOption + ( long "add-storage-directory" + <> metavar "DIR" + <> help "Add the directory to the list of locations keysafe will use for backup/restore of keys. Keysafe will use the directory first, before any of its built-in servers." + ) + addserver = (\(h, p) lsd -> networkStorageOverride lsd h p) + <$> option hostPortOption + ( long "add-server" + <> metavar "HOST[:PORT]" + <> help "Add the server to the server list which keysafe will use for backup/restore of keys. Keysafe will use the server first before any of its built-in servers." + ) parseMode :: Parser Mode parseMode = @@ -226,3 +235,12 @@ secondsOption = Seconds . toRational <$> (auto :: ReadM Double) nameOption :: ReadM Name nameOption = Name . BU8.fromString <$> auto + +hostPortOption :: ReadM (HostName, Port) +hostPortOption = eitherReader $ \s -> + case break (== ':') s of + ([], []) -> Left "need a hostname" + (h, ':':ps) -> case reads ps of + [(p, "")] -> Right (h, p) + _ -> Left $ "unable to parse port \"" ++ ps ++ "\"" + (h, _) -> Right (h, 80) diff --git a/HTTP/Client.hs b/HTTP/Client.hs index 8415b2f..25ff536 100644 --- a/HTTP/Client.hs +++ b/HTTP/Client.hs @@ -14,7 +14,6 @@ import Types.Cost import Servant.API import Servant.Client import Data.Proxy -import Network.Wai.Handler.Warp (Port) import Network.HTTP.Client hiding (port, host, Proxy) import Network.HTTP.Client.Internal (Connection, makeConnection) import Control.Monad.Trans.Except (ExceptT, runExceptT) diff --git a/Storage.hs b/Storage.hs index de6eab3..428dc6f 100644 --- a/Storage.hs +++ b/Storage.hs @@ -25,12 +25,10 @@ import System.Random import Control.Concurrent.Thread.Delay import Control.Concurrent.Async import qualified Data.Set as S -import Network.Wai.Handler.Warp (Port) import System.Random.Shuffle -networkStorageLocations :: Maybe LocalStorageDirectory -> IO StorageLocations -networkStorageLocations = shuffleStorageLocations - . StorageLocations . serverList +networkStorageLocations :: Maybe LocalStorageDirectory -> StorageLocations +networkStorageLocations = StorageLocations . serverList type UpdateProgress = IO () @@ -155,7 +153,8 @@ retrieveShares (StorageLocations locs) sis updateprogress = do -- | Returns descriptions of any failures. tryUploadQueued :: Maybe LocalStorageDirectory -> IO [String] tryUploadQueued d = do - StorageLocations locs <- networkStorageLocations d + StorageLocations locs <- shuffleStorageLocations $ + networkStorageLocations d results <- forM locs $ \loc -> case uploadQueue loc of Nothing -> return [] Just q -> moveShares q loc diff --git a/Storage/Local.hs b/Storage/Local.hs index 6dcaaae..a79cc43 100644 --- a/Storage/Local.hs +++ b/Storage/Local.hs @@ -5,6 +5,7 @@ module Storage.Local ( localStorage + , localStorageOverride , storageDir , storageTopDir , testStorageDir @@ -49,6 +50,9 @@ localStorage storagelevel getsharedir n = Storage where section = Section n +localStorageOverride :: FilePath -> Storage +localStorageOverride d = localStorage LocallyPreferred (\_ -> pure d) "" + store :: Section -> GetShareDir -> StorableObjectIdent -> Share -> IO StoreResult store section getsharedir i s = onError (StoreFailure . show) $ do dir <- getsharedir section diff --git a/Storage/Network.hs b/Storage/Network.hs index e2004cc..9d54a1c 100644 --- a/Storage/Network.hs +++ b/Storage/Network.hs @@ -7,6 +7,7 @@ module Storage.Network ( networkStorage, + networkStorageOverride, ) where import Types @@ -32,6 +33,13 @@ networkStorage storagelevel localdir server = Storage where ServerName name = serverName server +networkStorageOverride :: Maybe LocalStorageDirectory -> HostName -> Port -> Storage +networkStorageOverride lsd h p = networkStorage LocallyPreferred lsd $ Server + { serverName = ServerName h + , serverAddress = [ServerAddress h p] + , serverDesc = h + } + store :: Server -> StorableObjectIdent -> Share -> IO StoreResult store srv i (Share _n o) = serverRequest srv StoreFailure id i $ \pow -> diff --git a/TODO b/TODO index 6348d07..44bbb00 100644 --- a/TODO +++ b/TODO @@ -15,13 +15,6 @@ Later: values were used for backup. Instead, try to download at least 2 shares, and run SS.decode. If it throws AssertionFailed, there were not enough shares, so get more shares and retry. -* It can be useful to upload 2 shares to keysafe servers, and store 2 - shares locally; with 3 shares needed to restore this prevents all - possible cracking attempts of the data on the servers, and if the local - data is compromised, the user will probably know, and has a long - time period before the password can be guessed to take steps. - Supporting this use case needs a way to redirect L shares to local - storage, with the other M-L going to servers as usual. * --no-jargon which makes the UI avoid terms like "secret key" and "crack password". Do usability testing! * --key-value=$N which eliminates the question about password value, diff --git a/Types/Server.hs b/Types/Server.hs index 9a2017d..6a3fe23 100644 --- a/Types/Server.hs +++ b/Types/Server.hs @@ -5,7 +5,7 @@ {-# LANGUAGE DeriveGeneric #-} -module Types.Server where +module Types.Server (module Types.Server, Port) where import Data.Aeson import GHC.Generics diff --git a/keysafe.hs b/keysafe.hs index 11f52dc..4c93251 100644 --- a/keysafe.hs +++ b/keysafe.hs @@ -360,7 +360,13 @@ userName = do return $ Name $ BU8.fromString $ takeWhile (/= ',') (userGecos u) cmdLineStorageLocations :: CmdLine.CmdLine -> IO StorageLocations -cmdLineStorageLocations = networkStorageLocations . CmdLine.localstoragedirectory +cmdLineStorageLocations cmdline = + shuffleStorageLocations (preflocs <> netlocs) + where + netlocs = networkStorageLocations lsd + preflocs = StorageLocations $ + map (\mk -> mk lsd) (CmdLine.preferredStorage cmdline) + lsd = CmdLine.localstoragedirectory cmdline getPasswordEntropy :: Password -> Name -> IO (Entropy UnknownPassword) getPasswordEntropy password name = do -- cgit v1.2.3