--show-whose-key option to search who owns the given ssh key.

1 files changed, 55 insertions, 1 deletions

diff --git a/kiki.hs b/kiki.hs
index 87f5db4..e79c9f3 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -79,6 +79,7 @@ import qualified Hosts
 import Network.Socket -- (SockAddr)
 import LengthPrefixedBE
 import Data.Binary.Put (putWord32be,runPut,putByteString)
+import Data.Binary.Get (runGet)
 
 -- instance Default S.ByteString where def = S.empty
 
@@ -105,7 +106,7 @@ unprefix c spec = if null (snd p) then swap p else (fst p, tail (snd p))
  where p = break (==c) spec
 
 
-data RSAPublicKey = RSAKey MPI MPI deriving Show
+data RSAPublicKey = RSAKey MPI MPI deriving (Eq,Show)
 data PKCS8_RSAPublicKey = RSAKey8 MPI MPI deriving Show
 
 pkcs8 (RSAKey n e) = RSAKey8 n e
@@ -226,6 +227,18 @@ sshrsa e n = runPut $ do
     put (LengthPrefixedBE e)
     put (LengthPrefixedBE n)
 
+decode_sshrsa :: Char8.ByteString -> Maybe RSAPublicKey
+decode_sshrsa bs = do
+    let (pre,bs1) = Char8.splitAt 11 bs
+        v = runPut (putWord32be 7 >> putByteString "ssh-rsa")
+    guard $ pre == runPut (putWord32be 7 >> putByteString "ssh-rsa")
+    let rsakey = flip runGet bs1 $ do
+            LengthPrefixedBE e <- get
+            LengthPrefixedBE n <- get
+            return $ RSAKey (MPI n) (MPI e)
+    return rsakey
+        
+
 rsaKeyFromPacket :: Packet -> Maybe RSAPublicKey
 rsaKeyFromPacket p@(PublicKeyPacket {}) = do
     n <- lookup 'n' $ key p
@@ -964,6 +977,18 @@ readKeyFromFile False "PEM" fname = do
             }
 readKeyFromFile is_public fmt filename = error ("unimplemented key type: "++fmt)
 
+readPublicKey :: Char8.ByteString -> RSAPublicKey
+readPublicKey bs = maybe er id $ do
+    let (pre,bs1) = Char8.splitAt 7 bs
+    guard $ pre == "ssh-rsa"
+    let (sp,bs2) = Char8.span isSpace bs1
+    guard $ not (Char8.null sp)
+    bs3 <- listToMaybe $ Char8.words bs2
+    qq <- L.pack `fmap` Base64.decode (Char8.unpack bs3)
+    decode_sshrsa qq
+ where
+    er = error "Unsupported key format"
+
 {-
 getPassphrase cmd =
          case passphrase_fd cmd of
@@ -1409,6 +1434,16 @@ show_all db = do
     putStrLn $ listKeys packets
     -- warn $ "END   LIST "++show (length packets)++" packets."
 
+show_whose_key input_key db = do
+    flip (maybe $ return ()) input_key $ \input_key -> do
+    let ks = whoseKey input_key db
+    case ks of
+        [KeyData k _ uids _] -> do
+            putStrLn $ fingerprint (packet k)
+            mapM_ putStrLn $ Map.keys uids
+        (_:_) -> error "ambiguous"
+        [] -> return ()
+
 show_pem keyspec wkgrip db = do
     let s = parseSpec wkgrip keyspec
     flip (maybe $ warn (keyspec ++ ": not found") >> return ())
@@ -2102,6 +2137,15 @@ getHostnames (KeyData topmp _ uids subs) = (addr,(onames,othernames))
                  . torhash )
                  torkeys
 
+whoseKey :: RSAPublicKey -> KeyDB -> [KeyData]
+whoseKey rsakey db = filter matchkey (Map.elems db)
+ where
+    matchkey (KeyData k _ _ subs) =
+        not . null .  filter ismatch $ Map.elems subs
+
+    ismatch (SubKey mp sigs) = 
+       Just rsakey == rsaKeyFromPacket (packet mp)
+
 kiki_usage = do
     putStr . unlines $
         ["kiki - a pgp key editing utility"
@@ -2169,6 +2213,10 @@ kiki_usage = do
         ,""
         ,"     --show-all Show fingerprints and UIDs and usage tags for all known keys."
         ,""
+        ,"     --show-whose-key"
+        ,"                Shows the fingerprint and UIDs of the key that owns the one that"
+        ,"                is input on stdin in ssh-rsa format."
+        ,""
         ,"     --show-pem SPEC"
         ,"                Outputs the PKCS #8 public key corresponding to SPEC."
         ,""
@@ -2211,6 +2259,7 @@ main = do
                                      , ("--autosign",0)
                                      , ("--show-wk",0)
                                      , ("--show-all",0)
+                                     , ("--show-whose-key",0)
                                      , ("--show-key",1)
                                      , ("--show-pem",1)
                                      , ("--show-ssh",1)
@@ -2298,6 +2347,10 @@ main = do
         warn "syntax error"
         exitFailure
 
+    input_key <- maybe (return Nothing)
+                       (const $ fmap (Just . readPublicKey) Char8.getContents) 
+                    $ Map.lookup "--show-whose-key" margs
+
     let keypairs = catMaybes keypairs0
         btcpairs = catMaybes btcpairs0
 
@@ -2460,6 +2513,7 @@ main = do
             -- On last pass, interpret --show-* commands.
             let shspec = Map.fromList [("--show-wk", const $ show_wk secfile grip)
                                       ,("--show-all",const $ show_all)
+                                      ,("--show-whose-key", const $ show_whose_key input_key)
                                       ,("--show-key",\[x] -> show_key x $ maybe "" id grip)
                                       ,("--show-pem",\[x] -> show_pem x $ maybe "" id grip)
                                       ,("--show-ssh",\[x] -> show_ssh x $ maybe "" id grip)