Refactored ssh key blob serialization into independent module.

2 files changed, 57 insertions, 31 deletions

diff --git a/SSHKey.hs b/SSHKey.hs
new file mode 100644
index 0000000..6e92e43
--- /dev/null
+++ b/SSHKey.hs
@@ -0,0 +1,51 @@
+{-# LANGUAGE OverloadedStrings #-}
+module SSHKey where
+
+import qualified Data.ByteString.Lazy.Char8 as L8
+import qualified Data.ByteString.Lazy as L
+import qualified Codec.Binary.Base64 as Base64
+import Data.Binary.Get ( runGet )
+import Data.Binary.Put ( putWord32be, runPut, putByteString )
+import Data.Binary     ( get, put )
+import Data.Monoid     ( (<>) )
+import Data.Maybe      ( fromMaybe, listToMaybe )
+import Data.Char       ( isSpace )
+import Control.Monad   ( guard )
+import LengthPrefixedBE
+
+type Key = (Integer,Integer)
+
+keyblob :: Key -> L.ByteString
+keyblob (n,e) = "ssh-rsa " <> blob
+ where
+    bs = sshrsa e n
+    blob = L8.pack $ Base64.encode (L.unpack bs)
+
+    sshrsa :: Integer -> Integer -> L.ByteString
+    sshrsa e n = runPut $ do
+        putWord32be 7
+        putByteString "ssh-rsa"
+        put (LengthPrefixedBE e)
+        put (LengthPrefixedBE n)
+
+blobkey :: L8.ByteString -> Key
+blobkey bs = fromMaybe er $ do
+    let (pre,bs1) = L8.splitAt 7 bs
+    guard $ pre == "ssh-rsa"
+    let (sp,bs2) = L8.span isSpace bs1
+    guard $ not (L8.null sp)
+    bs3 <- listToMaybe $ L8.words bs2
+    qq <- L.pack `fmap` Base64.decode (L8.unpack bs3)
+    decode_sshrsa qq
+ where
+    er = error "Unsupported key format"
+
+    decode_sshrsa :: L8.ByteString -> Maybe Key
+    decode_sshrsa bs = do
+        let (pre,bs1) = L8.splitAt 11 bs
+        guard $ pre == runPut (putWord32be 7 >> putByteString "ssh-rsa")
+        let rsakey = flip runGet bs1 $ do
+                LengthPrefixedBE e <- get
+                LengthPrefixedBE n <- get
+                return (n,e)
+        return rsakey
diff --git a/kiki.hs b/kiki.hs
index 9619971..98ac4c7 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -36,8 +36,6 @@ import qualified Data.ByteString.Lazy as L
 import qualified Data.ByteString.Lazy.Char8 as Char8
 import qualified Data.Map as Map
 import Control.Arrow   (first,second)
-import Data.Binary.Get (runGet)
-import Data.Binary.Put (putWord32be,runPut,putByteString)
 import Data.Time.Clock.POSIX ( posixSecondsToUTCTime )
 import Data.Monoid ( (<>) )
 
@@ -45,12 +43,12 @@ import Data.OpenPGP.Util (verify,fingerprint)
 import ScanningParser
 import PEM
 import DotLock
-import LengthPrefixedBE
 import KeyRing
 import Base58
 import qualified CryptoCoins
 -- import Chroot
 import ProcessUtils
+import qualified SSHKey as SSH
 
 -- {-# ANN module ("HLint: ignore Eta reduce"::String) #-}
 -- {-# ANN module ("HLint: ignore Use camelCase"::String) #-}
@@ -114,22 +112,6 @@ import ProcessUtils
 
 warn str = hPutStrLn stderr str
 
-sshrsa :: Integer -> Integer -> Char8.ByteString
-sshrsa e n = runPut $ do
-    putWord32be 7
-    putByteString "ssh-rsa"
-    put (LengthPrefixedBE e)
-    put (LengthPrefixedBE n)
-
-decode_sshrsa :: Char8.ByteString -> Maybe RSAPublicKey
-decode_sshrsa bs = do
-    let (pre,bs1) = Char8.splitAt 11 bs
-    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
 
 isCertificationSig (CertificationSignature {}) = True
 isCertificationSig _                           = True
@@ -240,16 +222,9 @@ modifyUID other              = other
 -}
 
 readPublicKey :: Char8.ByteString -> RSAPublicKey
-readPublicKey bs = fromMaybe er $ 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
+readPublicKey bs = RSAKey (MPI n) (MPI e)
  where
-    er = error "Unsupported key format"
+    (n,e) = SSH.blobkey bs
 
 -- | Returns the given list with its last element modified.
 toLast :: (x -> x) -> [x] -> [x]
@@ -312,9 +287,9 @@ show_ssh' keyspec wkgrip db = do
          (selectPublicKey s db)
          $ \k -> do
     let Just (RSAKey (MPI n) (MPI e)) = rsaKeyFromPacket k
-        bs = sshrsa e n
-        blob = Base64.encode (L.unpack bs)
-    return $ "ssh-rsa " ++ blob
+        bs = SSH.keyblob (n,e)
+        blob = Char8.unpack bs
+    return blob
 
 show_id keyspec wkgrip db = do
     let s = parseSpec "" keyspec