Merge tag '0.20161107'

tagging package keysafe version 0.20161107

# gpg: Signature made Mon 07 Nov 2016 12:06:16 PM MST
# gpg:                using RSA key C910D9222512E3C7
# gpg: Good signature from "Joey Hess <id@joeyh.name>" [full]
# Primary key fingerprint: E85A 5F63 B31D 24C1 EBF0  D81C C910 D922 2512 E3C7

10 files changed, 107 insertions, 38 deletions

diff --git a/CHANGELOG b/CHANGELOG
index 47ced82..d209b28 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -1,3 +1,20 @@
+keysafe (0.20161107) unstable; urgency=medium
+
+  * The third keysafe server is now available, provided by Purism.
+  * Purism's keysafe server has been vetted to Recommended level!
+  * Change default for --port to 4242.
+  * Fix --check-server to not fail when the server has not had anything
+    stored on it yet.
+  * --upload-queued: Exit nonzero if unable to upload all queued objects.
+  * --autostart: If unable to upload all queued objects initially,
+    delay between 1 and 2 hours and try again.
+  * Better suggestion when user is having difficulty thinking of a strong
+    enough password.
+  * Defer requesting secret key from gpg until just before backup, so the
+    user knows why gpg is asking for this secret key to be backed up.
+
+ -- Joey Hess <id@joeyh.name>  Mon, 07 Nov 2016 15:05:29 -0400
+
 keysafe (0.20161022) unstable; urgency=medium
 
   * Add keywords to desktop file.
diff --git a/CmdLine.hs b/CmdLine.hs
index 155a628..3ba4e23 100644
--- a/CmdLine.hs
+++ b/CmdLine.hs
@@ -181,7 +181,7 @@ parseServerConfig = ServerConfig
 	<$> option auto
 		( long "port"
 		<> metavar "P"
-		<> value 80
+		<> value 4242
 		<> showDefault
 		<> help "Port for server to listen on."
 		)
@@ -243,4 +243,4 @@ hostPortOption = eitherReader $ \s ->
 		(h, ':':ps) -> case reads ps of
 			[(p, "")] -> Right (h, p)
 			_ -> Left $ "unable to parse port \"" ++ ps ++ "\""
-		(h, _) -> Right (h, 80)
+		(h, _) -> Right (h, 4242)
diff --git a/Gpg.hs b/Gpg.hs
index 91b53cd..192ab1c 100644
--- a/Gpg.hs
+++ b/Gpg.hs
@@ -21,19 +21,17 @@ import qualified Data.Text as T
 --
 -- If there is only one gpg secret key,
 -- the choice is obvious. Otherwise prompt the user with a list.
-getKeyToBackup :: UI -> IO (SecretKeySource, SecretKey)
+getKeyToBackup :: UI -> IO SecretKeySource
 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)] = mkret kid
-	go l = maybe (error "Canceled") mkret
+	go [(_, kid)] = selected kid
+	go l = maybe (error "Canceled") selected
 		=<< promptKeyId ui "Pick gpg secret key"
 			"Pick gpg secret key to back up:" l
-	mkret kid = do
-		sk <- getSecretKey kid
-		return (GpgKey kid, sk)
+	selected = return . GpgKey
 
 listSecretKeys :: IO [(Name, KeyId)]
 listSecretKeys = map mk . parse . lines <$> readProcess "gpg"
diff --git a/SecretKey.hs b/SecretKey.hs
index 8dc2ada..15256d0 100644
--- a/SecretKey.hs
+++ b/SecretKey.hs
@@ -12,12 +12,9 @@ import qualified Data.ByteString as B
 import System.IO
 import System.Posix.IO
 
-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)
+getSecretKey :: SecretKeySource -> IO SecretKey
+getSecretKey (GpgKey kid) = Gpg.getSecretKey kid
+getSecretKey (KeyFile f) = SecretKey <$> B.readFile f
 
 -- | Can throw exception if the secret key already exists.
 writeSecretKey :: Distinguisher -> SecretKey -> IO ()
