summaryrefslogtreecommitdiff
path: root/lib/Kiki.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Kiki.hs')
-rw-r--r--lib/Kiki.hs26
1 files changed, 17 insertions, 9 deletions
diff --git a/lib/Kiki.hs b/lib/Kiki.hs
index 4fb19ff..7fc96b3 100644
--- a/lib/Kiki.hs
+++ b/lib/Kiki.hs
@@ -1,3 +1,4 @@
1{-# LANGUAGE RecordWildCards #-}
1{-# LANGUAGE ViewPatterns #-} 2{-# LANGUAGE ViewPatterns #-}
2{-# LANGUAGE CPP #-} 3{-# LANGUAGE CPP #-}
3{-# LANGUAGE OverloadedStrings #-} 4{-# LANGUAGE OverloadedStrings #-}
@@ -331,16 +332,22 @@ importAndRefresh root cmn cipher = do
331 -- Finally, we update /var/cache/kiki. 332 -- Finally, we update /var/cache/kiki.
332 when (not bUnprivileged) $ refreshCache rt rootdir 333 when (not bUnprivileged) $ refreshCache rt rootdir
333 334
335data IpsecPeerConfig = IpsecPeerConfig
336 { contactname :: Char8.ByteString
337 , addr :: SockAddr
338 , kd :: KeyData
339 }
340
334-- Installs the cert file for the peer to the filesystem, and returns an 341-- Installs the cert file for the peer to the filesystem, and returns an
335-- ipsec.conf snippet configuring the peer and referencing the installed cert 342-- ipsec.conf snippet configuring the peer and referencing the installed cert
336-- file. 343-- file.
337installIpsecPeerCertificate 344installIpsecPeerCertificate
338 :: FileWriter 345 :: FileWriter
339 -> (L.ByteString, SockAddr, KeyData) 346 -> IpsecPeerConfig
340 -> IO Char8.ByteString 347 -> IO Char8.ByteString
341installIpsecPeerCertificate fw (contactname,addr,kd) = 348installIpsecPeerCertificate fw IpsecPeerConfig{..} =
342 Char8.concat <$> do 349 fromMaybe "" <$> do
343 forM (take 1 ipsecs) $ \k -> do 350 forM (listToMaybe ipsecs) $ \k -> do
344 flip (either warn') (pemFromPacket k :: Either String String) $ \pem -> do 351 flip (either warn') (pemFromPacket k :: Either String String) $ \pem -> do
345 case sshs of 352 case sshs of
346 (sshkey:_) -> do 353 (sshkey:_) -> do
@@ -399,8 +406,8 @@ data FileWriter =
399 , writeL077 :: FilePath -> Char8.ByteString -> IO FileMode 406 , writeL077 :: FilePath -> Char8.ByteString -> IO FileMode
400 } 407 }
401 408
402getMkPathAndCommit :: FilePath -> IO (FileWriter) 409getMkPathAndCommit :: FilePath -> IO (FileWriter)
403getMkPathAndCommit destdir = do 410getMkPathAndCommit destdir = do
404 let cachedir = takeDirectory destdir 411 let cachedir = takeDirectory destdir
405 unslash ('/':xs) = xs 412 unslash ('/':xs) = xs
406 unslash xs = xs 413 unslash xs = xs
@@ -462,8 +469,8 @@ getssh (contactname,_addr,kd) = do
462 Char8.unlines taggedblobs 469 Char8.unlines taggedblobs
463 470
464 471
465installIpsecConf :: FileWriter -> SockAddr -> Char8.ByteString -> [(Char8.ByteString, SockAddr, KeyData)] -> IO () 472installIpsecConf :: FileWriter -> SockAddr -> Char8.ByteString -> [IpsecPeerConfig] -> IO ()
466installIpsecConf fw wkaddr (certBasename) cs = do 473installIpsecConf fw wkaddr certBasename cs = do
467 snippets <- mapM (installIpsecPeerCertificate fw) cs 474 snippets <- mapM (installIpsecPeerCertificate fw) cs
468 writeL fw "ipsec.conf" . Char8.unlines 475 writeL fw "ipsec.conf" . Char8.unlines
469 $ [ "conn %default" 476 $ [ "conn %default"
@@ -547,6 +554,7 @@ writePublicKeyFiles rt fw grip oname wkaddr = do
547 554
548 let onionkeys = mapMaybe namedContact $ Map.elems $ byKeyKey $ rtKeyDB rt 555 let onionkeys = mapMaybe namedContact $ Map.elems $ byKeyKey $ rtKeyDB rt
549 cs = filter (\(_,_,kd) -> notme kd) onionkeys 556 cs = filter (\(_,_,kd) -> notme kd) onionkeys
557 cs' = cs <&> \(a,b,c) -> IpsecPeerConfig a b c
550 kk = keykey (fromJust $ rtWorkingKey rt) 558 kk = keykey (fromJust $ rtWorkingKey rt)
551 notme kd = keykey (keyPacket kd) /= kk 559 notme kd = keykey (keyPacket kd) /= kk
552 560
@@ -560,7 +568,7 @@ writePublicKeyFiles rt fw grip oname wkaddr = do
560 568
561 writeL fw "ssh_known_hosts" known_hosts 569 writeL fw "ssh_known_hosts" known_hosts
562 570
563 installIpsecConf fw wkaddr (Char8.pack $ takeBaseName $ ipsecCertPath oname) cs 571 installIpsecConf fw wkaddr (Char8.pack $ takeBaseName $ ipsecCertPath oname) cs'
564 fileWriterCommit fw 572 fileWriterCommit fw
565 573
566sshKeyToHostname :: Packet -> IO Char8.ByteString 574sshKeyToHostname :: Packet -> IO Char8.ByteString