diff options
-rw-r--r-- | lib/KeyRing/Types.hs | 3 | ||||
-rw-r--r-- | lib/Kiki.hs | 31 |
2 files changed, 18 insertions, 16 deletions
diff --git a/lib/KeyRing/Types.hs b/lib/KeyRing/Types.hs index f5fd879..6b686d5 100644 --- a/lib/KeyRing/Types.hs +++ b/lib/KeyRing/Types.hs | |||
@@ -1,3 +1,4 @@ | |||
1 | {-# LANGUAGE DeriveAnyClass #-} | ||
1 | {-# LANGUAGE DeriveFunctor #-} | 2 | {-# LANGUAGE DeriveFunctor #-} |
2 | module KeyRing.Types where | 3 | module KeyRing.Types where |
3 | 4 | ||
@@ -28,7 +29,7 @@ data KeyRingOperation = KeyRingOperation | |||
28 | -- files reside. Otherwise, the evironment variable $GNUPGHOME is consulted | 29 | -- files reside. Otherwise, the evironment variable $GNUPGHOME is consulted |
29 | -- and if that is not set, it falls back to $HOME/.gnupg. | 30 | -- and if that is not set, it falls back to $HOME/.gnupg. |
30 | } | 31 | } |
31 | deriving (Eq,Show) | 32 | deriving (Eq,Show,Semigroup,Monoid) |
32 | 33 | ||
33 | data InputFile = HomeSec | 34 | data InputFile = HomeSec |
34 | -- ^ A file named secring.gpg located in the home directory. | 35 | -- ^ A file named secring.gpg located in the home directory. |
diff --git a/lib/Kiki.hs b/lib/Kiki.hs index 5201dac..5070389 100644 --- a/lib/Kiki.hs +++ b/lib/Kiki.hs | |||
@@ -485,21 +485,17 @@ refreshCache rt rootdir = do | |||
485 | 485 | ||
486 | let grip = fingerprint wk | 486 | let grip = fingerprint wk |
487 | wkkd = rtKeyDB rt Map.! keykey wk | 487 | wkkd = rtKeyDB rt Map.! keykey wk |
488 | getSecret tag = sortOn (Down . timestamp) | 488 | getSecret tag = sortOn (Down . timestamp) $ getSubkeys Unsigned wk (keySubKeys wkkd) tag |
489 | $ getSubkeys Unsigned wk (keySubKeys wkkd) tag | 489 | exportOp = passphrases <> pemSecrets <> minimalOp (CommonArgsParsed (Just $ takeDirectory $ rtPubring rt) Nothing) |
490 | exportOp = withOutgoing $ minimalOp (CommonArgsParsed (Just $ takeDirectory $ rtPubring rt) | ||
491 | Nothing) | ||
492 | where | 490 | where |
493 | withOutgoing op = op | 491 | passphrases = mempty { opPassphrases = [PassphraseMemoizer (rtPassphrases rt)] } |
494 | { opFiles = opFiles op `Map.union` Map.fromList outgoing_secrets | 492 | pemSecrets = mempty { opFiles = Map.fromList |
495 | , opPassphrases = [PassphraseMemoizer (rtPassphrases rt)] | ||
496 | } | ||
497 | outgoing_secrets = | ||
498 | [ send "ipsec" (mkpath "ipsec.d/private/" ++ Char8.unpack oname++".pem") "missing ipsec key?" | 493 | [ send "ipsec" (mkpath "ipsec.d/private/" ++ Char8.unpack oname++".pem") "missing ipsec key?" |
499 | , send "ssh-client" (mkpath "root/.ssh/id_rsa") "missing ssh-client key?" | 494 | , send "ssh-client" (mkpath "root/.ssh/id_rsa") "missing ssh-client key?" |
500 | , send "ssh-server" (mkpath "ssh_host_rsa_key") "missing ssh host key?" | 495 | , send "ssh-server" (mkpath "ssh_host_rsa_key") "missing ssh host key?" |
501 | , send "tor" (mkpath "tor/private_key") "missing tor key?" | 496 | , send "tor" (mkpath "tor/private_key") "missing tor key?" |
502 | ] | 497 | ] |
498 | } | ||
503 | send usage path warning = | 499 | send usage path warning = |
504 | ( ArgFile path, StreamInfo { typ = PEMFile | 500 | ( ArgFile path, StreamInfo { typ = PEMFile |
505 | , fill = KF_Match usage | 501 | , fill = KF_Match usage |
@@ -509,17 +505,22 @@ refreshCache rt rootdir = do | |||
509 | , transforms = [] | 505 | , transforms = [] |
510 | }) | 506 | }) |
511 | KikiResult rt' report <- runKeyRing exportOp | 507 | KikiResult rt' report <- runKeyRing exportOp |
512 | |||
513 | outputReport report | 508 | outputReport report |
514 | -- outputReport $ map (first $ resolveForReport ctx) $ filter ((/=ExportedSubkey) . snd) report | 509 | -- outputReport $ map (first $ resolveForReport ctx) $ filter ((/=ExportedSubkey) . snd) report |
515 | rt <- case rt' of | 510 | rt'' <- rethrowKikiErrors rt' |
516 | BadPassphrase -> | 511 | writePublicKeyFiles rt'' mkpath grip oname wkaddr commit |
517 | error "Operation requires correct passphrase. (Hint: Use --passphrase-fd=0 to input it on stdin.)" | 512 | |
518 | _ -> unconditionally $ return rt' | 513 | rethrowKikiErrors :: KikiCondition a -> IO a |
514 | rethrowKikiErrors BadPassphrase = | ||
515 | error "Operation requires correct passphrase. (Hint: Use --passphrase-fd=0 to input it on stdin.)" | ||
516 | rethrowKikiErrors rt = unconditionally $ return rt | ||
517 | |||
518 | writePublicKeyFiles :: KeyRingRuntime -> (FilePath -> FilePath) -> String -> Char8.ByteString -> SockAddr -> IO () -> IO () | ||
519 | writePublicKeyFiles rt mkpath grip oname wkaddr commit = do | ||
519 | 520 | ||
520 | -- Finally, export public keys if they do not exist. | 521 | -- Finally, export public keys if they do not exist. |
521 | either warn (write $ mkpath "root/.ssh/id_rsa.pub") | 522 | either warn (write $ mkpath "root/.ssh/id_rsa.pub") |
522 | $ show_ssh' "ssh-client" grip (rtKeyDB rt) | 523 | $ show_ssh' "ssh-client" grip (rtKeyDB rt) |
523 | either warn (write $ mkpath "ssh_host_rsa_key.pub") | 524 | either warn (write $ mkpath "ssh_host_rsa_key.pub") |
524 | $ show_ssh' "ssh-server" grip (rtKeyDB rt) | 525 | $ show_ssh' "ssh-server" grip (rtKeyDB rt) |
525 | either warn (write $ mkpath "ipsec.d/certs/" ++ Char8.unpack oname++".pem") | 526 | either warn (write $ mkpath "ipsec.d/certs/" ++ Char8.unpack oname++".pem") |