1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
|
{-# LANGUAGE OverloadedStrings #-}
{- Copyright 2016 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
module Main where
import Types
import Tunables
import qualified CmdLine
import UI
import Encryption
import Entropy
import ExpensiveHash
import Cost
import Shard
import Storage
import Storage.LocalFiles
import qualified Gpg
import Data.Maybe
import Control.Monad
import qualified Data.ByteString as B
import qualified Data.ByteString.UTF8 as BU8
import System.Posix.User (userGecos, getUserEntryForID, getEffectiveUserID)
main :: IO ()
main = do
cmdline <- CmdLine.get
ui <- selectUI (CmdLine.gui cmdline)
let tunables = if CmdLine.testMode cmdline
then testModeTunables
else defaultTunables
mode <- CmdLine.selectMode cmdline
go mode (CmdLine.secretkeysource cmdline) tunables ui
where
go CmdLine.Backup (Just secretkeysource@(GpgKey kid)) tunables ui = do
ok <- Gpg.knownByKeyServer kid
unless ok $
error "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
=<< getSecretKey secretkeysource
go CmdLine.Backup (Just secretkeysource) tunables ui =
backup 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 _ =
benchmarkTunables tunables
getSecretKey :: SecretKeySource -> IO SecretKey
getSecretKey (GpgKey kid) = Gpg.getSecretKey kid
getSecretKey (KeyFile f) = SecretKey <$> B.readFile f
-- | Pick gpg secret key to back up.
--
-- If there is only one gpg secret key,
-- the choice is obvious. Otherwise prompt the user with a list.
pickGpgKeyToBackup :: UI -> IO SecretKey
pickGpgKeyToBackup ui = go =<< Gpg.listSecretKeys
where
go [] = do
showError ui "You have no gpg secret keys to back up."
error "Aborting on no gpg secret keys."
go [(_, kid)] = Gpg.getSecretKey kid
go l = maybe (error "Canceled") Gpg.getSecretKey
=<< 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.
anyGpgKey :: SecretKeySource
anyGpgKey = GpgKey (KeyId "")
backup :: UI -> Tunables -> SecretKeySource -> SecretKey -> IO ()
backup ui tunables secretkeysource secretkey = do
username <- userName
name <- fromMaybe (error "Aborting on no name")
<$> promptName ui "Enter a name"
namedesc username validateName
password <- fromMaybe (error "Aborting on no password")
<$> promptPassword ui "Enter a password"
passworddesc validatePassword
kek <- genKeyEncryptionKey tunables name password
-- TODO: show password strength estimate, and verify password.
putStrLn "Very rough estimate of cost to brute-force the password:"
print $ estimateAttack spotAWS $ estimateBruteforceOf kek
(passwordEntropy password [])
let esk = encrypt tunables kek secretkey
let sis = shardIdents tunables name secretkeysource
shards <- genShards esk tunables
print =<< mapM (uncurry (storeShard localFiles)) (zip (getIdents sis) shards)
print =<< obscureShards localFiles
where
namedesc = unlines
[ "To back up your secret key, you will need to enter a name and a password."
, ""
, "Make sure to pick a name you will remember at some point in the future,"
, "perhaps years from now, when you will need to enter it with the same"
, "spelling and capitalization in order to restore your secret key."
, ""
, "(Your own full name is a pretty good choice for the name to enter here.)"
]
passworddesc = unlines
[ "Pick a password that will be used to protect your secret key."
, ""
, "It's very important that this password be hard to guess."
, ""
, "And, it needs to be one that you will be able to remember years from now"
, "in order to restore your secret key."
]
restore :: UI -> SecretKeySource -> IO ()
restore ui secretkeydest = do
username <- userName
name <- fromMaybe (error "Aborting on no name")
<$> promptName ui "Enter the name of the key to restore"
namedesc username validateName
let sis = shardIdents tunables name secretkeydest
-- we drop 1 to simulate not getting all shards from the servers
let l = drop 1 $ zip [1..] (getIdents sis)
shards <- map (\(RetrieveSuccess s) -> s)
<$> mapM (uncurry (retrieveShard localFiles)) l
_ <- obscureShards localFiles
let esk = combineShards tunables shards
go esk (candidateKeyEncryptionKeys tunables name password)
where
go _ [] = error "decryption failed"
go esk (kek:rest) = case decrypt kek esk of
Just (SecretKey sk) -> print sk
Nothing -> go esk rest
password = Password "correct horse battery staple"
-- TODO: derive by probing to find objects
tunables = testModeTunables -- defaultTunables
namedesc = unlines
[ "When you backed up the key, you entered a name and a password."
, "Now it's time to remember what you entered back then."
, ""
, "(If you can't remember the name you used, your own full name is the best guess.)"
]
validateName :: Name -> Maybe Problem
validateName (Name n)
| B.length n < 6 = Just "The name should be at least 6 letters long."
| otherwise = Nothing
validatePassword :: Password -> Maybe Problem
validatePassword _ = Nothing
userName :: IO Name
userName = do
u <- getUserEntryForID =<< getEffectiveUserID
return $ Name $ BU8.fromString $ takeWhile (/= ',') (userGecos u)
|
