diff options
-rw-r--r-- | lib/Kiki.hs | 27 |
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 | ||
387 | getMkPathAndCommit :: FilePath -> IO (FilePath -> FilePath, IO ()) | 387 | data FileWriter = FileWriter { |
388 | pathMaker :: FilePath -> FilePath, | ||
389 | fileWriterCommit :: IO () | ||
390 | } | ||
391 | |||
392 | getMkPathAndCommit :: FilePath -> IO (FileWriter) | ||
388 | getMkPathAndCommit destdir = do | 393 | getMkPathAndCommit 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 | ||
419 | generateHostsFile :: (FilePath -> FilePath) -> KeyRingRuntime -> IO () | 424 | generateHostsFile :: (FilePath -> FilePath) -> KeyRingRuntime -> IO () |
420 | generateHostsFile mkpath rt = do | 425 | generateHostsFile mkpath rt = do |
@@ -475,7 +480,7 @@ installIpsecConf mkpath wkaddr (certBasename) cs = do | |||
475 | 480 | ||
476 | refreshCache :: KeyRingRuntime -> Maybe FilePath -> IO () | 481 | refreshCache :: KeyRingRuntime -> Maybe FilePath -> IO () |
477 | refreshCache rt rootdir = do | 482 | refreshCache 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 | ||
517 | rethrowKikiErrors :: KikiCondition a -> IO a | 522 | rethrowKikiErrors :: KikiCondition a -> IO a |
518 | rethrowKikiErrors BadPassphrase = | 523 | rethrowKikiErrors 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.)" |
520 | rethrowKikiErrors rt = unconditionally $ return rt | 525 | rethrowKikiErrors rt = unconditionally $ return rt |
521 | 526 | ||
522 | writePublicKeyFiles :: KeyRingRuntime -> (FilePath -> FilePath) -> String -> Char8.ByteString -> SockAddr -> IO () -> IO () | 527 | writePublicKeyFiles :: KeyRingRuntime -> FileWriter -> String -> Char8.ByteString -> SockAddr -> IO () |
523 | writePublicKeyFiles rt mkpath grip oname wkaddr commit = do | 528 | writePublicKeyFiles 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) |