From 2899baa5ea5ffeb05c06990a8fd3762a1693b221 Mon Sep 17 00:00:00 2001 From: Andrew Cady Date: Wed, 3 Jul 2019 18:44:59 -0400 Subject: more minor refactors --- lib/Kiki.hs | 61 +++++++++++++++++++++++++++++++++---------------------------- 1 file 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 when (not bUnprivileged) $ refreshCache rt rootdir - --- We find all cross-certified ipsec keys for the given cross-certified onion name. -installContact +-- Installs the cert file for the peer to the filesystem, and returns an +-- ipsec.conf snippet configuring the peer and referencing the installed cert +-- file. +installIpsecPeerCertificate :: (FilePath -> FilePath) -> (L.ByteString, SockAddr, KeyData) -> IO Char8.ByteString -installContact mkpath (contactname,addr,kd) = +installIpsecPeerCertificate mkpath (contactname,addr,kd) = Char8.concat <$> do forM (take 1 ipsecs) $ \k -> do flip (either warn') (pemFromPacket k :: Either String String) $ \pem -> do - write (mkpath cpath) pem case sshs of - (sshkey:_) -> strongswanForContact addr contactname <$> sshKeyToHostname sshkey + (sshkey:_) -> do + theirHostname <- sshKeyToHostname sshkey + write (mkpath $ ipsecCertPath theirHostname) pem + return $ strongswanPeerConfiguration addr contactname theirHostname _ -> error "fuck." where warn' x = warn x >> return Char8.empty @@ -353,9 +356,14 @@ installContact mkpath (contactname,addr,kd) = sshs = sortOn (Down . timestamp) $ getSubkeys CrossSigned their_master (keySubKeys kd) "ssh-server" - cpath :: FilePath - cpath = interp (Map.singleton "onion" (Char8.unpack contactname)) "ipsec.d/certs/%(onion).pem" +ipsecPath :: String -> Char8.ByteString -> String +ipsecPath theDirName theBaseName = "ipsec.d/" ++ theDirName ++ "/" ++ Char8.unpack theBaseName ++ ".pem" + +ipsecKeyPath :: Char8.ByteString -> FilePath +ipsecKeyPath = ipsecPath "private" +ipsecCertPath :: Char8.ByteString -> FilePath +ipsecCertPath = ipsecPath "certs" write' :: (FilePath -> t -> IO b) -> FilePath -> t -> IO b write' wr f bs = do @@ -426,8 +434,8 @@ names rt = do wk <- rtWorkingKey rt -- XXX unnecessary signature check return $ getHostnames (rtKeyDB rt Map.! keykey wk) -getssh :: (Char8.ByteString, t, KeyData) -> Char8.ByteString -getssh (contactname,addr,kd) = do +getssh :: (Char8.ByteString, SockAddr, KeyData) -> Char8.ByteString +getssh (contactname,_addr,kd) = do let their_master = packet $ keyMappedPacket kd sshs :: [Packet] sshs = sortOn (Down . timestamp) @@ -437,9 +445,10 @@ getssh (contactname,addr,kd) = do Char8.unlines taggedblobs -writeIpsecConf :: FilePath -> SockAddr -> Char8.ByteString -> [Char8.ByteString] -> IO () -writeIpsecConf p wkaddr oname cons = - writeL p . Char8.unlines +installIpsecConf :: (FilePath -> FilePath) -> SockAddr -> Char8.ByteString -> [(Char8.ByteString, SockAddr, KeyData)] -> IO () +installIpsecConf mkpath wkaddr (certBasename) cs = do + snippets <- mapM (installIpsecPeerCertificate mkpath) cs + writeL (mkpath "ipsec.conf") . Char8.unlines $ [ "conn %default" , " ikelifetime=60m" , " keylife=20m" @@ -452,7 +461,7 @@ writeIpsecConf p wkaddr oname cons = , " leftsubnet=" <> Char8.pack (showA wkaddr) <> "/128" , " leftauth=pubkey" , " leftid=" <> Char8.pack (showA wkaddr) - , " leftrsasigkey=" <> oname <> ".pem" + , " leftrsasigkey=" <> certBasename , " leftikeport=4500" , " rightikeport=4500" , " right=%any" @@ -460,7 +469,7 @@ writeIpsecConf p wkaddr oname cons = , " type=tunnel" , " auto=route" , "" - ] ++ filter (not . Char8.null) cons + ] ++ filter (not . Char8.null) snippets refreshCache :: KeyRingRuntime -> Maybe FilePath -> IO () refreshCache rt rootdir = do @@ -483,7 +492,7 @@ refreshCache rt rootdir = do where passphrases = mempty { opPassphrases = [PassphraseMemoizer (rtPassphrases rt)] } pemSecrets = mempty { opFiles = Map.fromList - [ send "ipsec" (mkpath "ipsec.d/private/" ++ Char8.unpack oname++".pem") "missing ipsec key?" + [ send "ipsec" (mkpath $ ipsecKeyPath oname) "missing ipsec key?" , send "ssh-client" (mkpath "root/.ssh/id_rsa") "missing ssh-client key?" , send "ssh-server" (mkpath "ssh_host_rsa_key") "missing ssh host key?" , send "tor" (mkpath "tor/private_key") "missing tor key?" @@ -512,12 +521,9 @@ writePublicKeyFiles :: KeyRingRuntime -> (FilePath -> FilePath) -> String -> Cha writePublicKeyFiles rt mkpath grip oname wkaddr commit = do -- Finally, export public keys if they do not exist. - 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/" ++ Char8.unpack oname++".pem") - $ show_pem' "ipsec" grip (rtKeyDB rt) pemFromPacket + 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 $ ipsecCertPath oname) $ show_pem' "ipsec" grip (rtKeyDB rt) pemFromPacket let onionkeys = mapMaybe namedContact $ Map.elems $ rtKeyDB rt cs = filter (\(_,_,kd) -> notme kd) onionkeys @@ -534,9 +540,7 @@ writePublicKeyFiles rt mkpath grip oname wkaddr commit = do writeL (mkpath "ssh_known_hosts") known_hosts - cons <- mapM (installContact mkpath) cs - - writeIpsecConf (mkpath "ipsec.conf") wkaddr oname cons + installIpsecConf mkpath wkaddr (Char8.pack $ takeBaseName $ ipsecCertPath oname) cs commit sshKeyToHostname :: Packet -> IO Char8.ByteString @@ -545,10 +549,11 @@ sshKeyToHostname sshkey = do return $ Char8.fromChunks [sout] where shellScript = - "f=$(mktemp) && cat > \"$f\" && ssh-keygen -r _ -f \"$f\" | (read _ _ _ _ _ hash _ && echo -n $hash.ssh.cryptonomic.net)" + "f=$(mktemp) && cat > \"$f\" && ssh-keygen -r _ -f \"$f\" |" ++ + " (read _ _ _ _ _ hash _ && echo -n $hash.ssh.cryptonomic.net); r=$?; rm -f \"$f\"; exit $r" -strongswanForContact :: SockAddr -> Char8.ByteString -> Char8.ByteString -> Char8.ByteString -strongswanForContact addr oname rightip = Char8.unlines +strongswanPeerConfiguration :: SockAddr -> Char8.ByteString -> Char8.ByteString -> Char8.ByteString +strongswanPeerConfiguration addr oname rightip = Char8.unlines [ "conn " <> oname , " right=" <> rightip , " rightsubnet=" <> p (showA addr) <> "/128" -- cgit v1.2.3