diff --git a/Servers.hs b/Servers.hs
index ab31838..3e4e792 100644
--- a/Servers.hs
+++ b/Servers.hs
@@ -23,9 +23,13 @@ serverList d =
 		[ServerAddress "vzgrspuxbtnlrtup.onion" 4242]
 		"Provided by Joey Hess. Digital Ocean VPS, located in Indonesia"
 
-	, mk Alternate $ Server (ServerName "keysafe.puri.sm")
-		[]
-		"Purism server is not yet deployed, but planned."
+	, mk Recommended $ Server (ServerName "keysafe.puri.sm")
+		[ServerAddress "hlmjmeth356s5ekm.onion" 4242]
+		"Provided by Purism. Located in the EU (Cyprus)"
+		-- Note that while Joey Hess is employed by Purism,
+		-- he does not have access to this server or its data,
+		-- and Purism has policy to never allow him such access.
+		-- This is important since he runs keysafe.joeyh.name.
 
 	-- still being vetted
 	, mk Alternate $ Server (ServerName "thirdserver")
diff --git a/Storage/Local.hs b/Storage/Local.hs
index 637a31b..c1dcea4 100644
--- a/Storage/Local.hs
+++ b/Storage/Local.hs
@@ -112,8 +112,11 @@ obscure section getsharedir = onError (ObscureFailure . show) $ do
 count :: Section -> GetShareDir -> IO CountResult
 count section getsharedir = onError (CountFailure . show) $ do
 	dir <- getsharedir section
-	CountResult . genericLength . filter isShareFile
-		<$> getDirectoryContents dir
+	exists <- doesDirectoryExist dir
+	if exists
+		then CountResult . genericLength . filter isShareFile
+			<$> getDirectoryContents dir
+		else return (CountResult 0)
 
 move :: Section -> GetShareDir -> Storage -> IO [StoreResult]
 move section getsharedir storage = do
diff --git a/TODO b/TODO
index 97da3e0..e0190cc 100644
--- a/TODO
+++ b/TODO
@@ -1,6 +1,6 @@
 Soon:
 
-* Get some keysafe servers set up.
+* Finish vetting 2 servers to Recommended.
 * Set up --check-servers in a cron job, so I know when servers are down.
 
 Later:
@@ -8,6 +8,8 @@ Later:
 * The attack cost display can lead to a false sense of security if the user
   takes it as gospel. It needs to be clear that it's an estimate. This and
   other parts of the keysafe UI need usability testing.
+* Make --gui password entry fields longer, so user does not feel they need
+  to make password short. (zenity may not allow configuring this)
 * 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.
@@ -24,11 +26,19 @@ Later:
   harder for traffic analysis to tell that given TOR traffic is
   keysafe traffic.
 * Argon2d is more resistent to GPU/ASIC attack optimisation.
-  Switching from Argon2i would require new tunables, so deferred for now
+  Switching from Argon2i would require new tunables, and delay restores
+  (of keys backed up using the old tunables, and when the user provides the
+  wrong name) by ~10 minutes, so deferred for now
   until there's some other reason to change the tunables.
 
 Wishlist:
 
+* Custom GUI, instead of zenity. Allows:
+  - Fewer screens by consolidating multiple prompts.
+  - Check same password entered second time and don't allow continuing
+    if not.
+  - Password strengh display, and don't allow continuing if password is too
+    weak.
 * Keep secret keys in locked memory until they're encrypted.
   (Raaz makes this possible to do.)
   Would be nice, but not super-important, since gpg secret keys
@@ -51,4 +61,14 @@ Wishlist:
   with 2 shares, then 3, etc, and once it found shares, it would know the
   number needed. It should also be possible to avoid breaking backwards
   compatability, by only including the number of shares in the name when
