summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--lib/Kiki.hs44
1 files changed, 22 insertions, 22 deletions
diff --git a/lib/Kiki.hs b/lib/Kiki.hs
index 3a1028b..e782d8a 100644
--- a/lib/Kiki.hs
+++ b/lib/Kiki.hs
@@ -330,17 +330,17 @@ importAndRefresh root cmn cipher = do
330-- ipsec.conf snippet configuring the peer and referencing the installed cert 330-- ipsec.conf snippet configuring the peer and referencing the installed cert
331-- file. 331-- file.
332installIpsecPeerCertificate 332installIpsecPeerCertificate
333 :: (FilePath -> FilePath) 333 :: FileWriter
334 -> (L.ByteString, SockAddr, KeyData) 334 -> (L.ByteString, SockAddr, KeyData)
335 -> IO Char8.ByteString 335 -> IO Char8.ByteString
336installIpsecPeerCertificate mkpath (contactname,addr,kd) = 336installIpsecPeerCertificate fw@(FileWriter mkpath _) (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 (mkpath $ ipsecCertPath theirHostname) pem 343 write fw (mkpath $ 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
@@ -367,21 +367,21 @@ ipsecKeyPath = ipsecPath "private"
367ipsecCertPath :: Char8.ByteString -> FilePath 367ipsecCertPath :: Char8.ByteString -> FilePath
368ipsecCertPath = ipsecPath "certs" 368ipsecCertPath = ipsecPath "certs"
369 369
370write' :: (FilePath -> t -> IO b) -> FilePath -> t -> IO b 370write' :: FileWriter -> (FilePath -> t -> IO b) -> FilePath -> t -> IO b
371write' wr f bs = do 371write' fw wr f bs = do
372 createDirectoryIfMissing True $ takeDirectory f 372 createDirectoryIfMissing True $ takeDirectory f
373 wr f bs 373 wr f bs
374 374
375write :: FilePath -> String -> IO () 375write :: FileWriter -> FilePath -> String -> IO ()
376write = write' writeFile 376write fw = write' fw writeFile
377 377
378writeL :: FilePath -> Char8.ByteString -> IO () 378writeL :: FileWriter -> FilePath -> Char8.ByteString -> IO ()
379writeL = write' L.writeFile 379writeL fw = write' fw L.writeFile
380 380
381writeL077 :: FilePath -> Char8.ByteString -> IO FileMode 381writeL077 :: FileWriter -> FilePath -> Char8.ByteString -> IO FileMode
382writeL077 f bs = do 382writeL077 fw f bs = do
383 old_umask <- setFileCreationMask 0o077 383 old_umask <- setFileCreationMask 0o077
384 writeL f bs 384 writeL fw f bs
385 setFileCreationMask old_umask 385 setFileCreationMask old_umask
386 386
387data FileWriter = FileWriter { 387data FileWriter = FileWriter {
@@ -452,10 +452,10 @@ getssh (contactname,_addr,kd) = do
452 Char8.unlines taggedblobs 452 Char8.unlines taggedblobs
453 453
454 454
455installIpsecConf :: (FilePath -> FilePath) -> SockAddr -> Char8.ByteString -> [(Char8.ByteString, SockAddr, KeyData)] -> IO () 455installIpsecConf :: FileWriter -> SockAddr -> Char8.ByteString -> [(Char8.ByteString, SockAddr, KeyData)] -> IO ()
456installIpsecConf mkpath wkaddr (certBasename) cs = do 456installIpsecConf fw@(FileWriter mkpath _) wkaddr (certBasename) cs = do
457 snippets <- mapM (installIpsecPeerCertificate mkpath) cs 457 snippets <- mapM (installIpsecPeerCertificate fw) cs
458 writeL (mkpath "ipsec.conf") . Char8.unlines 458 writeL fw (mkpath "ipsec.conf") . Char8.unlines
459 $ [ "conn %default" 459 $ [ "conn %default"
460 , " ikelifetime=60m" 460 , " ikelifetime=60m"
461 , " keylife=20m" 461 , " keylife=20m"
@@ -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 (FileWriter mkpath commit) grip oname wkaddr = do 528writePublicKeyFiles rt fw@(FileWriter mkpath 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 $ mkpath "root/.ssh/id_rsa.pub") $ show_ssh' "ssh-client" grip (rtKeyDB rt) 531 either warn (write fw $ mkpath "root/.ssh/id_rsa.pub") $ show_ssh' "ssh-client" grip (rtKeyDB rt)
532 either warn (write $ mkpath "ssh_host_rsa_key.pub") $ show_ssh' "ssh-server" grip (rtKeyDB rt) 532 either warn (write fw $ mkpath "ssh_host_rsa_key.pub") $ show_ssh' "ssh-server" grip (rtKeyDB rt)
533 either warn (write $ mkpath $ ipsecCertPath oname) $ show_pem' "ipsec" grip (rtKeyDB rt) pemFromPacket 533 either warn (write fw $ mkpath $ 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,9 +545,9 @@ writePublicKeyFiles rt (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 (mkpath "ssh_known_hosts") known_hosts 548 writeL fw (mkpath "ssh_known_hosts") known_hosts
549 549
550 installIpsecConf mkpath wkaddr (Char8.pack $ takeBaseName $ ipsecCertPath oname) cs 550 installIpsecConf fw wkaddr (Char8.pack $ takeBaseName $ ipsecCertPath oname) cs
551 commit 551 commit
552 552
553sshKeyToHostname :: Packet -> IO Char8.ByteString 553sshKeyToHostname :: Packet -> IO Char8.ByteString