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
159
160
161
162
163
164
165
166
167
168
169
|
{-# LANGUAGE CPP #-}
module Kiki where
import Control.Monad
import Control.Applicative
import Data.List
import Data.Maybe
import Data.Ord
import System.Directory
import System.FilePath.Posix
import System.IO
import Data.OpenPGP
import Data.OpenPGP.Util
import qualified Data.Map.Strict as Map
import qualified Codec.Binary.Base64 as Base64
import Data.ASN1.BinaryEncoding
import Data.ASN1.Encoding
import Data.ASN1.Types
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as Char8
import CommandLine
import qualified SSHKey as SSH
import KeyRing
-- |
-- Regenerate /var/cache/kiki
refresh :: (FilePath -> FilePath) -> CommonArgsParsed -> IO ()
refresh root homepass = do
let homepass' = homepass { cap_homespec = fmap root (cap_homespec homepass) }
KikiResult r report <- runKeyRing $ minimalOp homepass'
let mroot = case root "" of
"/" -> Nothing
"" -> Nothing
pth -> Just pth
case r of
KikiSuccess rt -> refreshCache rt mroot
_ -> return () -- XXX: silent fail?
data CommonArgsParsed = CommonArgsParsed { cap_homespec :: Maybe String, cap_passfd :: Maybe InputFile }
minimalOp :: CommonArgsParsed -> KeyRingOperation
minimalOp cap = op
where
streaminfo = StreamInfo { fill = KF_None
, typ = KeyRingFile
, spill = KF_All
, initializer = NoCreate
, access = AutoAccess
, transforms = []
}
op = KeyRingOperation
{ opFiles = Map.fromList $
[ ( HomeSec, streaminfo { access = Sec })
, ( HomePub, streaminfo { access = Pub })
]
, opPassphrases = do pfile <- maybeToList (cap_passfd cap)
return $ PassphraseSpec Nothing Nothing pfile
, opTransforms = []
, opHome = cap_homespec cap
}
refreshCache :: KeyRingRuntime -> Maybe FilePath -> IO ()
refreshCache rt rootdir = do
let mkpath pth = fromMaybe "" rootdir ++ "/var/cache/kiki/"++pth
write f bs = do
createDirectoryIfMissing True $ takeDirectory f
writeFile f bs
let oname' = do wk <- rtWorkingKey rt
-- XXX unnecessary signature check
onionNameForContact (keykey wk) (rtKeyDB rt)
bUnprivileged = False -- TODO
if (oname' == Nothing) && (not bUnprivileged) then error "Missing tor key" else do
let oname = fromMaybe "" oname'
-- sshcpathpub0 = fromMaybe "" rootdir ++ osHomeDir </> ".ssh" </> "id_rsa.pub"
-- sshspathpub0 = fromMaybe "" rootdir ++ "/etc/ssh/ssh_host_rsa_key.pub"
-- contactipsec0 = fromMaybe "" rootdir ++ "/etc/ipsec.d/certs/%(onion).pem"
-- Finally, export public keys if they do not exist.
flip (maybe $ warn "missing working key?") (rtGrip rt) $ \grip -> do
either warn (write $ mkpath "root/.ssh/id_rsa.pub")
$ show_ssh' "ssh-client" grip (rtKeyDB rt)
either warn (write $ mkpath "ssh_host_rsa_key.pub")
$ show_ssh' "ssh-server" grip (rtKeyDB rt)
either warn (write $ mkpath "ipsec.d/certs/" ++ oname++".pem")
$ show_pem' "ipsec" grip (rtKeyDB rt) pemFromPacket
let cs = filter notme (Map.elems $ rtKeyDB rt)
kk = keykey (fromJust $ rtWorkingKey rt)
notme kd = keykey (keyPacket kd) /= kk
installConctact kd = do
-- The getHostnames command requires a valid cross-signed tor key
-- for each onion name returned in (_,(ns,_)).
let (_,(ns,_)) = getHostnames kd
contactname = fmap Char8.unpack $ listToMaybe ns -- only first onion name.
flip (maybe $ return ()) contactname $ \contactname -> do
let cpath = interp (Map.singleton "onion" contactname) "ipsec.d/certs/%(onion).pem"
their_master = packet $ keyMappedPacket kd
-- We find all cross-certified ipsec keys for the given cross-certified onion name.
ipsecs = sortOn (Down . timestamp)
$ getCrossSignedSubkeys their_master (keySubKeys kd) "ipsec"
forM_ (take 1 ipsecs) $ \k -> do
either warn (write $ mkpath cpath) $ pemFromPacket k
mapM_ installConctact cs
#if !MIN_VERSION_base(4,8,0)
sortOn :: Ord b => (a -> b) -> [a] -> [a]
sortOn f =
map snd . sortBy (comparing fst) . map (\x -> let y = f x in y `seq` (y, x))
#endif
pemFromPacket k = do
let rsa = pkcs8 . fromJust $ rsaKeyFromPacket k
der = encodeASN1 DER (toASN1 rsa [])
qq = Base64.encode (L.unpack der)
return $
writePEM "PUBLIC KEY" qq -- ("TODO "++show keyspec)
show_pem keyspec wkgrip db = either warn putStrLn $ show_pem' keyspec wkgrip db pemFromPacket
show_pem' keyspec wkgrip db keyfmt = do
let s = parseSpec wkgrip keyspec
flip (maybe . Left $ keyspec ++ ": not found")
(selectPublicKey s db)
keyfmt
warn str = hPutStrLn stderr str
show_ssh keyspec wkgrip db = either warn putStrLn $ show_ssh' keyspec wkgrip db
show_ssh' keyspec wkgrip db = do
let s = parseSpec wkgrip keyspec
flip (maybe . Left $ keyspec ++ ": not found")
(selectPublicKey s db)
$ return . sshblobFromPacket
-- |
-- interpolate %var patterns in a string.
interp vars raw = es >>= interp1
where
gs = groupBy (\_ c -> c/='%') raw
es = dropWhile null $ gobbleEscapes ("":gs)
where gobbleEscapes :: [String] -> [String]
gobbleEscapes (a:"%":b:bs) = (a++b) : gobbleEscapes bs
gobbleEscapes (g:gs) = g : gobbleEscapes gs
gobbleEscapes [] = []
interp1 ('%':'(':str) = fromMaybe "" (Map.lookup key vars) ++ drop 1 rest
where (key,rest) = break (==')') str
interp1 plain = plain
sshblobFromPacket k = blob
where
Just (RSAKey (MPI n) (MPI e)) = rsaKeyFromPacket k
bs = SSH.keyblob (n,e)
blob = Char8.unpack bs
ㄧhomedir = Kiki.CommonArgsParsed
<$> optional (arg "--homedir")
<*> optional (FileDesc <$> read <$> arg "--passphrase-fd")
|
