summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/KeyRing/BuildKeyDB.hs2
-rw-r--r--lib/Kiki.hs174
-rw-r--r--lib/PacketTranscoder.hs6
3 files changed, 92 insertions, 90 deletions
diff --git a/lib/KeyRing/BuildKeyDB.hs b/lib/KeyRing/BuildKeyDB.hs
index 24b39b1..dd204d1 100644
--- a/lib/KeyRing/BuildKeyDB.hs
+++ b/lib/KeyRing/BuildKeyDB.hs
@@ -199,7 +199,7 @@ buildKeyDB ctx grip0 keyring = do
199 accs = fmap (access . fst) ringPackets 199 accs = fmap (access . fst) ringPackets
200 return (spilled,mwk,grip,accs,keys,fmap snd unspilled) 200 return (spilled,mwk,grip,accs,keys,fmap snd unspilled)
201 201
202 transcode <- makeMemoizingDecrypter keyring ctx (mwk,keyqs) 202 transcode <- makeMemoizingDecrypter (opPassphrases keyring) ctx (mwk,keyqs)
203 let doDecrypt = transcode (Unencrypted,S2K 100 "") 203 let doDecrypt = transcode (Unencrypted,S2K 100 "")
204 204
205 let wk = fmap packet mwk 205 let wk = fmap packet mwk
diff --git a/lib/Kiki.hs b/lib/Kiki.hs
index e67c805..eabd8ed 100644
--- a/lib/Kiki.hs
+++ b/lib/Kiki.hs
@@ -14,6 +14,7 @@ import Data.ASN1.Types
14import Data.Binary 14import Data.Binary
15import Data.Bool 15import Data.Bool
16import Data.Char 16import Data.Char
17import Data.Functor
17import Data.List 18import Data.List
18import Data.Maybe 19import Data.Maybe
19import Data.OpenPGP 20import Data.OpenPGP
@@ -155,6 +156,35 @@ mkdirFor path = do
155 let dir = takeDirectory path 156 let dir = takeDirectory path
156 createDirectoryIfMissing True dir 157 createDirectoryIfMissing True dir
157 158
159
160-- | Useful default KeyRingFile StreamInfo.
161strm :: StreamInfo
162strm = StreamInfo
163 { typ = KeyRingFile
164 , fill = KF_None
165 , spill = KF_All
166 , access = AutoAccess
167 , initializer = NoCreate
168 , transforms = []
169 }
170
171-- | Convenience constructor for StreamInfo
172buildStreamInfo :: KeyFilter -> FileType -> StreamInfo
173buildStreamInfo rtyp ftyp = strm { typ = ftyp , fill = rtyp }
174
175-- | Convenience constuctor for Streaminfo generating a tagged subkey.
176peminfo :: Int -- ^ bits
177 -> String -- ^ subkey tag.
178 -> StreamInfo
179peminfo bits usage = StreamInfo
180 { typ = PEMFile
181 , fill = KF_None -- KF_Match usage
182 , spill = KF_Match usage
183 , access = Sec
184 , initializer = Internal (GenRSA $ bits `div` 8)
185 , transforms = []
186 }
187
158importAndRefresh :: (FilePath -> FilePath) -> CommonArgsParsed -> SymmetricAlgorithm -> IO () 188importAndRefresh :: (FilePath -> FilePath) -> CommonArgsParsed -> SymmetricAlgorithm -> IO ()
159importAndRefresh root cmn cipher = do 189importAndRefresh root cmn cipher = do
160 let rootdir = do guard (root "x" /= "x") 190 let rootdir = do guard (root "x" /= "x")
@@ -165,54 +195,57 @@ importAndRefresh root cmn cipher = do
165 bool id (error "--chroot requires an argument") (rootdir==Just "") $ do 195 bool id (error "--chroot requires an argument") (rootdir==Just "") $ do
166 let homespec = mplus (slash <$> rootdir <*> cap_homespec cmn) 196 let homespec = mplus (slash <$> rootdir <*> cap_homespec cmn)
167 (fmap (++"/root/.gnupg") rootdir) 197 (fmap (++"/root/.gnupg") rootdir)
198 passfd = cap_passfd cmn
168 (home,secring,pubring,mbwk) <- unconditionally $ getHomeDir homespec 199 (home,secring,pubring,mbwk) <- unconditionally $ getHomeDir homespec
169 osHomeDir <- if bUnprivileged then getHomeDirectory else return "/root" 200 osHomeDir <- if bUnprivileged then getHomeDirectory else return "/root"
170 201
171 old_umask <- setFileCreationMask(0o077); 202 old_umask <- setFileCreationMask 0o077 -- Keyring files need to be created with proper mask.
172 -- Generate secring.gpg if it does not exist...
173 gotsec <- doesFileExist secring 203 gotsec <- doesFileExist secring
174
175 let passfd = cap_passfd cmn
176
177 (torgen,pwds) <- bool id (const $ return (Generate 0 $ GenRSA $ 1024 `div` 8, [])) gotsec $ do 204 (torgen,pwds) <- bool id (const $ return (Generate 0 $ GenRSA $ 1024 `div` 8, [])) gotsec $ do
178 {- ssh-keygen to create master key... 205 -- We have no secring.gpg (and thus no master key).
179 let mkpath = home ++ "/master-key" 206 -- Since 'runKeyRing' cannot currently cope with this situation, we will
180 mkdirFor mkpath 207 -- generate a master-key and very minimal secring.gpg file.
181 e <- systemEnv [ ("file",mkpath) ] (fromJust $ sshkeygen 4096) 208 master_un <- generateKey (GenRSA $ 4096 `div` 8 )
182 case e of 209 <&> \k -> MappedPacket (k { is_subkey = False }) -- Set as master-key.
183 ExitFailure num -> error "ssh-keygen failed to create master key" 210 Map.empty -- Packet occurs in no files.
184 ExitSuccess -> return () 211 -- The user may desire the master key is encrypted on disk but this
185 [PEMPacket mk] <- readSecretPEMFile (ArgFile mkpath) 212 -- requires a password prompt. In order to have a decent prompt, it'd
186 writeInputFileL (InputFileContext secring pubring) 213 -- be nice if we could display the .onion hostname for the key.
187 HomeSec 214 -- Therefore, we generate the tor key early.
188 ( encode $ Message [mk { is_subkey = False }] )
189 -}
190 master_un <- (\k -> MappedPacket (k { is_subkey = False }) Map.empty) <$> generateKey (GenRSA $ 4096 `div` 8 )
191 tor_un <- generateKey (GenRSA $ 1024 `div` 8 ) 215 tor_un <- generateKey (GenRSA $ 1024 `div` 8 )
216 -- However, we'll postpone writing the tor key to the keyring and
217 -- instead have the later all-in-one call to runKeyRing take care of
218 -- it. That interface does not currently provide a way to accept
219 -- in-memory input, so we'll create a fifo stream for it to read the
220 -- key in PEM format.
192 (read_tor,write_tor) <- Posix.createPipe 221 (read_tor,write_tor) <- Posix.createPipe
193 do rs <- writeKeyToFile (streaminfo { typ = PEMFile, access = Sec, spill = KF_Match "tor", fill = KF_All }) (FileDesc write_tor) tor_un 222 rs <- writeKeyToFile (streaminfo { typ = PEMFile
194 -- outputReport $ map (first show) rs 223 , access = Sec
195 return () 224 , spill = KF_Match "tor"
196 cipher's2k <- do 225 , fill = KF_All })
197 IteratedSaltedS2K _ salt _ <- randomS2K SHA1 226 (FileDesc write_tor)
198 -- (cipher {- AES128 -}, IteratedSaltedS2K SHA1 4073382889203176146 7864320) 227 tor_un
199 return $ (cipher {- AES128 -}, IteratedSaltedS2K SHA1 salt (15 * 2^19)) 228 -- -- Currently disabled: show warnings and errors from the PEM generation.
229 -- outputReport $ map (first show) rs
230
200 let ctx = InputFileContext secring pubring 231 let ctx = InputFileContext secring pubring
201 main_passwds = withAgent $ do pfd <- maybeToList passfd 232 -- Here we encrypt the master-key if neccessary. If no --passphrase-fd option
202 return $ PassphraseSpec Nothing Nothing pfd 233 -- was used, the user will receive prompts from gpg-agent.
203 passwordop = KeyRingOperation 234 (master0,transcoder) <- do
204 { opFiles = Map.empty 235 let main_passwds = withAgent $ do pfd <- maybeToList passfd
205 , opPassphrases = main_passwds 236 return $ PassphraseSpec Nothing Nothing pfd
206 , opHome = homespec 237 uidentry = Map.singleton (keykey $ packet master_un)
207 , opTransforms = [] 238 $ master_un { packet = Query (packet master_un)
208 } 239 (torUIDFromKey tor_un)
209 let uidentry = Map.singleton (keykey $ packet master_un) 240 Nothing }
210 $ master_un { packet = Query (packet master_un) 241 cipher's2k <- do
211 (torUIDFromKey tor_un) 242 IteratedSaltedS2K _ salt _ <- randomS2K SHA1
212 Nothing 243 return $ (cipher {- AES128 -}, IteratedSaltedS2K SHA1 salt (15 * 2^19))
213 } 244 transcoder <- makeMemoizingDecrypter main_passwds ctx (Just master_un, uidentry)
214 transcoder <- makeMemoizingDecrypter passwordop ctx (Just master_un, uidentry) 245 master <- transcoder cipher's2k master_un
215 master0 <- transcoder cipher's2k master_un 246 return (master,transcoder)
247
248 -- Finally, we write-out the secring.gpg file.
216 case master0 of 249 case master0 of
217 KikiSuccess master -> do 250 KikiSuccess master -> do
218 mkdirFor secring 251 mkdirFor secring
@@ -229,7 +262,17 @@ importAndRefresh root cmn cipher = do
229 HomeSec 262 HomeSec
230 $ encode $ Message [packet master_un] 263 $ encode $ Message [packet master_un]
231 putStrLn "Wrote master key" 264 putStrLn "Wrote master key"
265 -- FIXME: Why are we re-generating the tor key here? Does this
266 -- code get triggered when the user cancels the agent prompt?
267 -- If so, he's likely canceling encryption, not the .onion name
268 -- he was already shown.
232 return (Generate 0 (GenRSA $ 1024 `div` 8 ), []) 269 return (Generate 0 (GenRSA $ 1024 `div` 8 ), [])
270
271 -- If the public ring does not exist, then creating an empty file is
272 -- sufficient to satisfy 'runKeyRing'. However, as we've already generated
273 -- a key above, GnuPG will not like the unsynced state we are leaving these
274 -- files. It's important at this point that, 'runKeyRing' actually occurs
275 -- to fix things up.
233 gotpub <- doesFileExist pubring 276 gotpub <- doesFileExist pubring
234 when (not gotpub) $ do 277 when (not gotpub) $ do
235 mkdirFor pubring 278 mkdirFor pubring
@@ -237,49 +280,9 @@ importAndRefresh root cmn cipher = do
237 HomePub 280 HomePub
238 ( encode $ Message [] ) 281 ( encode $ Message [] )
239 282
240 setFileCreationMask(old_umask); 283 setFileCreationMask old_umask -- We're done creating keyring files, so restore umask.
241 -- Old paths.. 284
242 -- 285 let sshcpath = fromMaybe "" rootdir ++ osHomeDir ++ ".ssh/id_rsa"
243 -- Private
244 -- pem tor /var/lib/tor/samizdat/private_key
245 -- pem ssh-client %(home)/.ssh/id_rsa
246 -- pem ssh-server /etc/ssh/ssh_host_rsa_key
247 -- pem ipsec /etc/ipsec.d/private/%(onion).pem
248
249 -- Public
250 -- ssh-client %(home)/.ssh/id_rsa.pub
251 -- ssh-server /etc/ssh/ssh_host_rsa_key.pub
252 -- ipsec /etc/ipsec.d/certs/%(onion).pem
253
254 -- First, we ensure that the tor key exists and is imported
255 -- so that we know where to put the strongswan key.
256 let strm =
257 StreamInfo
258 { typ = KeyRingFile
259 , fill = KF_None
260 , spill = KF_All
261 , access = AutoAccess
262 , initializer = NoCreate
263 , transforms = []
264 }
265 buildStreamInfo rtyp ftyp =
266 StreamInfo
267 { typ = ftyp
268 , fill = rtyp
269 , spill = KF_All
270 , access = AutoAccess
271 , initializer = NoCreate
272 , transforms = [] }
273 peminfo bits usage =
274 StreamInfo
275 { typ = PEMFile
276 , fill = KF_None -- KF_Match usage
277 , spill = KF_Match usage
278 , access = Sec
279 , initializer = Internal (GenRSA $ bits `div` 8)
280 , transforms = []
281 }
282 sshcpath = fromMaybe "" rootdir ++ osHomeDir ++ ".ssh/id_rsa"
283 sshspath = fromMaybe "" rootdir ++ "/etc/ssh/ssh_host_rsa_key" 286 sshspath = fromMaybe "" rootdir ++ "/etc/ssh/ssh_host_rsa_key"
284 op = 287 op =
285 KeyRingOperation 288 KeyRingOperation
@@ -306,7 +309,6 @@ importAndRefresh root cmn cipher = do
306 , opHome = homespec 309 , opHome = homespec
307 , opTransforms = [] 310 , opTransforms = []
308 } 311 }
309 -- doNothing = return ()
310 nop = 312 nop =
311 KeyRingOperation 313 KeyRingOperation
312 { opFiles = Map.empty 314 { opFiles = Map.empty
@@ -314,14 +316,14 @@ importAndRefresh root cmn cipher = do
314 return $ PassphraseSpec Nothing Nothing pfd 316 return $ PassphraseSpec Nothing Nothing pfd
315 , opHome=homespec, opTransforms = [] 317 , opHome=homespec, opTransforms = []
316 } 318 }
317 -- if bUnprivileged then doNothing else mkdirFor torpath 319 -- Run the all-in-one operation that generates or imports all subkeys.
318 KikiResult rt report <- runKeyRing (if bUnprivileged then nop else op) 320 KikiResult rt report <- runKeyRing (if bUnprivileged then nop else op)
319 outputReport report 321 outputReport report
320 rt <- case rt of 322 rt <- case rt of
321 BadPassphrase -> 323 BadPassphrase ->
322 error "Operation requires correct passphrase. (Hint: Use --passphrase-fd=0 to input it on stdin.)" 324 error "Operation requires correct passphrase. (Hint: Use --passphrase-fd=0 to input it on stdin.)"
323 _ -> unconditionally $ return rt 325 _ -> unconditionally $ return rt
324 326 -- Finally, we update /var/cache/kiki.
325 when (not bUnprivileged) $ refreshCache rt rootdir 327 when (not bUnprivileged) $ refreshCache rt rootdir
326 328
327-- Installs the cert file for the peer to the filesystem, and returns an 329-- Installs the cert file for the peer to the filesystem, and returns an
diff --git a/lib/PacketTranscoder.hs b/lib/PacketTranscoder.hs
index 03b219b..830ec2f 100644
--- a/lib/PacketTranscoder.hs
+++ b/lib/PacketTranscoder.hs
@@ -253,14 +253,14 @@ tryInOrder (f:fs) alg mp = do
253 253
254-- The transcoder works on 'MappedPacket' instead of 'Packet' so that 254-- The transcoder works on 'MappedPacket' instead of 'Packet' so that
255-- file-specific passphrases can be utilized. 255-- file-specific passphrases can be utilized.
256makeMemoizingDecrypter :: KeyRingOperation -> InputFileContext 256makeMemoizingDecrypter :: [PassphraseSpec] -> InputFileContext
257 -> (Maybe MappedPacket, Map.Map KeyKey (OriginMapped Query)) 257 -> (Maybe MappedPacket, Map.Map KeyKey (OriginMapped Query))
258 -> IO PacketTranscoder 258 -> IO PacketTranscoder
259makeMemoizingDecrypter operation ctx (workingkey,keys) = do 259makeMemoizingDecrypter passwdspec ctx (workingkey,keys) = do
260 unkeysRef <- newIORef (Map.empty :: Map.Map (KeyKey,SymmetricAlgorithm,S2K) Packet) 260 unkeysRef <- newIORef (Map.empty :: Map.Map (KeyKey,SymmetricAlgorithm,S2K) Packet)
261 return $ tryInOrder $ map passSpecTranscoder chains ++ [ trans unkeysRef ] 261 return $ tryInOrder $ map passSpecTranscoder chains ++ [ trans unkeysRef ]
262 where 262 where
263 (chains,passpecs) = span isChain $ sort $ opPassphrases operation 263 (chains,passpecs) = span isChain $ sort passwdspec
264 where isChain (PassphraseMemoizer {}) = True 264 where isChain (PassphraseMemoizer {}) = True
265 isChain _ = False 265 isChain _ = False
266 srcs = map (interpretPassSpec ctx (workingkey,keys)) passpecs 266 srcs = map (interpretPassSpec ctx (workingkey,keys)) passpecs