diff options
Diffstat (limited to 'lib')
-rw-r--r-- | lib/Kiki.hs | 28 |
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 |
336 | installIpsecPeerCertificate fw@(FileWriter mkpath _) (contactname,addr,kd) = | 336 | installIpsecPeerCertificate 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 | |||
368 | ipsecCertPath = ipsecPath "certs" | 368 | ipsecCertPath = ipsecPath "certs" |
369 | 369 | ||
370 | write' :: FileWriter -> (FilePath -> t -> IO b) -> FilePath -> t -> IO b | 370 | write' :: FileWriter -> (FilePath -> t -> IO b) -> FilePath -> t -> IO b |
371 | write' fw wr f bs = do | 371 | write' 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 | ||
424 | generateHostsFile :: (FilePath -> FilePath) -> KeyRingRuntime -> IO () | 424 | generateHostsFile :: FileWriter -> KeyRingRuntime -> IO () |
425 | generateHostsFile mkpath rt = do | 425 | generateHostsFile (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 | ||
455 | installIpsecConf :: FileWriter -> SockAddr -> Char8.ByteString -> [(Char8.ByteString, SockAddr, KeyData)] -> IO () | 455 | installIpsecConf :: FileWriter -> SockAddr -> Char8.ByteString -> [(Char8.ByteString, SockAddr, KeyData)] -> IO () |
456 | installIpsecConf fw@(FileWriter mkpath _) wkaddr (certBasename) cs = do | 456 | installIpsecConf 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 | ||
481 | refreshCache :: KeyRingRuntime -> Maybe FilePath -> IO () | 481 | refreshCache :: KeyRingRuntime -> Maybe FilePath -> IO () |
482 | refreshCache rt rootdir = do | 482 | refreshCache 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 = | |||
525 | rethrowKikiErrors rt = unconditionally $ return rt | 525 | rethrowKikiErrors rt = unconditionally $ return rt |
526 | 526 | ||
527 | writePublicKeyFiles :: KeyRingRuntime -> FileWriter -> String -> Char8.ByteString -> SockAddr -> IO () | 527 | writePublicKeyFiles :: KeyRingRuntime -> FileWriter -> String -> Char8.ByteString -> SockAddr -> IO () |
528 | writePublicKeyFiles rt fw@(FileWriter mkpath commit) grip oname wkaddr = do | 528 | writePublicKeyFiles 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 |