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
|
{-# 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 Data.Maybe
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)
-- TODO determine gpg key id by examining secret key,
-- or retrieving public key from keyserver and examining it.
let tunables = if CmdLine.testMode cmdline
then testModeTunables
else defaultTunables
case (CmdLine.mode cmdline, CmdLine.secretkeysource cmdline) of
(CmdLine.Backup, Just secretkeysource) ->
backup ui tunables =<< normalize secretkeysource
(CmdLine.Backup, Nothing) -> do
backup ui tunables =<< normalize =<< pickGpgKey CmdLine.Backup ui
(CmdLine.Restore, Just secretkeydest) ->
restore ui =<< normalize secretkeydest
(CmdLine.Restore, Nothing) -> do
restore ui =<< normalize =<< pickGpgKey CmdLine.Backup ui
(CmdLine.Benchmark, _) -> benchmarkTunables tunables
-- | Normalize gpg keyids, by querying the gpg keyserver for the key.
-- If the keyserver knows of the key, the long keyid is used.
-- But, if the keyserver does not know of the key, a null keyid is used.
normalize :: SecretKeySource -> IO SecretKeySource
normalize = return -- TODO
-- | Pick gpg secret key to back up or restore.
--
-- When backing up, if there is only one secret
-- key, the choice is obvious. Otherwise prompt the user with a list.
--
-- When restoring, prompt the user for the name of the key,
-- query the keyserver, and let the user pick from a list.
-- The "other" option uses a null keyid, to handle the case where a key is
-- not stored in the keyserver.
pickGpgKey :: CmdLine.Mode -> UI -> IO SecretKeySource
pickGpgKey CmdLine.Backup ui = error "TODO"
pickGpgKey CmdLine.Restore ui = error "TODO"
pickGpgKey _ ui = error "internal error in pickGpgKey"
backup :: UI -> Tunables -> SecretKeySource -> IO ()
backup ui tunables secretkeysource = do
username <- userName
name <- fromMaybe (error "Aborting on no name")
<$> promptName ui "Enter a name"
namedesc username validateName
kek <- genKeyEncryptionKey tunables name 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
password = Password "correct horse battery staple"
secretkey = SecretKey "this is a gpg private key"
namedesc = unlines
[ "To back up your 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 the key."
, ""
, "(Your own full name is a pretty good choice for the name to enter here.)"
]
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
userName :: IO Name
userName = do
u <- getUserEntryForID =<< getEffectiveUserID
return $ Name $ BU8.fromString $ takeWhile (/= ',') (userGecos u)
|
