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.

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 <id@joeyh.name>  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