Better error for unsupported key type for export

1 files changed, 23 insertions, 20 deletions

diff --git a/kiki.hs b/kiki.hs
index 9f30664..81ef3ef 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -220,6 +220,7 @@ derRSA rsa = do
     k <- rsaKeyFromPacket rsa
     return $ encodeASN1 DER (toASN1 k [])
 
+rsaPrivateKeyFromPacket :: Packet -> Maybe RSAPrivateKey
 rsaPrivateKeyFromPacket pkt@(SecretKeyPacket {}) = do
     -- public fields...
     n <- lookup 'n' $ key pkt
@@ -832,26 +833,29 @@ guessKeyFormat 'S' "ssh-client" = "PEM"
 guessKeyFormat 'S' "ssh-host"   = "PEM"
 guessKeyFormat _   _            = "PEM" -- "PGP"
 
-writeKeyToFile False "PEM" fname packet = do
-    flip (maybe (return ()))
-         (rsaPrivateKeyFromPacket packet) -- RSAPrivateKey
-        $ \rsa -> do
-    let asn1 = toASN1 rsa []
-        bs = encodeASN1 DER asn1
-        dta = Base64.encode (L.unpack bs)
-        output = writePEM "RSA PRIVATE KEY" dta
-        stamp = toEnum . fromEnum $ timestamp packet
-    createDirectoryIfMissing True (takeDirectory fname)
-    handleIO_ (warn $ fname ++ ": write failure") $ do
-        saved_mask <- setFileCreationMask 0o077
-        writeFile fname output
-        -- Note: The key's timestamp is included in it's fingerprint.
-        --       Therefore, we should attempt to preserve it.
-        setFileTimes fname stamp stamp
-        setFileCreationMask saved_mask
+writeKeyToFile False "PEM" fname packet =
+    case key_algorithm packet of
+    RSA -> do
+        flip (maybe (return ()))
+             (rsaPrivateKeyFromPacket packet) -- RSAPrivateKey
+            $ \rsa -> do
+        let asn1 = toASN1 rsa []
+            bs = encodeASN1 DER asn1
+            dta = Base64.encode (L.unpack bs)
+            output = writePEM "RSA PRIVATE KEY" dta
+            stamp = toEnum . fromEnum $ timestamp packet
+        createDirectoryIfMissing True (takeDirectory fname)
+        handleIO_ (warn $ fname ++ ": write failure") $ do
+            saved_mask <- setFileCreationMask 0o077
+            writeFile fname output
+            -- Note: The key's timestamp is included in it's fingerprint.
+            --       Therefore, we should attempt to preserve it.
+            setFileTimes fname stamp stamp
+            setFileCreationMask saved_mask
+            return ()
+        warn $ fname ++ ": exported"
         return ()
-    -- warn $ fname++ ": wrote"
-    return ()
+    algo -> warn $ fname ++ ": unable to export "++show algo++" key "++fingerprint packet
 
 readKeyFromFile False "PEM" fname = do
     -- warn $ fname ++ ": reading ..."
@@ -1373,7 +1377,6 @@ doExport doDecrypt (db,use_db) (fname,subspec,ms,cmd) =
         pun <- doDecrypt p
         flip (maybe $ error "Bad passphrase?") pun $ \pun -> do
         writeKeyToFile False "PEM" fname pun
-        warn $ fname ++ ": exported"
         return (db,use_db)
 
 findTag tag wk subkey subsigs = (xs',minsig,ys')