summaryrefslogtreecommitdiff
path: root/lib/SSHKey.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/SSHKey.hs')
-rw-r--r--lib/SSHKey.hs49
1 files changed, 49 insertions, 0 deletions
diff --git a/lib/SSHKey.hs b/lib/SSHKey.hs
new file mode 100644
index 0000000..488f55f
--- /dev/null
+++ b/lib/SSHKey.hs
@@ -0,0 +1,49 @@
1{-# LANGUAGE OverloadedStrings #-}
2module SSHKey where
3
4import qualified Data.ByteString.Lazy.Char8 as L8
5import qualified Data.ByteString.Lazy as L
6import qualified Codec.Binary.Base64 as Base64
7import Data.Binary.Get ( runGet )
8import Data.Binary.Put ( putWord32be, runPut, putByteString )
9import Data.Binary ( get, put )
10import Data.Monoid ( (<>) )
11import Data.Maybe ( listToMaybe )
12import Data.Char ( isSpace )
13import Control.Monad ( guard )
14import LengthPrefixedBE
15
16type Key = (Integer,Integer)
17
18keyblob :: Key -> L.ByteString
19keyblob (n,e) = "ssh-rsa " <> blob
20 where
21 bs = sshrsa e n
22 blob = L8.pack $ Base64.encode (L.unpack bs)
23
24 sshrsa :: Integer -> Integer -> L.ByteString
25 sshrsa e n = runPut $ do
26 putWord32be 7
27 putByteString "ssh-rsa"
28 put (LengthPrefixedBE e)
29 put (LengthPrefixedBE n)
30
31blobkey :: L8.ByteString -> Maybe Key
32blobkey bs = do
33 let (pre,bs1) = L8.splitAt 7 bs
34 guard $ pre == "ssh-rsa"
35 let (sp,bs2) = L8.span isSpace bs1
36 guard $ not (L8.null sp)
37 bs3 <- listToMaybe $ L8.words bs2
38 qq <- L.pack `fmap` Base64.decode (L8.unpack bs3)
39 decode_sshrsa qq
40 where
41 decode_sshrsa :: L8.ByteString -> Maybe Key
42 decode_sshrsa bs = do
43 let (pre,bs1) = L8.splitAt 11 bs
44 guard $ pre == runPut (putWord32be 7 >> putByteString "ssh-rsa")
45 let rsakey = flip runGet bs1 $ do
46 LengthPrefixedBE e <- get
47 LengthPrefixedBE n <- get
48 return (n,e)
49 return rsakey