diff options
author | Andrew Cady <d@jerkface.net> | 2019-07-12 17:03:47 -0400 |
---|---|---|
committer | Andrew Cady <d@jerkface.net> | 2019-07-12 17:03:51 -0400 |
commit | 1045fb4edb1b673846467efd44c8b7bb44befd51 (patch) | |
tree | 58a66e6614c7775d71a9596c2f91f82fca48de29 /lib | |
parent | 352b340868f52d4749180c1ceb63e599170abada (diff) |
use type
Diffstat (limited to 'lib')
-rw-r--r-- | lib/Kiki.hs | 26 |
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 | ||
335 | data 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. |
337 | installIpsecPeerCertificate | 344 | installIpsecPeerCertificate |
338 | :: FileWriter | 345 | :: FileWriter |
339 | -> (L.ByteString, SockAddr, KeyData) | 346 | -> IpsecPeerConfig |
340 | -> IO Char8.ByteString | 347 | -> IO Char8.ByteString |
341 | installIpsecPeerCertificate fw (contactname,addr,kd) = | 348 | installIpsecPeerCertificate 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 | ||
402 | getMkPathAndCommit :: FilePath -> IO (FileWriter) | 409 | getMkPathAndCommit :: FilePath -> IO (FileWriter) |
403 | getMkPathAndCommit destdir = do | 410 | getMkPathAndCommit 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 | ||
465 | installIpsecConf :: FileWriter -> SockAddr -> Char8.ByteString -> [(Char8.ByteString, SockAddr, KeyData)] -> IO () | 472 | installIpsecConf :: FileWriter -> SockAddr -> Char8.ByteString -> [IpsecPeerConfig] -> IO () |
466 | installIpsecConf fw wkaddr (certBasename) cs = do | 473 | installIpsecConf 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 | ||
566 | sshKeyToHostname :: Packet -> IO Char8.ByteString | 574 | sshKeyToHostname :: Packet -> IO Char8.ByteString |