summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorAndrew Cady <d@jerkface.net>2019-07-13 14:51:27 -0400
committerAndrew Cady <d@jerkface.net>2019-07-13 14:55:12 -0400
commitc88789ddfa5e6d72addc70f3106a162cf4ea18e7 (patch)
treeeceecb6aabc09a5799d00969a7992fb80ad6d5c2 /lib
parent63f03c53bcf64807fe26c28fec946502faa1651e (diff)
simplify refreshCache
Diffstat (limited to 'lib')
-rw-r--r--lib/Kiki.hs43
1 files changed, 19 insertions, 24 deletions
diff --git a/lib/Kiki.hs b/lib/Kiki.hs
index 58dfa20..5481241 100644
--- a/lib/Kiki.hs
+++ b/lib/Kiki.hs
@@ -38,7 +38,6 @@ import System.Posix.Types (FileMode)
38import System.Posix.IO as Posix (createPipe) 38import System.Posix.IO as Posix (createPipe)
39import System.Posix.User 39import System.Posix.User
40#if defined(VERSION_memory) 40#if defined(VERSION_memory)
41import Data.ByteArray (convert)
42import Data.ByteArray.Encoding 41import Data.ByteArray.Encoding
43import qualified Data.ByteString.Char8 as S8 42import qualified Data.ByteString.Char8 as S8
44#elif defined(VERSION_dataenc) 43#elif defined(VERSION_dataenc)
@@ -48,7 +47,6 @@ import qualified Data.ByteString.Lazy as L
48import qualified Data.ByteString.Lazy.Char8 as Char8 47import qualified Data.ByteString.Lazy.Char8 as Char8
49import qualified Data.Map.Strict as Map 48import qualified Data.Map.Strict as Map
50import Network.Socket 49import Network.Socket
51import ProcessUtils
52import qualified SSHKey as SSH 50import qualified SSHKey as SSH
53 51
54import CommandLine 52import CommandLine
@@ -378,10 +376,10 @@ ipsecPath :: String -> Char8.ByteString -> String
378ipsecPath theDirName theBaseName = "ipsec.d/" ++ theDirName ++ "/" ++ Char8.unpack theBaseName 376ipsecPath theDirName theBaseName = "ipsec.d/" ++ theDirName ++ "/" ++ Char8.unpack theBaseName
379 377
380ipsecKeyPath :: MyIdentity -> FilePath 378ipsecKeyPath :: MyIdentity -> FilePath
381ipsecKeyPath (MyIdentity (Char8.pack . showA -> addr)) = ipsecPath "private" (addr <> ".pem") 379ipsecKeyPath (MyIdentity (Char8.pack . showA -> addr) _) = ipsecPath "private" (addr <> ".pem")
382 380
383ipsecCertPath :: MyIdentity -> FilePath 381ipsecCertPath :: MyIdentity -> FilePath
384ipsecCertPath (MyIdentity (Char8.pack . showA -> addr)) = ipsecPath "certs" (addr <> ".pem") 382ipsecCertPath (MyIdentity (Char8.pack . showA -> addr) _) = ipsecPath "certs" (addr <> ".pem")
385 383
386peerCertPath :: Peer -> FilePath 384peerCertPath :: Peer -> FilePath
387peerCertPath = ipsecPath "certs" . coerce . peerCertificateName 385peerCertPath = ipsecPath "certs" . coerce . peerCertificateName
@@ -475,11 +473,12 @@ getSshKnownHosts peer@Peer{kd} = Char8.unlines taggedblobs
475 map ((coerce n <> " ") <>) blobs 473 map ((coerce n <> " ") <>) blobs
476 474
477data MyIdentity = MyIdentity { 475data MyIdentity = MyIdentity {
478 myGpgAddress :: SockAddr 476 myGpgAddress :: SockAddr,
477 myGpgKeyGrip :: String
479} 478}
480 479
481installIpsecConf :: FileWriter -> MyIdentity -> [Peer] -> IO () 480installIpsecConf :: FileWriter -> MyIdentity -> [Peer] -> IO ()
482installIpsecConf fw (MyIdentity wkaddr) cs = do 481installIpsecConf fw MyIdentity{myGpgAddress} cs = do
483 snippets <- mapM (coerce . installIpsecPeerCertificate fw) cs 482 snippets <- mapM (coerce . installIpsecPeerCertificate fw) cs
484 writeL fw "ipsec.conf" . Char8.unlines 483 writeL fw "ipsec.conf" . Char8.unlines
485 $ [ "conn %default" 484 $ [ "conn %default"
@@ -491,10 +490,10 @@ installIpsecConf fw (MyIdentity wkaddr) cs = do
491 , " dpddelay=10s" 490 , " dpddelay=10s"
492 , " dpdaction=restart" 491 , " dpdaction=restart"
493 , " left=%defaultroute" 492 , " left=%defaultroute"
494 , " leftsubnet=" <> Char8.pack (showA wkaddr) <> "/128" 493 , " leftsubnet=" <> Char8.pack (showA myGpgAddress) <> "/128"
495 , " leftauth=pubkey" 494 , " leftauth=pubkey"
496 , " leftid=" <> Char8.pack (showA wkaddr) 495 , " leftid=" <> Char8.pack (showA myGpgAddress)
497 , " leftsigkey=" <> Char8.pack (showA wkaddr) <> ".pem" 496 , " leftsigkey=" <> Char8.pack (showA myGpgAddress) <> ".pem"
498 , " leftikeport=4500" 497 , " leftikeport=4500"
499 , " rightikeport=4500" 498 , " rightikeport=4500"
500 , " right=%any" 499 , " right=%any"
@@ -504,25 +503,21 @@ installIpsecConf fw (MyIdentity wkaddr) cs = do
504 , "" 503 , ""
505 ] ++ filter (not . Char8.null) snippets 504 ] ++ filter (not . Char8.null) snippets
506 505
506getMyIdentity :: KeyRingRuntime -> Maybe MyIdentity
507getMyIdentity rt = do
508 wk <- rtWorkingKey rt
509 Hostnames wkaddr _ _ _ <- Just $ getHostnames (byKeyKey (rtKeyDB rt) Map.! keykey wk)
510 return $ MyIdentity wkaddr (fingerprint wk)
511
507refreshCache :: KeyRingRuntime -> Maybe FilePath -> IO () 512refreshCache :: KeyRingRuntime -> Maybe FilePath -> IO ()
508refreshCache rt rootdir = do 513refreshCache rt rootdir = do
509 fw <- getMkPathAndCommit (fromMaybe "" rootdir ++ "/var/cache/kiki/config") 514 fw <- getMkPathAndCommit (fromMaybe "" rootdir ++ "/var/cache/kiki/config")
510 generateHostsFile fw rt 515 generateHostsFile fw rt
511 fromMaybe (error "No working key.") $ do 516 fromMaybe (error "No working key.") $ do
512 wk <- rtWorkingKey rt 517 myId <- getMyIdentity rt
513 Hostnames wkaddr onames _ _ <- Just $ getHostnames (byKeyKey (rtKeyDB rt) Map.! keykey wk)
514 Just $ do 518 Just $ do
515 let oname = Char8.concat $ take 1 onames
516 if (oname == "") then error "Missing tor key" else do
517 -- sshcpathpub0 = fromMaybe "" rootdir ++ osHomeDir </> ".ssh" </> "id_rsa.pub"
518 -- sshspathpub0 = fromMaybe "" rootdir ++ "/etc/ssh/ssh_host_rsa_key.pub"
519 -- contactipsec0 = fromMaybe "" rootdir ++ "/etc/ipsec.d/certs/%(onion).pem"
520
521 flip (maybe $ warn "missing working key?") (rtWorkingKey rt) $ \wk -> do
522 519
523 let grip = fingerprint wk 520 let exportOp = passphrases <> pemSecrets
524 myId = MyIdentity wkaddr
525 exportOp = passphrases <> pemSecrets
526 <> minimalOp False 521 <> minimalOp False
527 (CommonArgsParsed (Just $ takeDirectory $ rtPubring rt) 522 (CommonArgsParsed (Just $ takeDirectory $ rtPubring rt)
528 Nothing) 523 Nothing)
@@ -547,7 +542,7 @@ refreshCache rt rootdir = do
547 outputReport report 542 outputReport report
548 -- outputReport $ map (first $ resolveForReport ctx) $ filter ((/=ExportedSubkey) . snd) report 543 -- outputReport $ map (first $ resolveForReport ctx) $ filter ((/=ExportedSubkey) . snd) report
549 rt'' <- rethrowKikiErrors rt' 544 rt'' <- rethrowKikiErrors rt'
550 writePublicKeyFiles rt'' fw grip myId 545 writePublicKeyFiles rt'' fw myId
551 546
552rethrowKikiErrors :: KikiCondition a -> IO a 547rethrowKikiErrors :: KikiCondition a -> IO a
553rethrowKikiErrors BadPassphrase = 548rethrowKikiErrors BadPassphrase =
@@ -567,8 +562,8 @@ listPeers rt = map (uncurry Peer) . filter notme . mapMaybe namedContact . Map.e
567 _ <- listToMaybe $ allNames h 562 _ <- listToMaybe $ allNames h
568 return (h, kd) 563 return (h, kd)
569 564
570writePublicKeyFiles :: KeyRingRuntime -> FileWriter -> String -> MyIdentity -> IO () 565writePublicKeyFiles :: KeyRingRuntime -> FileWriter -> MyIdentity -> IO ()
571writePublicKeyFiles rt fw grip myId = do 566writePublicKeyFiles rt fw myId@(MyIdentity _ grip) = do
572 567
573 -- Finally, export public keys if they do not exist. 568 -- Finally, export public keys if they do not exist.
574 either warn (write fw "root/.ssh/id_rsa.pub") $ show_ssh' "ssh-client" grip (rtKeyDB rt) 569 either warn (write fw "root/.ssh/id_rsa.pub") $ show_ssh' "ssh-client" grip (rtKeyDB rt)