summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndrew Cady <d@jerkface.net>2019-07-10 05:46:15 -0400
committerAndrew Cady <d@jerkface.net>2019-07-10 05:46:15 -0400
commit5370ed32b53758b8036f6ad6f5b1a7c0fafa39e7 (patch)
treedb72520271a8ac8bf27dca890524e936246d91ea
parentf89d7cc984dd780159906dbd9f37371c057c467d (diff)
use a type (FileWriter)
-rw-r--r--lib/Kiki.hs27
1 files changed, 16 insertions, 11 deletions
diff --git a/lib/Kiki.hs b/lib/Kiki.hs
index 8ceda99..3a1028b 100644
--- a/lib/Kiki.hs
+++ b/lib/Kiki.hs
@@ -384,7 +384,12 @@ writeL077 f bs = do
384 writeL f bs 384 writeL f bs
385 setFileCreationMask old_umask 385 setFileCreationMask old_umask
386 386
387getMkPathAndCommit :: FilePath -> IO (FilePath -> FilePath, IO ()) 387data FileWriter = FileWriter {
388 pathMaker :: FilePath -> FilePath,
389 fileWriterCommit :: IO ()
390}
391
392getMkPathAndCommit :: FilePath -> IO (FileWriter)
388getMkPathAndCommit destdir = do 393getMkPathAndCommit destdir = do
389 let cachedir = takeDirectory destdir 394 let cachedir = takeDirectory destdir
390 unslash ('/':xs) = xs 395 unslash ('/':xs) = xs
@@ -414,7 +419,7 @@ getMkPathAndCommit destdir = do
414 -- copyFile (destdir </> unslash (makeRelative destdir pth) (mkpath pth) 419 -- copyFile (destdir </> unslash (makeRelative destdir pth) (mkpath pth)
415 -- doesFileExist (mkpath pth) >>= flip when copyIt 420 -- doesFileExist (mkpath pth) >>= flip when copyIt
416 -- return (mkpath pth) 421 -- return (mkpath pth)
417 return (mkpath, commit {-, readyReadBeforeWrite -}) 422 return $ FileWriter mkpath commit
418 423
419generateHostsFile :: (FilePath -> FilePath) -> KeyRingRuntime -> IO () 424generateHostsFile :: (FilePath -> FilePath) -> KeyRingRuntime -> IO ()
420generateHostsFile mkpath rt = do 425generateHostsFile mkpath rt = do
@@ -475,7 +480,7 @@ installIpsecConf mkpath wkaddr (certBasename) cs = do
475 480
476refreshCache :: KeyRingRuntime -> Maybe FilePath -> IO () 481refreshCache :: KeyRingRuntime -> Maybe FilePath -> IO ()
477refreshCache rt rootdir = do 482refreshCache rt rootdir = do
478 (mkpath, commit) <- getMkPathAndCommit (fromMaybe "" rootdir ++ "/var/cache/kiki/config") 483 fw@(FileWriter mkpath commit) <- getMkPathAndCommit (fromMaybe "" rootdir ++ "/var/cache/kiki/config")
479 generateHostsFile mkpath rt 484 generateHostsFile mkpath rt
480 fromMaybe (error "No working key.") $ do 485 fromMaybe (error "No working key.") $ do
481 Hostnames wkaddr onames _ _ <- names rt 486 Hostnames wkaddr onames _ _ <- names rt
@@ -494,14 +499,14 @@ refreshCache rt rootdir = do
494 where 499 where
495 passphrases = mempty { opPassphrases = [PassphraseMemoizer (rtPassphrases rt)] } 500 passphrases = mempty { opPassphrases = [PassphraseMemoizer (rtPassphrases rt)] }
496 pemSecrets = mempty { opFiles = Map.fromList 501 pemSecrets = mempty { opFiles = Map.fromList
497 [ send "ipsec" (mkpath $ ipsecKeyPath oname) "missing ipsec key?" 502 [ send "ipsec" (ipsecKeyPath oname) "missing ipsec key?"
498 , send "ssh-client" (mkpath "root/.ssh/id_rsa") "missing ssh-client key?" 503 , send "ssh-client" ("root/.ssh/id_rsa") "missing ssh-client key?"
499 , send "ssh-server" (mkpath "ssh_host_rsa_key") "missing ssh host key?" 504 , send "ssh-server" ("ssh_host_rsa_key") "missing ssh host key?"
500 , send "tor" (mkpath "tor/private_key") "missing tor key?" 505 , send "tor" ("tor/private_key") "missing tor key?"
501 ] 506 ]
502 } 507 }
503 send usage path warning = 508 send usage path warning =
504 ( ArgFile path, StreamInfo { typ = PEMFile 509 ( ArgFile (mkpath path), StreamInfo { typ = PEMFile
505 , fill = KF_Match usage 510 , fill = KF_Match usage
506 , spill = KF_None 511 , spill = KF_None
507 , access = Sec 512 , access = Sec
@@ -512,15 +517,15 @@ refreshCache rt rootdir = do
512 outputReport report 517 outputReport report
513 -- outputReport $ map (first $ resolveForReport ctx) $ filter ((/=ExportedSubkey) . snd) report 518 -- outputReport $ map (first $ resolveForReport ctx) $ filter ((/=ExportedSubkey) . snd) report
514 rt'' <- rethrowKikiErrors rt' 519 rt'' <- rethrowKikiErrors rt'
515 writePublicKeyFiles rt'' mkpath grip oname wkaddr commit 520 writePublicKeyFiles rt'' fw grip oname wkaddr
516 521
517rethrowKikiErrors :: KikiCondition a -> IO a 522rethrowKikiErrors :: KikiCondition a -> IO a
518rethrowKikiErrors BadPassphrase = 523rethrowKikiErrors BadPassphrase =
519 error "Operation requires correct passphrase. (Hint: Use --passphrase-fd=0 to input it on stdin.)" 524 error "Operation requires correct passphrase. (Hint: Use --passphrase-fd=0 to input it on stdin.)"
520rethrowKikiErrors rt = unconditionally $ return rt 525rethrowKikiErrors rt = unconditionally $ return rt
521 526
522writePublicKeyFiles :: KeyRingRuntime -> (FilePath -> FilePath) -> String -> Char8.ByteString -> SockAddr -> IO () -> IO () 527writePublicKeyFiles :: KeyRingRuntime -> FileWriter -> String -> Char8.ByteString -> SockAddr -> IO ()
523writePublicKeyFiles rt mkpath grip oname wkaddr commit = do 528writePublicKeyFiles rt (FileWriter mkpath commit) grip oname wkaddr = do
524 529
525 -- Finally, export public keys if they do not exist. 530 -- Finally, export public keys if they do not exist.
526 either warn (write $ mkpath "root/.ssh/id_rsa.pub") $ show_ssh' "ssh-client" grip (rtKeyDB rt) 531 either warn (write $ mkpath "root/.ssh/id_rsa.pub") $ show_ssh' "ssh-client" grip (rtKeyDB rt)