-  it's not the standard number.
+  it's not the standard number. To avoid needing to re-run argon2 for each
+  try, the argon2 hash of the name could be calculated first, and then the
+  number of needed shares appended before the final sha256 hash is
+  generated.
+  
+  If an attacker is able to guess the name, and a nonstandard number of
+  shares was used, the attacker could upload other objects where they would
+  be found before the real objects. This could be used to prevent
+  restore from working. (It also makes a malicious data attack (as described
+  in https://joeyh.name/keysafe/details/) possible by attackers who do not
+  control the servers.
diff --git a/keysafe.1 b/keysafe.1
index 73d0b4d..a09bf6f 100644
--- a/keysafe.1
+++ b/keysafe.1
@@ -141,7 +141,7 @@ use for backup/restore of keys. Keysafe will use the
 server first before any of its built-in servers.
 .PP
 .IP "--port P"
-Port for server to listen on. (default: 80)
+Port for server to listen on. (default: 4242)
 .PP
 .IP "--address A"
 Address for server to bind to. (Use "*" to bind to
diff --git a/keysafe.cabal b/keysafe.cabal
index fc64e3f..a72ab81 100644
--- a/keysafe.cabal
+++ b/keysafe.cabal
@@ -1,5 +1,5 @@
 Name: keysafe
-Version: 0.20161022
+Version: 0.20161107
 Cabal-Version: >= 1.8
 Maintainer: Joey Hess <joey@kitenet.net>
 Author: Joey Hess
diff --git a/keysafe.hs b/keysafe.hs
index 996c0a7..d6c2a5e 100644
--- a/keysafe.hs
+++ b/keysafe.hs
@@ -40,6 +40,9 @@ 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
+import Control.Concurrent.Thread.Delay
+import System.Random
+import System.Exit
 import System.Posix.User (userGecos, getUserEntryForID, getEffectiveUserID)
 
 main :: IO ()
@@ -62,7 +65,7 @@ dispatch cmdline ui tunables possibletunables = do
   where
 	go CmdLine.Backup (Just secretkeysource) =
 		backup cmdline ui tunables (Distinguisher secretkeysource)
-			=<< getSecretKey secretkeysource
+			secretkeysource
 	go CmdLine.Restore (Just secretkeydest) =
 		restore cmdline ui possibletunables (Distinguisher secretkeydest)
 	go CmdLine.Backup Nothing =
@@ -70,8 +73,11 @@ dispatch cmdline ui tunables possibletunables = do
 			=<< Gpg.getKeyToBackup ui
 	go CmdLine.Restore Nothing =
 		restore cmdline ui possibletunables AnyGpgKey
-	go CmdLine.UploadQueued _ =
-		uploadQueued ui (CmdLine.localstoragedirectory cmdline)
+	go CmdLine.UploadQueued _ = do
+		ok <- uploadQueued ui (CmdLine.localstoragedirectory cmdline)
+		if ok
+			then exitSuccess
+			else exitFailure
 	go CmdLine.AutoStart _ =
 		autoStart cmdline tunables ui
 	go (CmdLine.Server) _ =
@@ -91,8 +97,8 @@ dispatch cmdline ui tunables possibletunables = do
 	go CmdLine.Test _ =
 		runTests
 
-backup :: CmdLine.CmdLine -> UI -> Tunables -> Distinguisher -> (SecretKeySource, SecretKey) -> IO ()
-backup cmdline ui tunables distinguisher (secretkeysource, secretkey) = do
+backup :: CmdLine.CmdLine -> UI -> Tunables -> Distinguisher -> SecretKeySource -> IO ()
+backup cmdline ui tunables distinguisher secretkeysource = do
 	installAutoStartFile
 
 	let m = totalObjects (shareParams tunables)
@@ -116,9 +122,9 @@ backup cmdline ui tunables distinguisher (secretkeysource, secretkey) = do
 		Nothing -> fromMaybe (error "Aborting on no username") 
 			<$> promptName ui "Enter your name"
 				usernamedesc (Just username) validateName
-	go theirname locs
+	go theirname locs Nothing
   where
-	go theirname locs = do
+	go theirname locs msecretkey = do
 		cores <- fromMaybe 1 <$> getNumCores
 		Name othername <- case CmdLine.name cmdline of
 			Just n -> pure n
@@ -129,6 +135,9 @@ backup cmdline ui tunables distinguisher (secretkeysource, secretkey) = do
 		(kek, passwordentropy) <- promptpassword name
 		let sis = shareIdents tunables name distinguisher
 		let cost = getCreationCost kek <> getCreationCost sis
+		secretkey <- case msecretkey of
+			Just sk -> pure sk
+			Nothing -> getSecretKey secretkeysource
 		(r, queued, usedlocs) <- withProgressIncremental ui "Encrypting and storing data"
 			(encryptdesc cost cores) $ \addpercent -> do
 				let esk = encrypt tunables kek secretkey
@@ -153,7 +162,7 @@ backup cmdline ui tunables distinguisher (secretkeysource, secretkey) = do
 					[ "Another secret key is already being stored under the name you entered."
 					, "Please try again with a different name."
 					]
-				go theirname locs
+				go theirname locs (Just secretkey)
 	promptpassword name = do
 		password <- fromMaybe (error "Aborting on no password") 
 			<$> promptPassword ui True "Enter password" passworddesc
@@ -164,7 +173,12 @@ backup cmdline ui tunables distinguisher (secretkeysource, secretkey) = do
 		let mincost = Dollars 100000
 		if crackcost < mincost
 			then do
-				showError ui $ "Weak password! It would cost only " ++ show crackcost ++ " to crack the password. Please think of a better one. More words would be good.."
+				showError ui $ unlines
+					[ "Weak password! It would cost only " ++ show crackcost ++ " to crack the password."
+					, "Please think of a better one."
+					, ""
+					, "Suggestion: Pick 3 or 4 unrelated words for a strong password, like \"correct horse battery staple\""
+					]
 				promptpassword name
 			else do
 				(thisyear, _, _) <- toGregorian . utctDay
@@ -384,18 +398,20 @@ getPasswordEntropy password name = do
   where
 	namewords (Name nb) = words (BU8.toString nb)
 
-uploadQueued :: UI -> Maybe LocalStorageDirectory -> IO ()
+uploadQueued :: UI -> Maybe LocalStorageDirectory -> IO Bool
 uploadQueued ui d = do
 	problems <- tryUploadQueued d
 	if null problems
-		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.")
+		then return True
+		else do
+			showError ui ("Problem uploading queued data to servers:\n\n" ++ unlines problems ++ "\n\nYour secret keys have not yet been backed up.")
+			return False
 
 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)
+	queueok <- 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
@@ -414,10 +430,24 @@ autoStart cmdline tunables ui = do
 				"Do you want to back up the gpg secret key now?"
 			if ans
 				then backup cmdline ui tunables AnyGpgKey
-					=<< getSecretKey (GpgKey kid)
+					(GpgKey kid)
 				else storeBackupLog
 					=<< mkBackupLog (BackupSkipped (GpgKey kid))
 
+	if queueok
+		then return ()
+		else retryqueue
+  where
+	-- Delay for between 1 and 2 hours, and retry queued uploads.
+	retryqueue = do
+		let hourdelay = 1000000 * 60*60
+		msdelay <- getStdRandom (randomR (hourdelay, hourdelay*2))
+		delay msdelay
+		problems <- tryUploadQueued (CmdLine.localstoragedirectory cmdline)
+		if null problems
+			then return ()
+			else retryqueue
+
 checkServers :: CmdLine.CmdLine -> IO ()
 checkServers cmdline = do
 	StorageLocations sls <- cmdLineStorageLocations cmdline