more minor refactors

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
 
     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"