diff options
-rw-r--r-- | lib/KeyRing.hs | 12 | ||||
-rw-r--r-- | lib/Kiki.hs | 47 |
2 files changed, 42 insertions, 17 deletions
diff --git a/lib/KeyRing.hs b/lib/KeyRing.hs index a0d1e1a..21d7c3e 100644 --- a/lib/KeyRing.hs +++ b/lib/KeyRing.hs | |||
@@ -100,6 +100,8 @@ module KeyRing | |||
100 | , secretPemFromPacket | 100 | , secretPemFromPacket |
101 | , SubkeyStatus(..) | 101 | , SubkeyStatus(..) |
102 | , getSubkeys | 102 | , getSubkeys |
103 | , writeKeyToFile | ||
104 | , resolveForReport | ||
103 | ) where | 105 | ) where |
104 | 106 | ||
105 | import System.Environment | 107 | import System.Environment |
@@ -662,7 +664,7 @@ data KikiReportAction = | |||
662 | | FailedFileWrite | 664 | | FailedFileWrite |
663 | | HostsDiff ByteString | 665 | | HostsDiff ByteString |
664 | | DeletedPacket String | 666 | | DeletedPacket String |
665 | deriving Show | 667 | deriving (Eq,Show) |
666 | 668 | ||
667 | uncamel :: String -> String | 669 | uncamel :: String -> String |
668 | uncamel str = unwords $ firstWord ++ (toLower .: otherWords) ++ args | 670 | uncamel str = unwords $ firstWord ++ (toLower .: otherWords) ++ args |
@@ -2246,8 +2248,8 @@ pemFromPacket AutoAccess p@(SecretKeyPacket {}) = pemFromPacket Sec p | |||
2246 | pemFromPacket AutoAccess _ = Nothing | 2248 | pemFromPacket AutoAccess _ = Nothing |
2247 | 2249 | ||
2248 | writeKeyToFile :: | 2250 | writeKeyToFile :: |
2249 | Bool -> StreamInfo -> InputFile -> Packet -> IO [(InputFile, KikiReportAction)] | 2251 | StreamInfo -> InputFile -> Packet -> IO [(InputFile, KikiReportAction)] |
2250 | writeKeyToFile False stream@(StreamInfo { typ = PEMFile }) fname packet = do | 2252 | writeKeyToFile stream@(StreamInfo { typ = PEMFile }) fname packet = do |
2251 | case pemFromPacket (access stream) packet of | 2253 | case pemFromPacket (access stream) packet of |
2252 | Just output -> do | 2254 | Just output -> do |
2253 | let stamp = toEnum . fromEnum $ timestamp packet | 2255 | let stamp = toEnum . fromEnum $ timestamp packet |
@@ -2260,7 +2262,7 @@ writeKeyToFile False stream@(StreamInfo { typ = PEMFile }) fname packet = do | |||
2260 | return [(fname, ExportedSubkey)] | 2262 | return [(fname, ExportedSubkey)] |
2261 | Nothing -> return [(fname, UnableToExport (key_algorithm packet) $ fingerprint packet)] | 2263 | Nothing -> return [(fname, UnableToExport (key_algorithm packet) $ fingerprint packet)] |
2262 | 2264 | ||
2263 | writeKeyToFile False StreamInfo { typ = DNSPresentation } fname packet = do | 2265 | writeKeyToFile StreamInfo { typ = DNSPresentation } fname packet = do |
2264 | case key_algorithm packet of | 2266 | case key_algorithm packet of |
2265 | RSA -> do | 2267 | RSA -> do |
2266 | flip (maybe (return [])) | 2268 | flip (maybe (return [])) |
@@ -2308,7 +2310,7 @@ writePEMKeys doDecrypt db exports = do | |||
2308 | let ds' = map functorToEither ds | 2310 | let ds' = map functorToEither ds |
2309 | if null (lefts ds') | 2311 | if null (lefts ds') |
2310 | then do | 2312 | then do |
2311 | rs <- mapM (\(f,stream,p) -> writeKeyToFile False stream (ArgFile f) p) | 2313 | rs <- mapM (\(f,stream,p) -> writeKeyToFile stream (ArgFile f) p) |
2312 | (rights ds') | 2314 | (rights ds') |
2313 | return $ KikiSuccess (map (first $ resolveForReport Nothing) $ concat rs) | 2315 | return $ KikiSuccess (map (first $ resolveForReport Nothing) $ concat rs) |
2314 | else do | 2316 | else do |
diff --git a/lib/Kiki.hs b/lib/Kiki.hs index b1f7ad7..8a1878b 100644 --- a/lib/Kiki.hs +++ b/lib/Kiki.hs | |||
@@ -82,6 +82,11 @@ run args x = | |||
82 | Left e -> hPutStrLn stderr $ usageErrorMessage e | 82 | Left e -> hPutStrLn stderr $ usageErrorMessage e |
83 | Right io -> io | 83 | Right io -> io |
84 | 84 | ||
85 | outputReport :: [(FilePath, KikiReportAction)] -> IO () | ||
86 | outputReport report = do | ||
87 | forM_ report $ \(fname,act) -> do | ||
88 | putStrLn $ fname ++ ": " ++ reportString act | ||
89 | |||
85 | importAndRefresh :: (FilePath -> FilePath) -> CommonArgsParsed -> IO () | 90 | importAndRefresh :: (FilePath -> FilePath) -> CommonArgsParsed -> IO () |
86 | importAndRefresh root cmn = do | 91 | importAndRefresh root cmn = do |
87 | let rootdir = do guard (root "x" /= "x") | 92 | let rootdir = do guard (root "x" /= "x") |
@@ -195,8 +200,7 @@ importAndRefresh root cmn = do | |||
195 | } | 200 | } |
196 | -- if bUnprivileged then doNothing else mkdirFor torpath | 201 | -- if bUnprivileged then doNothing else mkdirFor torpath |
197 | KikiResult rt report <- runKeyRing (if bUnprivileged then nop else op) | 202 | KikiResult rt report <- runKeyRing (if bUnprivileged then nop else op) |
198 | forM_ report $ \(fname,act) -> do | 203 | outputReport report |
199 | putStrLn $ fname ++ ": " ++ reportString act | ||
200 | rt <- case rt of | 204 | rt <- case rt of |
201 | BadPassphrase -> | 205 | BadPassphrase -> |
202 | error "Operation requires correct passphrase. (Hint: Use --passphrase-fd=0 to input it on stdin.)" | 206 | error "Operation requires correct passphrase. (Hint: Use --passphrase-fd=0 to input it on stdin.)" |
@@ -237,16 +241,35 @@ refreshCache rt rootdir = do | |||
237 | 241 | ||
238 | let grip = fingerprint wk | 242 | let grip = fingerprint wk |
239 | wkkd = rtKeyDB rt Map.! keykey wk | 243 | wkkd = rtKeyDB rt Map.! keykey wk |
240 | 244 | getSecret tag = sortOn (Down . timestamp) | |
241 | either warn (write $ mkpath "ipsec.d/private/" ++ Char8.unpack oname++".pem") $ do | 245 | $ getSubkeys Unsigned wk (keySubKeys wkkd) tag |
242 | -- Note: no sig check here. That may be incautious... | 246 | |
243 | let my_ipsecs :: [Packet] | 247 | let writeSecret tag path warning = do |
244 | my_ipsecs = sortOn (Down . timestamp) | 248 | let my_ks :: [Packet] |
245 | $ getSubkeys Unsigned wk (keySubKeys wkkd) "ipsec" | 249 | my_ks = getSecret "ipsec" |
246 | case my_ipsecs of | 250 | case my_ks of |
247 | ipsec:_ -> maybe (Left "unsupported ipsec key type") Right | 251 | sec:_ -> do report <- writeKeyToFile streaminfo { typ = PEMFile |
248 | $ secretPemFromPacket ipsec | 252 | , access = Sec |
249 | _ -> Left "missing ipsec key?" | 253 | , spill = KF_All |
254 | } | ||
255 | (ArgFile path) | ||
256 | sec | ||
257 | let ctx = Just $ InputFileContext "secring.gpg" "pubring.gpg" | ||
258 | outputReport $ map (first $ resolveForReport ctx) | ||
259 | $ filter ((/=ExportedSubkey) . snd) report | ||
260 | _ -> warn warning | ||
261 | |||
262 | writeSecret "ipsec" | ||
263 | (mkpath "ipsec.d/private/" ++ Char8.unpack oname++".pem") | ||
264 | "missing ipsec key?" | ||
265 | |||
266 | writeSecret "ssh-client" | ||
267 | (mkpath "root/.ssh/id_rsa") | ||
268 | "missing ssh-client key?" | ||
269 | |||
270 | writeSecret "ssh-server" | ||
271 | (mkpath "ssh_host_rsa_key") | ||
272 | "missing ssh host key?" | ||
250 | 273 | ||
251 | -- Finally, export public keys if they do not exist. | 274 | -- Finally, export public keys if they do not exist. |
252 | either warn (write $ mkpath "root/.ssh/id_rsa.pub") | 275 | either warn (write $ mkpath "root/.ssh/id_rsa.pub") |