diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,16 @@ +keysafe (0.20161006) unstable; urgency=medium + + * 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. + * Fix bugs with entry of gpg keyid in the keysafe.log. + * Fix bug in --autostart that caused the full gpg keyid to be + used to generate object names, which made restores would only work + when --gpgkeyid was specifid. + * Remove embedded copy of argon2 binding, depend on fixed version of package. + + -- Joey Hess Wed, 05 Oct 2016 20:54:51 -0400 + keysafe (0.20160927) unstable; urgency=medium * Makefile: Avoid rebuilding on make install, so that sudo make install works. diff --git a/CmdLine.hs b/CmdLine.hs --- a/CmdLine.hs +++ b/CmdLine.hs @@ -7,26 +7,27 @@ 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 = 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 @@ <> 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 @@ <> 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 @@ 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/Crypto/Argon2.hs b/Crypto/Argon2.hs deleted file mode 100644 --- a/Crypto/Argon2.hs +++ /dev/null @@ -1,280 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE ForeignFunctionInterface #-} -{-# LANGUAGE RecordWildCards #-} - -{-| - -"Crypto.Argon2" provides bindings to the - of Argon2, -the password-hashing function that won the -. - -The main entry points to this module are 'hashEncoded', which produces a -crypt-like ASCII output; and 'hash' which produces a 'BS.ByteString' (a stream -of bytes). Argon2 is a configurable hash function, and can be configured by -supplying a particular set of 'HashOptions' - 'defaultHashOptions' should provide -a good starting point. See 'HashOptions' for more documentation on the particular -parameters that can be adjusted. - -For access directly to the C interface, see "Crypto.Argon2.FFI". - --} - -{- - -Copyright (c) 2016, Ollie Charles - -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - - * Redistributions in binary form must reproduce the above - copyright notice, this list of conditions and the following - disclaimer in the documentation and/or other materials provided - with the distribution. - - * Neither the name of Ollie Charles nor the names of other - contributors may be used to endorse or promote products derived - from this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - - -} - -module Crypto.Argon2 - ( -- * Computing hashes - hashEncoded, hash, - -- * Verification - verify, - -- * Configuring hashing - HashOptions(..), Argon2Variant(..), defaultHashOptions, - -- * Exceptions - Argon2Exception(..)) - where - -import GHC.Generics (Generic) -import Control.Exception -import Data.Typeable -import Foreign -import Foreign.C -import System.IO.Unsafe (unsafePerformIO) -import qualified Crypto.Argon2.FFI as FFI -import qualified Data.ByteString as BS -import qualified Data.Text as T -import qualified Data.Text.Encoding as T - --- | Which variant of Argon2 to use. You should choose the variant that is most --- applicable to your intention to hash inputs. -data Argon2Variant - = Argon2i -- ^ Argon2i uses data-independent memory access, which is preferred - -- for password hashing and password-based key derivation. Argon2i - -- is slower as it makes more passes over the memory to protect from - -- tradeoff attacks. - | Argon2d -- ^ Argon2d is faster and uses data-depending memory access, which - -- makes it suitable for cryptocurrencies and applications with no - -- threats from side-channel timing attacks. - deriving (Eq,Ord,Read,Show,Bounded,Generic,Typeable,Enum) - --- | Parameters that can be adjusted to change the runtime performance of the --- hashing. -data HashOptions = - HashOptions {hashIterations :: !Word32 -- ^ The time cost, which defines the amount of computation realized and therefore the execution time, given in number of iterations. - -- - -- 'FFI.ARGON2_MIN_TIME' <= 'hashIterations' <= 'FFI.ARGON2_MAX_TIME' - ,hashMemory :: !Word32 -- ^ The memory cost, which defines the memory usage, given in kibibytes. - -- - -- max 'FFI.ARGON2_MIN_MEMORY' (8 * 'hashParallelism') <= 'hashMemory' <= 'FFI.ARGON2_MAX_MEMORY' - ,hashParallelism :: !Word32 -- ^ A parallelism degree, which defines the number of parallel threads. - -- - -- 'FFI.ARGON2_MIN_LANES' <= 'hashParallelism' <= 'FFI.ARGON2_MAX_LANES' && 'FFI.ARGON_MIN_THREADS' <= 'hashParallelism' <= 'FFI.ARGON2_MAX_THREADS' - ,hashVariant :: !Argon2Variant -- ^ Which version of Argon2 to use. - } - deriving (Eq,Ord,Read,Show,Bounded,Generic,Typeable) - --- | A set of default 'HashOptions', taken from the @argon2@ executable. --- --- @ --- 'defaultHashOptions' :: 'HashOptions' --- 'defaultHashOptions' = --- 'HashOptions' {'hashIterations' = 1 --- ,'hashMemory' = 2 ^ 17 --- ,'hashParallelism' = 4 --- ,'hashVariant' = 'Argon2i'} --- @ -defaultHashOptions :: HashOptions -defaultHashOptions = - HashOptions {hashIterations = 1 - ,hashMemory = 2 ^ (17 :: Integer) - ,hashParallelism = 4 - ,hashVariant = Argon2i} - --- | Encode a password with a given salt and 'HashOptions' and produce a textual --- encoding of the result. -hashEncoded :: HashOptions -- ^ Options pertaining to how expensive the hash is to calculate. - -> BS.ByteString -- ^ The password to hash. Must be less than 4294967295 bytes. - -> BS.ByteString -- ^ The salt to use when hashing. Must be less than 4294967295 bytes. - -> T.Text -- ^ The encoded password hash. -hashEncoded options password salt = - unsafePerformIO - (hashEncoded' options password salt FFI.argon2i_hash_encoded FFI.argon2d_hash_encoded) - --- | Encode a password with a given salt and 'HashOptions' and produce a stream --- of bytes. -hash :: HashOptions -- ^ Options pertaining to how expensive the hash is to calculate. - -> BS.ByteString -- ^ The password to hash. Must be less than 4294967295 bytes. - -> BS.ByteString -- ^ The salt to use when hashing. Must be less than 4294967295 bytes. - -> BS.ByteString -- ^ The un-encoded password hash. -hash options password salt = - unsafePerformIO (hash' options password salt FFI.argon2i_hash_raw FFI.argon2d_hash_raw) - -variant :: a -> a -> Argon2Variant -> a -variant a _ Argon2i = a -variant _ b Argon2d = b -{-# INLINE variant #-} - --- | Not all 'HashOptions' can necessarily be used to compute hashes. If you --- supply invalid 'HashOptions' (or hashing otherwise fails) a 'Argon2Exception' --- will be throw. -data Argon2Exception - = -- | The length of the supplied password is outside the range supported by @libargon2@. - Argon2PasswordLengthOutOfRange !CSize -- ^ The erroneous length. - | -- | The length of the supplied salt is outside the range supported by @libargon2@. - Argon2SaltLengthOutOfRange !CSize -- ^ The erroneous length. - | -- | Either too much or too little memory was requested via 'hashMemory'. - Argon2MemoryUseOutOfRange !Word32 -- ^ The erroneous 'hashMemory' value. - | -- | Either too few or too many iterations were requested via 'hashIterations'. - Argon2IterationCountOutOfRange !Word32 -- ^ The erroneous 'hashIterations' value. - | -- | Either too much or too little parallelism was requested via 'hasParallelism'. - Argon2ParallelismOutOfRange !Word32 -- ^ The erroneous 'hashParallelism' value. - | -- | An unexpected exception was throw. Please ! - Argon2Exception !Int32 -- ^ The =libargon2= error code. - deriving (Typeable, Show) - -instance Exception Argon2Exception - -type Argon2Encoded = Word32 -> Word32 -> Word32 -> CString -> CSize -> CString -> CSize -> CSize -> CString -> CSize -> IO Int32 - -hashEncoded' :: HashOptions - -> BS.ByteString - -> BS.ByteString - -> Argon2Encoded - -> Argon2Encoded - -> IO T.Text -hashEncoded' options@HashOptions{..} password salt argon2i argon2d = - do let saltLen = fromIntegral (BS.length salt) - passwordLen = fromIntegral (BS.length password) - outLen = - (BS.length salt * 4 + 32 * 4 + - length ("$argon2x$m=,t=,p=$$" :: String) + - 3 * 3) - out <- mallocBytes outLen - res <- - BS.useAsCString password $ - \password' -> - BS.useAsCString salt $ - \salt' -> - argon2 hashIterations - hashMemory - hashParallelism - password' - passwordLen - salt' - saltLen - 64 - out - (fromIntegral outLen) - handleSuccessCode res options password salt - fmap T.decodeUtf8 (BS.packCString out) - where argon2 = variant argon2i argon2d hashVariant - -type Argon2Unencoded = Word32 -> Word32 -> Word32 -> CString -> CSize -> CString -> CSize -> CString -> CSize -> IO Int32 - -hash' :: HashOptions - -> BS.ByteString - -> BS.ByteString - -> Argon2Unencoded - -> Argon2Unencoded - -> IO BS.ByteString -hash' options@HashOptions{..} password salt argon2i argon2d = - do let saltLen = fromIntegral (BS.length salt) - passwordLen = fromIntegral (BS.length password) - outLen = 512 - out <- mallocBytes outLen - res <- - BS.useAsCString password $ - \password' -> - BS.useAsCString salt $ - \salt' -> - argon2 hashIterations - hashMemory - hashParallelism - password' - passwordLen - salt' - saltLen - out - (fromIntegral outLen) - handleSuccessCode res options password salt - BS.packCString out - where argon2 = variant argon2i argon2d hashVariant - -handleSuccessCode :: Int32 - -> HashOptions - -> BS.ByteString - -> BS.ByteString - -> IO () -handleSuccessCode res HashOptions{..} password salt = - let saltLen = fromIntegral (BS.length salt) - passwordLen = fromIntegral (BS.length password) - in case res of - a - | a `elem` [FFI.ARGON2_OK] -> return () - | a `elem` [FFI.ARGON2_SALT_TOO_SHORT,FFI.ARGON2_SALT_TOO_LONG] -> - throwIO (Argon2SaltLengthOutOfRange saltLen) - | a `elem` [FFI.ARGON2_PWD_TOO_SHORT,FFI.ARGON2_PWD_TOO_LONG] -> - throwIO (Argon2PasswordLengthOutOfRange passwordLen) - | a `elem` [FFI.ARGON2_TIME_TOO_SMALL,FFI.ARGON2_TIME_TOO_LARGE] -> - throwIO (Argon2IterationCountOutOfRange hashIterations) - | a `elem` [FFI.ARGON2_MEMORY_TOO_LITTLE,FFI.ARGON2_MEMORY_TOO_MUCH] -> - throwIO (Argon2MemoryUseOutOfRange hashMemory) - | a `elem` - [FFI.ARGON2_LANES_TOO_FEW - ,FFI.ARGON2_LANES_TOO_MANY - ,FFI.ARGON2_THREADS_TOO_FEW - ,FFI.ARGON2_THREADS_TOO_MANY] -> - throwIO (Argon2ParallelismOutOfRange hashParallelism) - | otherwise -> throwIO (Argon2Exception a) - --- | Verify that a given password could result in a given hash output. --- Automatically determines the correct 'HashOptions' based on the --- encoded hash (as produced by 'hashEncoded'). -verify - :: T.Text -> BS.ByteString -> Bool -verify encoded password = - unsafePerformIO - (BS.useAsCString password $ - \pwd -> - BS.useAsCString (T.encodeUtf8 encoded) $ - \enc -> - do res <- - (variant FFI.argon2i_verify FFI.argon2d_verify v) enc - pwd - (fromIntegral (BS.length password)) - return (res == FFI.ARGON2_OK)) - where v | T.pack "$argon2i" `T.isPrefixOf` encoded = Argon2i - | otherwise = Argon2d diff --git a/Crypto/Argon2/FFI.hsc b/Crypto/Argon2/FFI.hsc deleted file mode 100644 --- a/Crypto/Argon2/FFI.hsc +++ /dev/null @@ -1,127 +0,0 @@ -{-# LANGUAGE ForeignFunctionInterface #-} -{-# LANGUAGE PatternSynonyms #-} - -module Crypto.Argon2.FFI where - -#include -#include - -{- - -Copyright (c) 2016, Ollie Charles - -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - - * Redistributions in binary form must reproduce the above - copyright notice, this list of conditions and the following - disclaimer in the documentation and/or other materials provided - with the distribution. - - * Neither the name of Ollie Charles nor the names of other - contributors may be used to endorse or promote products derived - from this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - - -} - -import Foreign -import Foreign.C - -foreign import ccall unsafe "argon2.h argon2i_hash_encoded" argon2i_hash_encoded :: (#type const uint32_t) -> (#type const uint32_t) -> (#type const uint32_t) -> Ptr a -> CSize -> Ptr b -> CSize -> CSize -> CString -> CSize -> IO (#type int) - -foreign import ccall unsafe "argon2.h argon2i_hash_raw" argon2i_hash_raw :: (#type const uint32_t) -> (#type const uint32_t) -> (#type const uint32_t) -> Ptr a -> CSize -> Ptr b -> CSize -> Ptr c -> CSize -> IO (#type int) - -foreign import ccall unsafe "argon2.h argon2d_hash_encoded" argon2d_hash_encoded :: (#type const uint32_t) -> (#type const uint32_t) -> (#type const uint32_t) -> Ptr a -> CSize -> Ptr b -> CSize -> CSize -> CString -> CSize -> IO (#type int) - -foreign import ccall unsafe "argon2.h argon2d_hash_raw" argon2d_hash_raw :: (#type const uint32_t) -> (#type const uint32_t) -> (#type const uint32_t) -> Ptr a -> CSize -> Ptr b -> CSize -> Ptr c -> CSize -> IO (#type int) - -foreign import ccall unsafe "argon2.h argon2i_verify" argon2i_verify :: CString -> Ptr a -> CSize -> IO (#type int) - -foreign import ccall unsafe "argon2.h argon2d_verify" argon2d_verify :: CString -> Ptr a -> CSize -> IO (#type int) - -pattern ARGON2_OK = (#const ARGON2_OK) -pattern ARGON2_OUTPUT_PTR_NULL = (#const ARGON2_OUTPUT_PTR_NULL) -pattern ARGON2_OUTPUT_TOO_SHORT = (#const ARGON2_OUTPUT_TOO_SHORT) -pattern ARGON2_OUTPUT_TOO_LONG = (#const ARGON2_OUTPUT_TOO_LONG) -pattern ARGON2_PWD_TOO_SHORT = (#const ARGON2_PWD_TOO_SHORT) -pattern ARGON2_PWD_TOO_LONG = (#const ARGON2_PWD_TOO_LONG) -pattern ARGON2_SALT_TOO_SHORT = (#const ARGON2_SALT_TOO_SHORT) -pattern ARGON2_SALT_TOO_LONG = (#const ARGON2_SALT_TOO_LONG) -pattern ARGON2_AD_TOO_SHORT = (#const ARGON2_AD_TOO_SHORT) -pattern ARGON2_AD_TOO_LONG = (#const ARGON2_AD_TOO_LONG) -pattern ARGON2_SECRET_TOO_SHORT = (#const ARGON2_SECRET_TOO_SHORT) -pattern ARGON2_SECRET_TOO_LONG = (#const ARGON2_SECRET_TOO_LONG) -pattern ARGON2_TIME_TOO_SMALL = (#const ARGON2_TIME_TOO_SMALL) -pattern ARGON2_TIME_TOO_LARGE = (#const ARGON2_TIME_TOO_LARGE) -pattern ARGON2_MEMORY_TOO_LITTLE = (#const ARGON2_MEMORY_TOO_LITTLE) -pattern ARGON2_MEMORY_TOO_MUCH = (#const ARGON2_MEMORY_TOO_MUCH) -pattern ARGON2_LANES_TOO_FEW = (#const ARGON2_LANES_TOO_FEW) -pattern ARGON2_LANES_TOO_MANY = (#const ARGON2_LANES_TOO_MANY) -pattern ARGON2_PWD_PTR_MISMATCH = (#const ARGON2_PWD_PTR_MISMATCH) -pattern ARGON2_SALT_PTR_MISMATCH = (#const ARGON2_SALT_PTR_MISMATCH) -pattern ARGON2_SECRET_PTR_MISMATCH = (#const ARGON2_SECRET_PTR_MISMATCH) -pattern ARGON2_AD_PTR_MISMATCH = (#const ARGON2_AD_PTR_MISMATCH) -pattern ARGON2_MEMORY_ALLOCATION_ERROR = (#const ARGON2_MEMORY_ALLOCATION_ERROR) -pattern ARGON2_FREE_MEMORY_CBK_NULL = (#const ARGON2_FREE_MEMORY_CBK_NULL) -pattern ARGON2_ALLOCATE_MEMORY_CBK_NULL = (#const ARGON2_ALLOCATE_MEMORY_CBK_NULL) -pattern ARGON2_INCORRECT_PARAMETER = (#const ARGON2_INCORRECT_PARAMETER) -pattern ARGON2_INCORRECT_TYPE = (#const ARGON2_INCORRECT_TYPE) -pattern ARGON2_OUT_PTR_MISMATCH = (#const ARGON2_OUT_PTR_MISMATCH) -pattern ARGON2_THREADS_TOO_FEW = (#const ARGON2_THREADS_TOO_FEW) -pattern ARGON2_THREADS_TOO_MANY = (#const ARGON2_THREADS_TOO_MANY) -pattern ARGON2_MISSING_ARGS = (#const ARGON2_MISSING_ARGS) -pattern ARGON2_ENCODING_FAIL = (#const ARGON2_ENCODING_FAIL) -pattern ARGON2_DECODING_FAIL = (#const ARGON2_DECODING_FAIL) - -pattern ARGON2_MIN_LANES = (#const ARGON2_MIN_LANES) -pattern ARGON2_MAX_LANES = (#const ARGON2_MAX_LANES) - -pattern ARGON2_MIN_THREADS = (#const ARGON2_MIN_THREADS) -pattern ARGON2_MAX_THREADS = (#const ARGON2_MAX_THREADS) - -pattern ARGON2_SYNC_POINTS = (#const ARGON2_SYNC_POINTS) - -pattern ARGON2_MIN_OUTLEN = (#const ARGON2_MIN_OUTLEN) -pattern ARGON2_MAX_OUTLEN = (#const ARGON2_MAX_OUTLEN) - -pattern ARGON2_MIN_MEMORY = (#const ARGON2_MIN_MEMORY) - -pattern ARGON2_MAX_MEMORY_BITS = (#const ARGON2_MAX_MEMORY_BITS) -pattern ARGON2_MAX_MEMORY = (#const ARGON2_MAX_MEMORY) - -pattern ARGON2_MIN_TIME = (#const ARGON2_MIN_TIME) -pattern ARGON2_MAX_TIME = (#const ARGON2_MAX_TIME) - -pattern ARGON2_MIN_PWD_LENGTH = (#const ARGON2_MIN_PWD_LENGTH) -pattern ARGON2_MAX_PWD_LENGTH = (#const ARGON2_MAX_PWD_LENGTH) - -pattern ARGON2_MIN_AD_LENGTH = (#const ARGON2_MIN_AD_LENGTH) -pattern ARGON2_MAX_AD_LENGTH = (#const ARGON2_MAX_AD_LENGTH) - -pattern ARGON2_MIN_SALT_LENGTH = (#const ARGON2_MIN_SALT_LENGTH) -pattern ARGON2_MAX_SALT_LENGTH = (#const ARGON2_MAX_SALT_LENGTH) - -pattern ARGON2_MIN_SECRET = (#const ARGON2_MIN_SECRET) -pattern ARGON2_MAX_SECRET = (#const ARGON2_MAX_SECRET) - -pattern ARGON2_FLAG_CLEAR_PASSWORD = (#const ARGON2_FLAG_CLEAR_PASSWORD) -pattern ARGON2_FLAG_CLEAR_SECRET = (#const ARGON2_FLAG_CLEAR_SECRET) -pattern ARGON2_FLAG_CLEAR_MEMORY = (#const ARGON2_FLAG_CLEAR_MEMORY) -pattern ARGON2_DEFAULT_FLAGS = (#const ARGON2_DEFAULT_FLAGS) diff --git a/Gpg.hs b/Gpg.hs --- a/Gpg.hs +++ b/Gpg.hs @@ -21,20 +21,19 @@ -- -- If there is only one gpg secret key, -- the choice is obvious. Otherwise prompt the user with a list. -getKeyToBackup :: UI -> IO SecretKey +getKeyToBackup :: UI -> IO (SecretKeySource, SecretKey) 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)] = getSecretKey kid - go l = maybe (error "Canceled") getSecretKey + go [(_, kid)] = mkret kid + go l = maybe (error "Canceled") mkret =<< promptKeyId ui "Pick gpg secret key" "Pick gpg secret key to back up:" l - --- | Use when the gpg keyid will not be known at restore time. -anyKey :: SecretKeySource -anyKey = GpgKey (KeyId "") + mkret kid = do + sk <- getSecretKey kid + return (GpgKey kid, sk) listSecretKeys :: IO [(Name, KeyId)] listSecretKeys = map mk . parse . lines <$> readProcess "gpg" diff --git a/HTTP/Client.hs b/HTTP/Client.hs --- a/HTTP/Client.hs +++ b/HTTP/Client.hs @@ -9,13 +9,11 @@ import HTTP.ProofOfWork import Types import Types.Server -import Servers import Types.Storage 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) @@ -111,3 +109,8 @@ (recv socket chunksize) (sendAll socket) (Network.Socket.close socket) + +serverUrls :: Server -> [BaseUrl] +serverUrls srv = map go (serverAddress srv) + where + go (ServerAddress addr port) = BaseUrl Http addr port "" diff --git a/HTTP/Server.hs b/HTTP/Server.hs --- a/HTTP/Server.hs +++ b/HTTP/Server.hs @@ -56,7 +56,7 @@ host = fromString (serverAddress cfg) serverStorage :: Maybe LocalStorageDirectory -> Storage -serverStorage d = localStorage (storageDir d) "server" +serverStorage d = localStorage LocallyPreferred (storageDir d) "server" app :: ServerState -> Application app st = serve userAPI (server st) diff --git a/SecretKey.hs b/SecretKey.hs --- a/SecretKey.hs +++ b/SecretKey.hs @@ -6,19 +6,24 @@ module SecretKey where import Types +import Share import qualified Gpg import qualified Data.ByteString as B import System.IO import System.Posix.IO -getSecretKey :: SecretKeySource -> IO SecretKey -getSecretKey (GpgKey kid) = Gpg.getSecretKey kid -getSecretKey (KeyFile f) = SecretKey <$> B.readFile f +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) -- | Can throw exception if the secret key already exists. -writeSecretKey :: SecretKeySource -> SecretKey -> IO () -writeSecretKey (GpgKey _) secretkey = Gpg.writeSecretKey secretkey -writeSecretKey (KeyFile f) (SecretKey b) = do +writeSecretKey :: Distinguisher -> SecretKey -> IO () +writeSecretKey (Distinguisher (GpgKey _)) secretkey = Gpg.writeSecretKey secretkey +writeSecretKey AnyGpgKey secretkey = Gpg.writeSecretKey secretkey +writeSecretKey (Distinguisher (KeyFile f)) (SecretKey b) = do fd <- openFd f WriteOnly (Just 0o666) (defaultFileFlags { exclusive = True } ) h <- fdToHandle fd diff --git a/Servers.hs b/Servers.hs --- a/Servers.hs +++ b/Servers.hs @@ -6,8 +6,8 @@ module Servers where import Types.Server -import Servant.Client -import System.Random.Shuffle +import Types.Storage +import Storage.Network -- | Keysafe's server list. -- @@ -17,29 +17,20 @@ -- -- Also, avoid changing the ServerName of any server, as that will -- cause any uploads queued under that name to not go through. -networkServers :: [Server] -networkServers = - [ Server (ServerName "keysafe.joeyh.name") Alternate +serverList :: Maybe LocalStorageDirectory -> [Storage] +serverList d = + [ mk Alternate $ Server (ServerName "keysafe.joeyh.name") [ServerAddress "vzgrspuxbtnlrtup.onion" 4242] "Provided by Joey Hess. Digital Ocean VPS, located in Indonesia" - , Server (ServerName "keysafe.puri.sm") Alternate + , mk Alternate $ Server (ServerName "keysafe.puri.sm") [] "Purism server is not yet deployed, but planned." - , Server (ServerName "thirdserver") Alternate -- still being vetted + -- still being vetted + , mk Alternate $ Server (ServerName "thirdserver") [ServerAddress "eqi7glyxe5ravak5.onion" 4242] "Provided by Marek Isalski at Faelix. Currently located in UK, but planned move to CH" ] - --- | Shuffles the server list, keeping Recommended first, then --- Alternate, and finally Untrusted. -shuffleServers :: [Server] -> IO [Server] -shuffleServers l = concat <$> mapM shuf [minBound..maxBound] where - shuf sl = shuffleM (filter (\s -> serverLevel s == sl) l) - -serverUrls :: Server -> [BaseUrl] -serverUrls srv = map go (serverAddress srv) - where - go (ServerAddress addr port) = BaseUrl Http addr port "" + mk l s = networkStorage l d s diff --git a/Share.hs b/Share.hs --- a/Share.hs +++ b/Share.hs @@ -41,18 +41,28 @@ instance Bruteforceable ShareIdents UnknownName where getBruteCostCalc = identsBruteForceCalc +data Distinguisher + = Distinguisher SecretKeySource + | AnyGpgKey + -- ^ Use to avoid the gpg keyid needing to be provided + -- at restore time. + deriving (Eq) + -- | Generates identifiers to use for storing shares. -- -- This is an expensive operation, to make it difficult for an attacker -- to brute force known/guessed names and find matching shares. -- The keyid or filename is used as a salt, to avoid collisions -- when the same name is chosen for multiple keys. -shareIdents :: Tunables -> Name -> SecretKeySource -> ShareIdents -shareIdents tunables (Name name) keyid = +shareIdents :: Tunables -> Name -> Distinguisher -> ShareIdents +shareIdents tunables (Name name) shareident = ShareIdents (segmentbyshare idents) creationcost bruteforcecalc where (ExpensiveHash creationcost basename) = - expensiveHash hashtunables (Salt keyid) name + expensiveHash hashtunables salt name + salt = case shareident of + Distinguisher sks -> Salt sks + AnyGpgKey -> Salt (GpgKey (KeyId "")) mk n = StorableObjectIdent $ Raaz.toByteString $ mksha $ E.encodeUtf8 $ basename <> T.pack (show n) mksha :: B.ByteString -> Raaz.Base16 diff --git a/Storage.hs b/Storage.hs --- a/Storage.hs +++ b/Storage.hs @@ -13,30 +13,22 @@ import Types.Cost import Output import Share -import Storage.Local import Storage.Network import Servers import Tunables import Data.Maybe import Data.List import Data.Monoid -import System.FilePath import Control.Monad import Crypto.Random import System.Random import Control.Concurrent.Thread.Delay import Control.Concurrent.Async import qualified Data.Set as S -import Network.Wai.Handler.Warp (Port) - -networkStorageLocations :: Maybe LocalStorageDirectory -> IO StorageLocations -networkStorageLocations d = StorageLocations . map (networkStorage d) - <$> shuffleServers networkServers +import System.Random.Shuffle -localStorageLocations :: Maybe LocalStorageDirectory -> StorageLocations -localStorageLocations d = StorageLocations $ - map (localStorage (storageDir d) . ("local" ) . show) - [1..100 :: Int] +networkStorageLocations :: Maybe LocalStorageDirectory -> StorageLocations +networkStorageLocations = StorageLocations . serverList type UpdateProgress = IO () @@ -67,12 +59,11 @@ , "If you continue, some of the following less secure" , "servers will be used:" , "" - ] ++ map descserver alternates + ] ++ map descserver (mapMaybe getServer alternates) | otherwise = Nothing where ps = shareParams tunables - getlevel sl = filter (\s -> serverLevel s == sl) $ - mapMaybe getServer locs + getlevel sl = filter (\s -> storageLevel s == sl) locs alternates = getlevel Alternate descserver (Server { serverName = ServerName n, serverDesc = d}) = "* " ++ n ++ " -- " ++ d @@ -162,7 +153,8 @@ -- | 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 @@ -184,12 +176,12 @@ -- the randomname is not something that can be feasibly guessed. -- Prefix "random chaff" to the name to avoid ever using a name -- that a real user might want to use. - let sis = shareIdents testModeTunables (Name $ "random chaff:" <> randomname) (KeyFile "random") + let sis = shareIdents testModeTunables (Name $ "random chaff:" <> randomname) AnyGpgKey mapConcurrently (go sis rng') [1..totalObjects (shareParams testModeTunables)] where - server = networkStorage Nothing $ - Server (ServerName hn) Untrusted [ServerAddress hn port] "chaff server" + server = networkStorage Untrusted Nothing $ + Server (ServerName hn) [ServerAddress hn port] "chaff server" objsize = objectSize defaultTunables * shareOverhead defaultTunables maxmsdelay = ceiling $ 1000000 * fromMaybe 0 delayseconds go sis rng n = do @@ -205,3 +197,11 @@ StoreSuccess -> progress "+" _ -> progress "!" go sis' rng' n + +-- | Shuffles the list, keeping Recommended first, then +-- Alternate, and finally Untrusted. +shuffleStorageLocations :: StorageLocations -> IO StorageLocations +shuffleStorageLocations (StorageLocations l) = + StorageLocations . concat <$> mapM shuf [minBound..maxBound] + where + shuf sl = shuffleM (filter (\s -> storageLevel s == sl) l) diff --git a/Storage/Local.hs b/Storage/Local.hs --- a/Storage/Local.hs +++ b/Storage/Local.hs @@ -5,6 +5,7 @@ module Storage.Local ( localStorage + , localStorageOverride , storageDir , storageTopDir , testStorageDir @@ -35,18 +36,22 @@ newtype Section = Section String -localStorage :: GetShareDir -> String -> Storage -localStorage getsharedir n = Storage +localStorage :: StorageLevel -> GetShareDir -> String -> Storage +localStorage storagelevel getsharedir n = Storage { storeShare = store section getsharedir , retrieveShare = retrieve section getsharedir , obscureShares = obscure section getsharedir , countShares = count section getsharedir , moveShares = move section getsharedir + , storageLevel = storagelevel , uploadQueue = Nothing , getServer = Nothing } 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 diff --git a/Storage/Network.hs b/Storage/Network.hs --- a/Storage/Network.hs +++ b/Storage/Network.hs @@ -7,6 +7,7 @@ module Storage.Network ( networkStorage, + networkStorageOverride, ) where import Types @@ -17,19 +18,27 @@ import HTTP.ProofOfWork import System.FilePath -networkStorage :: Maybe LocalStorageDirectory -> Server -> Storage -networkStorage localdir server = Storage +networkStorage :: StorageLevel -> Maybe LocalStorageDirectory -> Server -> Storage +networkStorage storagelevel localdir server = Storage { storeShare = store server , retrieveShare = retrieve server , obscureShares = obscure server , countShares = count server , moveShares = move server - , uploadQueue = Just $ localStorage (storageDir localdir) + , uploadQueue = Just $ localStorage storagelevel (storageDir localdir) ("uploadqueue" name) + , storageLevel = storagelevel , getServer = Just server } 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) = diff --git a/TODO b/TODO --- a/TODO +++ b/TODO @@ -11,9 +11,6 @@ * improve restore progress bar points (update after every hash try) * If we retrieved enough shares successfully, but decrypt failed, must be a wrong password, so prompt for re-entry and retry with those shares. -* Don't require --totalshares and --neededshares on restore when unusual - values were used for backup. Instead, probe until enough shares are found - to restore. * --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, @@ -33,3 +30,13 @@ (Raaz makes this possible to do.) Would be nice, but not super-important, since gpg secret keys are passphrase protected anyway.. +* Don't require --totalshares and --neededshares on restore when unusual + values were used for backup. + The difficulty is that the number of needed shares cannot be determined by + looking at shares, and guessing it wrong will result in combining + too few shares yielding garbage, which it will take up to an hour to + try to decrypt, before it can tell that more shares are needed. + This could be dealt with by including the number of needed shares in the + serialization of Share, but then an attacker could use it to partition + shares from servers. If only one person uses --neededshares=5, + the attacker can guess that all their shares go together. diff --git a/Tests.hs b/Tests.hs --- a/Tests.hs +++ b/Tests.hs @@ -75,7 +75,7 @@ setup = mkdtemp "keysafe-test" cleanup = removeDirectoryRecursive go tmpdir = a $ StorageLocations $ - map (localStorage (testStorageDir tmpdir) . show) + map (localStorage LocallyPreferred (testStorageDir tmpdir) . show) [1..100 :: Int] -- | Test of backup and restore of a SecretKey. @@ -91,12 +91,12 @@ kek <- genKeyEncryptionKey tunables name password let esk = encrypt tunables kek secretkey shares <- genShares esk tunables - let sis = shareIdents tunables name secretkeysource + let sis = shareIdents tunables name AnyGpgKey _ <- storeShares storagelocations sis shares (return ()) return () restore storagelocations = do - let sis = shareIdents tunables name secretkeysource + let sis = shareIdents tunables name AnyGpgKey (shares, sis', _) <- retrieveShares storagelocations sis (return ()) let candidatekeys = candidateKeyEncryptionKeys tunables name password case combineShares tunables [shares] of @@ -120,7 +120,6 @@ name = Name testdesc password = Password "password" - secretkeysource = GpgKey (KeyId "dummy") -- testModeTunables is used, to avoid this taking a very -- long time to run. tunables = testModeTunables @@ -132,7 +131,7 @@ where runtest [] = testFailed "not stable!" runtest (tunables:rest) = do - let sis = shareIdents tunables name secretkeysource + let sis = shareIdents tunables name (Distinguisher secretkeysource) if S.member knownvalue (head (identsStream sis)) then testSuccess else runtest rest diff --git a/Types.hs b/Types.hs --- a/Types.hs +++ b/Types.hs @@ -51,7 +51,7 @@ -- | A name associated with a key stored in keysafe. newtype Name = Name B.ByteString - deriving (Show, Monoid) + deriving (Eq, Show, Monoid) -- | Source of the secret key stored in keysafe. data SecretKeySource = GpgKey KeyId | KeyFile FilePath diff --git a/Types/Server.hs b/Types/Server.hs --- 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 @@ -27,12 +27,8 @@ instance ToJSON ServerName instance FromJSON ServerName -data ServerLevel = Recommended | Alternate | Untrusted - deriving (Show, Eq, Ord, Bounded, Enum) - data Server = Server { serverName :: ServerName - , serverLevel :: ServerLevel , serverAddress :: [ServerAddress] -- ^ A server may have multiple addresses, or no current address. , serverDesc :: String diff --git a/Types/Storage.hs b/Types/Storage.hs --- a/Types/Storage.hs +++ b/Types/Storage.hs @@ -20,6 +20,9 @@ newtype LocalStorageDirectory = LocalStorageDirectory FilePath +data StorageLevel = LocallyPreferred | Recommended | Alternate | Untrusted + deriving (Show, Eq, Ord, Bounded, Enum) + -- | Storage interface. This can be used both for local storage, -- an upload queue, or a remote server. -- @@ -35,6 +38,7 @@ , moveShares :: Storage -> IO [StoreResult] -- ^ Tries to move all shares from this storage to another one. , uploadQueue :: Maybe Storage + , storageLevel :: StorageLevel , getServer :: Maybe Server } diff --git a/keysafe.cabal b/keysafe.cabal --- a/keysafe.cabal +++ b/keysafe.cabal @@ -1,5 +1,5 @@ Name: keysafe -Version: 0.20160927 +Version: 0.20161006 Cabal-Version: >= 1.8 Maintainer: Joey Hess Author: Joey Hess @@ -74,17 +74,12 @@ , exceptions == 0.8.* , random-shuffle == 0.0.* , MonadRandom == 0.4.* - -- Temporarily inlined due to FTBFS bug - -- https://github.com/ocharles/argon2/issues/2 - -- argon2 == 1.1.* - Extra-Libraries: argon2 + , argon2 == 1.2.* Other-Modules: AutoStart BackupLog Benchmark ByteStrings - Crypto.Argon2.FFI - Crypto.Argon2 CmdLine Cost Encryption diff --git a/keysafe.hs b/keysafe.hs --- a/keysafe.hs +++ b/keysafe.hs @@ -20,7 +20,6 @@ import SecretKey import Share import Storage -import Servers import Types.Server import BackupLog import AutoStart @@ -62,15 +61,15 @@ go mode (CmdLine.secretkeysource cmdline) where go CmdLine.Backup (Just secretkeysource) = - backup cmdline ui tunables secretkeysource + backup cmdline ui tunables (Distinguisher secretkeysource) =<< getSecretKey secretkeysource go CmdLine.Restore (Just secretkeydest) = - restore cmdline ui possibletunables secretkeydest + restore cmdline ui possibletunables (Distinguisher secretkeydest) go CmdLine.Backup Nothing = - backup cmdline ui tunables Gpg.anyKey + backup cmdline ui tunables AnyGpgKey =<< Gpg.getKeyToBackup ui go CmdLine.Restore Nothing = - restore cmdline ui possibletunables Gpg.anyKey + restore cmdline ui possibletunables AnyGpgKey go CmdLine.UploadQueued _ = uploadQueued ui (CmdLine.localstoragedirectory cmdline) go CmdLine.AutoStart _ = @@ -86,14 +85,14 @@ go (CmdLine.Chaff hn) _ = storeChaff hn (CmdLine.serverPort (CmdLine.serverConfig cmdline)) (CmdLine.chaffMaxDelay cmdline) - go CmdLine.CheckServers _ = checkServers + go CmdLine.CheckServers _ = checkServers cmdline go CmdLine.Benchmark _ = benchmarkTunables tunables go CmdLine.Test _ = runTests -backup :: CmdLine.CmdLine -> UI -> Tunables -> SecretKeySource -> SecretKey -> IO () -backup cmdline ui tunables secretkeysource secretkey = do +backup :: CmdLine.CmdLine -> UI -> Tunables -> Distinguisher -> (SecretKeySource, SecretKey) -> IO () +backup cmdline ui tunables distinguisher (secretkeysource, secretkey) = do installAutoStartFile let m = totalObjects (shareParams tunables) @@ -128,7 +127,7 @@ othernamedesc Nothing validateName let name = Name (theirname <> " " <> othername) (kek, passwordentropy) <- promptpassword name - let sis = shareIdents tunables name secretkeysource + let sis = shareIdents tunables name distinguisher let cost = getCreationCost kek <> getCreationCost sis (r, queued, usedlocs) <- withProgressIncremental ui "Encrypting and storing data" (encryptdesc cost cores) $ \addpercent -> do @@ -228,8 +227,8 @@ , "A place you like to visit." ] -restore :: CmdLine.CmdLine -> UI -> [Tunables] -> SecretKeySource -> IO () -restore cmdline ui possibletunables secretkeydest = do +restore :: CmdLine.CmdLine -> UI -> [Tunables] -> Distinguisher -> IO () +restore cmdline ui possibletunables distinguisher = do cores <- fromMaybe 1 <$> getNumCores username <- userName Name theirname <- case CmdLine.name cmdline of @@ -246,7 +245,7 @@ password <- fromMaybe (error "Aborting on no password") <$> promptPassword ui True "Enter password" passworddesc - let mksis tunables = shareIdents tunables name secretkeydest + let mksis tunables = shareIdents tunables name distinguisher locs <- cmdLineStorageLocations cmdline r <- downloadInitialShares locs ui mksis possibletunables case r of @@ -269,14 +268,22 @@ showError ui "Decryption failed! Probably you entered the wrong password." DecryptSuccess secretkey -> do _ <- setpercent 100 - writeSecretKey secretkeydest secretkey + oldgpgkeys <- if distinguisher == AnyGpgKey then Gpg.listSecretKeys else return [] + writeSecretKey distinguisher secretkey + newgpgkeys <- if distinguisher == AnyGpgKey then Gpg.listSecretKeys else return [] return $ \passwordentropy -> do showInfo ui "Success" "Your secret key was successfully restored!" -- Since the key was restored, we know it's -- backed up; log that. - backuplog <- mkBackupLog $ - backupMade firstusedservers secretkeydest passwordentropy - storeBackupLog backuplog + let updatelog restored = do + backuplog <- mkBackupLog $ + backupMade firstusedservers restored passwordentropy + storeBackupLog backuplog + case distinguisher of + AnyGpgKey -> case filter (`notElem` oldgpgkeys) newgpgkeys of + [(_n, k)] -> updatelog (GpgKey k) + _ -> return () + Distinguisher sks -> updatelog sks DecryptIncomplete kek -> do -- Download shares for another chunk. (nextshares, sis', nextusedservers) @@ -361,10 +368,12 @@ return $ Name $ BU8.fromString $ takeWhile (/= ',') (userGecos u) cmdLineStorageLocations :: CmdLine.CmdLine -> IO StorageLocations -cmdLineStorageLocations cmdline - | CmdLine.localstorage cmdline = return (localStorageLocations lsd) - | otherwise = networkStorageLocations lsd +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) @@ -404,20 +413,22 @@ ("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 + then backup cmdline ui tunables AnyGpgKey + =<< getSecretKey (GpgKey kid) else storeBackupLog =<< mkBackupLog (BackupSkipped (GpgKey kid)) -checkServers :: IO () -checkServers = do - say $ "Checking " ++ show (length networkServers) ++ " servers concurrently; please wait..." - results <- mapConcurrently check networkServers +checkServers :: CmdLine.CmdLine -> IO () +checkServers cmdline = do + StorageLocations sls <- cmdLineStorageLocations cmdline + let serverlist = mapMaybe getServer sls + say $ "Checking " ++ show (length serverlist) ++ " servers concurrently; please wait..." + results <- mapConcurrently check serverlist mapM_ displayresult results case filter failed results of [] -> return () l - | length l == length networkServers -> + | length l == length serverlist -> error "Failed to connect to any servers. Perhaps TOR is not running?" | otherwise -> error $ "Failed to connect to some servers: "