summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--lib/KeyRing.hs12
-rw-r--r--lib/Kiki.hs47
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
105import System.Environment 107import 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
667uncamel :: String -> String 669uncamel :: String -> String
668uncamel str = unwords $ firstWord ++ (toLower .: otherWords) ++ args 670uncamel str = unwords $ firstWord ++ (toLower .: otherWords) ++ args
@@ -2246,8 +2248,8 @@ pemFromPacket AutoAccess p@(SecretKeyPacket {}) = pemFromPacket Sec p
2246pemFromPacket AutoAccess _ = Nothing 2248pemFromPacket AutoAccess _ = Nothing
2247 2249
2248writeKeyToFile :: 2250writeKeyToFile ::
2249 Bool -> StreamInfo -> InputFile -> Packet -> IO [(InputFile, KikiReportAction)] 2251 StreamInfo -> InputFile -> Packet -> IO [(InputFile, KikiReportAction)]
2250writeKeyToFile False stream@(StreamInfo { typ = PEMFile }) fname packet = do 2252writeKeyToFile 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
2263writeKeyToFile False StreamInfo { typ = DNSPresentation } fname packet = do 2265writeKeyToFile 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
85outputReport :: [(FilePath, KikiReportAction)] -> IO ()
86outputReport report = do
87 forM_ report $ \(fname,act) -> do
88 putStrLn $ fname ++ ": " ++ reportString act
89
85importAndRefresh :: (FilePath -> FilePath) -> CommonArgsParsed -> IO () 90importAndRefresh :: (FilePath -> FilePath) -> CommonArgsParsed -> IO ()
86importAndRefresh root cmn = do 91importAndRefresh 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")