summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/Kiki.hs28
1 files changed, 14 insertions, 14 deletions
diff --git a/lib/Kiki.hs b/lib/Kiki.hs
index e782d8a..cb77e2a 100644
--- a/lib/Kiki.hs
+++ b/lib/Kiki.hs
@@ -333,14 +333,14 @@ installIpsecPeerCertificate
333 :: FileWriter 333 :: FileWriter
334 -> (L.ByteString, SockAddr, KeyData) 334 -> (L.ByteString, SockAddr, KeyData)
335 -> IO Char8.ByteString 335 -> IO Char8.ByteString
336installIpsecPeerCertificate fw@(FileWriter mkpath _) (contactname,addr,kd) = 336installIpsecPeerCertificate fw (contactname,addr,kd) =
337 Char8.concat <$> do 337 Char8.concat <$> do
338 forM (take 1 ipsecs) $ \k -> do 338 forM (take 1 ipsecs) $ \k -> do
339 flip (either warn') (pemFromPacket k :: Either String String) $ \pem -> do 339 flip (either warn') (pemFromPacket k :: Either String String) $ \pem -> do
340 case sshs of 340 case sshs of
341 (sshkey:_) -> do 341 (sshkey:_) -> do
342 theirHostname <- sshKeyToHostname sshkey 342 theirHostname <- sshKeyToHostname sshkey
343 write fw (mkpath $ ipsecCertPath theirHostname) pem 343 write fw (ipsecCertPath theirHostname) pem
344 return $ strongswanPeerConfiguration addr contactname theirHostname 344 return $ strongswanPeerConfiguration addr contactname theirHostname
345 _ -> error "fuck." 345 _ -> error "fuck."
346 where 346 where
@@ -368,7 +368,7 @@ ipsecCertPath :: Char8.ByteString -> FilePath
368ipsecCertPath = ipsecPath "certs" 368ipsecCertPath = ipsecPath "certs"
369 369
370write' :: FileWriter -> (FilePath -> t -> IO b) -> FilePath -> t -> IO b 370write' :: FileWriter -> (FilePath -> t -> IO b) -> FilePath -> t -> IO b
371write' fw wr f bs = do 371write' fw@(FileWriter mkpath _) wr (mkpath -> f) bs = do
372 createDirectoryIfMissing True $ takeDirectory f 372 createDirectoryIfMissing True $ takeDirectory f
373 wr f bs 373 wr f bs
374 374
@@ -421,8 +421,8 @@ getMkPathAndCommit destdir = do
421 -- return (mkpath pth) 421 -- return (mkpath pth)
422 return $ FileWriter mkpath commit 422 return $ FileWriter mkpath commit
423 423
424generateHostsFile :: (FilePath -> FilePath) -> KeyRingRuntime -> IO () 424generateHostsFile :: FileWriter -> KeyRingRuntime -> IO ()
425generateHostsFile mkpath rt = do 425generateHostsFile (FileWriter mkpath _) rt = do
426 let hostspath = mkpath "hosts" 426 let hostspath = mkpath "hosts"
427 op = KeyRingOperation 427 op = KeyRingOperation
428 { opFiles = Map.fromList $ 428 { opFiles = Map.fromList $
@@ -453,9 +453,9 @@ getssh (contactname,_addr,kd) = do
453 453
454 454
455installIpsecConf :: FileWriter -> SockAddr -> Char8.ByteString -> [(Char8.ByteString, SockAddr, KeyData)] -> IO () 455installIpsecConf :: FileWriter -> SockAddr -> Char8.ByteString -> [(Char8.ByteString, SockAddr, KeyData)] -> IO ()
456installIpsecConf fw@(FileWriter mkpath _) wkaddr (certBasename) cs = do 456installIpsecConf fw wkaddr (certBasename) cs = do
457 snippets <- mapM (installIpsecPeerCertificate fw) cs 457 snippets <- mapM (installIpsecPeerCertificate fw) cs
458 writeL fw (mkpath "ipsec.conf") . Char8.unlines 458 writeL fw "ipsec.conf" . Char8.unlines
459 $ [ "conn %default" 459 $ [ "conn %default"
460 , " ikelifetime=60m" 460 , " ikelifetime=60m"
461 , " keylife=20m" 461 , " keylife=20m"
@@ -480,8 +480,8 @@ installIpsecConf fw@(FileWriter mkpath _) wkaddr (certBasename) cs = do
480 480
481refreshCache :: KeyRingRuntime -> Maybe FilePath -> IO () 481refreshCache :: KeyRingRuntime -> Maybe FilePath -> IO ()
482refreshCache rt rootdir = do 482refreshCache rt rootdir = do
483 fw@(FileWriter mkpath commit) <- getMkPathAndCommit (fromMaybe "" rootdir ++ "/var/cache/kiki/config") 483 fw@(FileWriter mkpath _) <- getMkPathAndCommit (fromMaybe "" rootdir ++ "/var/cache/kiki/config")
484 generateHostsFile mkpath rt 484 generateHostsFile fw rt
485 fromMaybe (error "No working key.") $ do 485 fromMaybe (error "No working key.") $ do
486 Hostnames wkaddr onames _ _ <- names rt 486 Hostnames wkaddr onames _ _ <- names rt
487 Just $ do 487 Just $ do
@@ -525,12 +525,12 @@ rethrowKikiErrors BadPassphrase =
525rethrowKikiErrors rt = unconditionally $ return rt 525rethrowKikiErrors rt = unconditionally $ return rt
526 526
527writePublicKeyFiles :: KeyRingRuntime -> FileWriter -> String -> Char8.ByteString -> SockAddr -> IO () 527writePublicKeyFiles :: KeyRingRuntime -> FileWriter -> String -> Char8.ByteString -> SockAddr -> IO ()
528writePublicKeyFiles rt fw@(FileWriter mkpath commit) grip oname wkaddr = do 528writePublicKeyFiles rt fw@(FileWriter _ commit) grip oname wkaddr = do
529 529
530 -- Finally, export public keys if they do not exist. 530 -- Finally, export public keys if they do not exist.
531 either warn (write fw $ mkpath "root/.ssh/id_rsa.pub") $ show_ssh' "ssh-client" grip (rtKeyDB rt) 531 either warn (write fw "root/.ssh/id_rsa.pub") $ show_ssh' "ssh-client" grip (rtKeyDB rt)
532 either warn (write fw $ mkpath "ssh_host_rsa_key.pub") $ show_ssh' "ssh-server" grip (rtKeyDB rt) 532 either warn (write fw "ssh_host_rsa_key.pub") $ show_ssh' "ssh-server" grip (rtKeyDB rt)
533 either warn (write fw $ mkpath $ ipsecCertPath oname) $ show_pem' "ipsec" grip (rtKeyDB rt) pemFromPacket 533 either warn (write fw $ ipsecCertPath oname) $ show_pem' "ipsec" grip (rtKeyDB rt) pemFromPacket
534 534
535 let onionkeys = mapMaybe namedContact $ Map.elems $ rtKeyDB rt 535 let onionkeys = mapMaybe namedContact $ Map.elems $ rtKeyDB rt
536 cs = filter (\(_,_,kd) -> notme kd) onionkeys 536 cs = filter (\(_,_,kd) -> notme kd) onionkeys
@@ -545,7 +545,7 @@ writePublicKeyFiles rt fw@(FileWriter mkpath commit) grip oname wkaddr = do
545 545
546 known_hosts = L.concat $ map getssh onionkeys 546 known_hosts = L.concat $ map getssh onionkeys
547 547
548 writeL fw (mkpath "ssh_known_hosts") known_hosts 548 writeL fw "ssh_known_hosts" known_hosts
549 549
550 installIpsecConf fw wkaddr (Char8.pack $ takeBaseName $ ipsecCertPath oname) cs 550 installIpsecConf fw wkaddr (Char8.pack $ takeBaseName $ ipsecCertPath oname) cs
551 commit 551 commit