summaryrefslogtreecommitdiff
path: root/lib/Kiki.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Kiki.hs')
-rw-r--r--lib/Kiki.hs61
1 files changed, 33 insertions, 28 deletions
diff --git a/lib/Kiki.hs b/lib/Kiki.hs
index af62a97..7bf0e3d 100644
--- a/lib/Kiki.hs
+++ b/lib/Kiki.hs
@@ -324,19 +324,22 @@ importAndRefresh root cmn cipher = do
324 324
325 when (not bUnprivileged) $ refreshCache rt rootdir 325 when (not bUnprivileged) $ refreshCache rt rootdir
326 326
327 327-- Installs the cert file for the peer to the filesystem, and returns an
328-- We find all cross-certified ipsec keys for the given cross-certified onion name. 328-- ipsec.conf snippet configuring the peer and referencing the installed cert
329installContact 329-- file.
330installIpsecPeerCertificate
330 :: (FilePath -> FilePath) 331 :: (FilePath -> FilePath)
331 -> (L.ByteString, SockAddr, KeyData) 332 -> (L.ByteString, SockAddr, KeyData)
332 -> IO Char8.ByteString 333 -> IO Char8.ByteString
333installContact mkpath (contactname,addr,kd) = 334installIpsecPeerCertificate mkpath (contactname,addr,kd) =
334 Char8.concat <$> do 335 Char8.concat <$> do
335 forM (take 1 ipsecs) $ \k -> do 336 forM (take 1 ipsecs) $ \k -> do
336 flip (either warn') (pemFromPacket k :: Either String String) $ \pem -> do 337 flip (either warn') (pemFromPacket k :: Either String String) $ \pem -> do
337 write (mkpath cpath) pem
338 case sshs of 338 case sshs of
339 (sshkey:_) -> strongswanForContact addr contactname <$> sshKeyToHostname sshkey 339 (sshkey:_) -> do
340 theirHostname <- sshKeyToHostname sshkey
341 write (mkpath $ ipsecCertPath theirHostname) pem
342 return $ strongswanPeerConfiguration addr contactname theirHostname
340 _ -> error "fuck." 343 _ -> error "fuck."
341 where 344 where
342 warn' x = warn x >> return Char8.empty 345 warn' x = warn x >> return Char8.empty
@@ -353,9 +356,14 @@ installContact mkpath (contactname,addr,kd) =
353 sshs = sortOn (Down . timestamp) 356 sshs = sortOn (Down . timestamp)
354 $ getSubkeys CrossSigned their_master (keySubKeys kd) "ssh-server" 357 $ getSubkeys CrossSigned their_master (keySubKeys kd) "ssh-server"
355 358
356 cpath :: FilePath 359ipsecPath :: String -> Char8.ByteString -> String
357 cpath = interp (Map.singleton "onion" (Char8.unpack contactname)) "ipsec.d/certs/%(onion).pem" 360ipsecPath theDirName theBaseName = "ipsec.d/" ++ theDirName ++ "/" ++ Char8.unpack theBaseName ++ ".pem"
361
362ipsecKeyPath :: Char8.ByteString -> FilePath
363ipsecKeyPath = ipsecPath "private"
358 364
365ipsecCertPath :: Char8.ByteString -> FilePath
366ipsecCertPath = ipsecPath "certs"
359 367
360write' :: (FilePath -> t -> IO b) -> FilePath -> t -> IO b 368write' :: (FilePath -> t -> IO b) -> FilePath -> t -> IO b
361write' wr f bs = do 369write' wr f bs = do
@@ -426,8 +434,8 @@ names rt = do wk <- rtWorkingKey rt
426 -- XXX unnecessary signature check 434 -- XXX unnecessary signature check
427 return $ getHostnames (rtKeyDB rt Map.! keykey wk) 435 return $ getHostnames (rtKeyDB rt Map.! keykey wk)
428 436
429getssh :: (Char8.ByteString, t, KeyData) -> Char8.ByteString 437getssh :: (Char8.ByteString, SockAddr, KeyData) -> Char8.ByteString
430getssh (contactname,addr,kd) = do 438getssh (contactname,_addr,kd) = do
431 let their_master = packet $ keyMappedPacket kd 439 let their_master = packet $ keyMappedPacket kd
432 sshs :: [Packet] 440 sshs :: [Packet]
433 sshs = sortOn (Down . timestamp) 441 sshs = sortOn (Down . timestamp)
@@ -437,9 +445,10 @@ getssh (contactname,addr,kd) = do
437 Char8.unlines taggedblobs 445 Char8.unlines taggedblobs
438 446
439 447
440writeIpsecConf :: FilePath -> SockAddr -> Char8.ByteString -> [Char8.ByteString] -> IO () 448installIpsecConf :: (FilePath -> FilePath) -> SockAddr -> Char8.ByteString -> [(Char8.ByteString, SockAddr, KeyData)] -> IO ()
441writeIpsecConf p wkaddr oname cons = 449installIpsecConf mkpath wkaddr (certBasename) cs = do
442 writeL p . Char8.unlines 450 snippets <- mapM (installIpsecPeerCertificate mkpath) cs
451 writeL (mkpath "ipsec.conf") . Char8.unlines
443 $ [ "conn %default" 452 $ [ "conn %default"
444 , " ikelifetime=60m" 453 , " ikelifetime=60m"
445 , " keylife=20m" 454 , " keylife=20m"
@@ -452,7 +461,7 @@ writeIpsecConf p wkaddr oname cons =
452 , " leftsubnet=" <> Char8.pack (showA wkaddr) <> "/128" 461 , " leftsubnet=" <> Char8.pack (showA wkaddr) <> "/128"
453 , " leftauth=pubkey" 462 , " leftauth=pubkey"
454 , " leftid=" <> Char8.pack (showA wkaddr) 463 , " leftid=" <> Char8.pack (showA wkaddr)
455 , " leftrsasigkey=" <> oname <> ".pem" 464 , " leftrsasigkey=" <> certBasename
456 , " leftikeport=4500" 465 , " leftikeport=4500"
457 , " rightikeport=4500" 466 , " rightikeport=4500"
458 , " right=%any" 467 , " right=%any"
@@ -460,7 +469,7 @@ writeIpsecConf p wkaddr oname cons =
460 , " type=tunnel" 469 , " type=tunnel"
461 , " auto=route" 470 , " auto=route"
462 , "" 471 , ""
463 ] ++ filter (not . Char8.null) cons 472 ] ++ filter (not . Char8.null) snippets
464 473
465refreshCache :: KeyRingRuntime -> Maybe FilePath -> IO () 474refreshCache :: KeyRingRuntime -> Maybe FilePath -> IO ()
466refreshCache rt rootdir = do 475refreshCache rt rootdir = do
@@ -483,7 +492,7 @@ refreshCache rt rootdir = do
483 where 492 where
484 passphrases = mempty { opPassphrases = [PassphraseMemoizer (rtPassphrases rt)] } 493 passphrases = mempty { opPassphrases = [PassphraseMemoizer (rtPassphrases rt)] }
485 pemSecrets = mempty { opFiles = Map.fromList 494 pemSecrets = mempty { opFiles = Map.fromList
486 [ send "ipsec" (mkpath "ipsec.d/private/" ++ Char8.unpack oname++".pem") "missing ipsec key?" 495 [ send "ipsec" (mkpath $ ipsecKeyPath oname) "missing ipsec key?"
487 , send "ssh-client" (mkpath "root/.ssh/id_rsa") "missing ssh-client key?" 496 , send "ssh-client" (mkpath "root/.ssh/id_rsa") "missing ssh-client key?"
488 , send "ssh-server" (mkpath "ssh_host_rsa_key") "missing ssh host key?" 497 , send "ssh-server" (mkpath "ssh_host_rsa_key") "missing ssh host key?"
489 , send "tor" (mkpath "tor/private_key") "missing tor key?" 498 , send "tor" (mkpath "tor/private_key") "missing tor key?"
@@ -512,12 +521,9 @@ writePublicKeyFiles :: KeyRingRuntime -> (FilePath -> FilePath) -> String -> Cha
512writePublicKeyFiles rt mkpath grip oname wkaddr commit = do 521writePublicKeyFiles rt mkpath grip oname wkaddr commit = do
513 522
514 -- Finally, export public keys if they do not exist. 523 -- Finally, export public keys if they do not exist.
515 either warn (write $ mkpath "root/.ssh/id_rsa.pub") 524 either warn (write $ mkpath "root/.ssh/id_rsa.pub") $ show_ssh' "ssh-client" grip (rtKeyDB rt)
516 $ show_ssh' "ssh-client" grip (rtKeyDB rt) 525 either warn (write $ mkpath "ssh_host_rsa_key.pub") $ show_ssh' "ssh-server" grip (rtKeyDB rt)
517 either warn (write $ mkpath "ssh_host_rsa_key.pub") 526 either warn (write $ mkpath $ ipsecCertPath oname) $ show_pem' "ipsec" grip (rtKeyDB rt) pemFromPacket
518 $ show_ssh' "ssh-server" grip (rtKeyDB rt)
519 either warn (write $ mkpath "ipsec.d/certs/" ++ Char8.unpack oname++".pem")
520 $ show_pem' "ipsec" grip (rtKeyDB rt) pemFromPacket
521 527
522 let onionkeys = mapMaybe namedContact $ Map.elems $ rtKeyDB rt 528 let onionkeys = mapMaybe namedContact $ Map.elems $ rtKeyDB rt
523 cs = filter (\(_,_,kd) -> notme kd) onionkeys 529 cs = filter (\(_,_,kd) -> notme kd) onionkeys
@@ -534,9 +540,7 @@ writePublicKeyFiles rt mkpath grip oname wkaddr commit = do
534 540
535 writeL (mkpath "ssh_known_hosts") known_hosts 541 writeL (mkpath "ssh_known_hosts") known_hosts
536 542
537 cons <- mapM (installContact mkpath) cs 543 installIpsecConf mkpath wkaddr (Char8.pack $ takeBaseName $ ipsecCertPath oname) cs
538
539 writeIpsecConf (mkpath "ipsec.conf") wkaddr oname cons
540 commit 544 commit
541 545
542sshKeyToHostname :: Packet -> IO Char8.ByteString 546sshKeyToHostname :: Packet -> IO Char8.ByteString
@@ -545,10 +549,11 @@ sshKeyToHostname sshkey = do
545 return $ Char8.fromChunks [sout] 549 return $ Char8.fromChunks [sout]
546 where 550 where
547 shellScript = 551 shellScript =
548 "f=$(mktemp) && cat > \"$f\" && ssh-keygen -r _ -f \"$f\" | (read _ _ _ _ _ hash _ && echo -n $hash.ssh.cryptonomic.net)" 552 "f=$(mktemp) && cat > \"$f\" && ssh-keygen -r _ -f \"$f\" |" ++
553 " (read _ _ _ _ _ hash _ && echo -n $hash.ssh.cryptonomic.net); r=$?; rm -f \"$f\"; exit $r"
549 554
550strongswanForContact :: SockAddr -> Char8.ByteString -> Char8.ByteString -> Char8.ByteString 555strongswanPeerConfiguration :: SockAddr -> Char8.ByteString -> Char8.ByteString -> Char8.ByteString
551strongswanForContact addr oname rightip = Char8.unlines 556strongswanPeerConfiguration addr oname rightip = Char8.unlines
552 [ "conn " <> oname 557 [ "conn " <> oname
553 , " right=" <> rightip 558 , " right=" <> rightip
554 , " rightsubnet=" <> p (showA addr) <> "/128" 559 , " rightsubnet=" <> p (showA addr) <> "/128"