diff options
author | joe <joe@jerkface.net> | 2014-08-04 21:03:38 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2014-08-04 21:03:38 -0400 |
commit | ef5631f8e90ed30fedc3e1dc2d2bb5f882fee183 (patch) | |
tree | 6134c2c040a6344f32e29012edf2ff928414cffa | |
parent | 7c4f8244594d14f3564b820f1ada264099840941 (diff) |
KnownHosts encode/decode
-rw-r--r-- | KnownHosts.hs | 30 | ||||
-rw-r--r-- | SSHKey.hs | 8 | ||||
-rw-r--r-- | kiki.hs | 3 |
3 files changed, 31 insertions, 10 deletions
diff --git a/KnownHosts.hs b/KnownHosts.hs index a8f4fe3..e04ad90 100644 --- a/KnownHosts.hs +++ b/KnownHosts.hs | |||
@@ -11,6 +11,7 @@ data KnownHostsEntry = KnownHostsEntry | |||
11 | , eSp :: [L.ByteString] | 11 | , eSp :: [L.ByteString] |
12 | , eComment :: L.ByteString | 12 | , eComment :: L.ByteString |
13 | , eKeyBlob :: L.ByteString | 13 | , eKeyBlob :: L.ByteString |
14 | , eKey :: Maybe SSH.Key | ||
14 | , eKeyHeader :: L.ByteString | 15 | , eKeyHeader :: L.ByteString |
15 | , eHosts :: [L.ByteString] | 16 | , eHosts :: [L.ByteString] |
16 | } | 17 | } |
@@ -20,12 +21,15 @@ serializeLine :: KnownHostsEntry -> L.ByteString | |||
20 | serializeLine (KnownHostsEntry { eSp = sp | 21 | serializeLine (KnownHostsEntry { eSp = sp |
21 | , eComment = comment | 22 | , eComment = comment |
22 | , eKeyHeader = hdr | 23 | , eKeyHeader = hdr |
23 | , eKeyBlob = key | 24 | , eKeyBlob = blob |
25 | , eKey = _ | ||
24 | , eHosts = hosts | 26 | , eHosts = hosts |
25 | }) | 27 | }) |
26 | = L.concat $ zipWith L.append [host,hdr,key] (take 3 sp) ++ [comment] | 28 | = L.concat $ zipWith L.append [host,hdr,blob] (take 3 sp) ++ [comment] |
29 | -- = L.concat $ zipWith L.append [host,hdr,keyblob] (take 3 sp) ++ [comment] | ||
27 | where | 30 | where |
28 | host = L.intercalate "," hosts | 31 | host = L.intercalate "," hosts |
32 | -- keyblob = L.dropWhile isSpace $ L.dropWhile (not . isSpace) $ SSH.keyblob key | ||
29 | 33 | ||
30 | 34 | ||
31 | parseLine :: Int -> L.ByteString -> KnownHostsEntry | 35 | parseLine :: Int -> L.ByteString -> KnownHostsEntry |
@@ -34,7 +38,8 @@ parseLine num str = KnownHostsEntry | |||
34 | , eSp = sp | 38 | , eSp = sp |
35 | , eComment = comment | 39 | , eComment = comment |
36 | , eKeyHeader = hdr | 40 | , eKeyHeader = hdr |
37 | , eKeyBlob = key | 41 | , eKeyBlob = blob |
42 | , eKey = key | ||
38 | , eHosts = hosts | 43 | , eHosts = hosts |
39 | } | 44 | } |
40 | where | 45 | where |
@@ -47,6 +52,23 @@ parseLine num str = KnownHostsEntry | |||
47 | h0 <- take 1 hs | 52 | h0 <- take 1 hs |
48 | h0 : hs' | 53 | h0 : hs' |
49 | hdr = L.concat $ take 1 (drop 1 ns) | 54 | hdr = L.concat $ take 1 (drop 1 ns) |
50 | key = L.concat $ take 1 (drop 2 ns) | 55 | blob = L.concat $ take 1 (drop 2 ns) |
56 | key = SSH.blobkey $ L.concat $ hdr:" ":blob:[] | ||
51 | comment = L.concat $ zipWith L.append (drop 3 ns) (drop 3 sp ++ repeat "") | 57 | comment = L.concat $ zipWith L.append (drop 3 ns) (drop 3 sp ++ repeat "") |
52 | 58 | ||
59 | data KnownHosts = KnownHosts | ||
60 | { khcount :: Int | ||
61 | , khentries :: [KnownHostsEntry] | ||
62 | } | ||
63 | |||
64 | decode :: L.ByteString -> KnownHosts | ||
65 | decode input = renum $ foldr grok (KnownHosts 0 []) ls | ||
66 | where | ||
67 | ls = L.lines input | ||
68 | grok x (KnownHosts cnt es) = | ||
69 | KnownHosts (cnt+1) (parseLine 0 x:es) | ||
70 | renum kh = kh { khentries = zipWith setnum [1..] (khentries kh) } | ||
71 | where setnum n e = e { eLineno=n } | ||
72 | |||
73 | encode :: KnownHosts -> L.ByteString | ||
74 | encode kh = L.unlines $ map serializeLine (khentries kh) | ||
@@ -8,7 +8,7 @@ import Data.Binary.Get ( runGet ) | |||
8 | import Data.Binary.Put ( putWord32be, runPut, putByteString ) | 8 | import Data.Binary.Put ( putWord32be, runPut, putByteString ) |
9 | import Data.Binary ( get, put ) | 9 | import Data.Binary ( get, put ) |
10 | import Data.Monoid ( (<>) ) | 10 | import Data.Monoid ( (<>) ) |
11 | import Data.Maybe ( fromMaybe, listToMaybe ) | 11 | import Data.Maybe ( listToMaybe ) |
12 | import Data.Char ( isSpace ) | 12 | import Data.Char ( isSpace ) |
13 | import Control.Monad ( guard ) | 13 | import Control.Monad ( guard ) |
14 | import LengthPrefixedBE | 14 | import LengthPrefixedBE |
@@ -28,8 +28,8 @@ keyblob (n,e) = "ssh-rsa " <> blob | |||
28 | put (LengthPrefixedBE e) | 28 | put (LengthPrefixedBE e) |
29 | put (LengthPrefixedBE n) | 29 | put (LengthPrefixedBE n) |
30 | 30 | ||
31 | blobkey :: L8.ByteString -> Key | 31 | blobkey :: L8.ByteString -> Maybe Key |
32 | blobkey bs = fromMaybe er $ do | 32 | blobkey bs = do |
33 | let (pre,bs1) = L8.splitAt 7 bs | 33 | let (pre,bs1) = L8.splitAt 7 bs |
34 | guard $ pre == "ssh-rsa" | 34 | guard $ pre == "ssh-rsa" |
35 | let (sp,bs2) = L8.span isSpace bs1 | 35 | let (sp,bs2) = L8.span isSpace bs1 |
@@ -38,8 +38,6 @@ blobkey bs = fromMaybe er $ do | |||
38 | qq <- L.pack `fmap` Base64.decode (L8.unpack bs3) | 38 | qq <- L.pack `fmap` Base64.decode (L8.unpack bs3) |
39 | decode_sshrsa qq | 39 | decode_sshrsa qq |
40 | where | 40 | where |
41 | er = error "Unsupported key format" | ||
42 | |||
43 | decode_sshrsa :: L8.ByteString -> Maybe Key | 41 | decode_sshrsa :: L8.ByteString -> Maybe Key |
44 | decode_sshrsa bs = do | 42 | decode_sshrsa bs = do |
45 | let (pre,bs1) = L8.splitAt 11 bs | 43 | let (pre,bs1) = L8.splitAt 11 bs |
@@ -224,7 +224,8 @@ modifyUID other = other | |||
224 | readPublicKey :: Char8.ByteString -> RSAPublicKey | 224 | readPublicKey :: Char8.ByteString -> RSAPublicKey |
225 | readPublicKey bs = RSAKey (MPI n) (MPI e) | 225 | readPublicKey bs = RSAKey (MPI n) (MPI e) |
226 | where | 226 | where |
227 | (n,e) = SSH.blobkey bs | 227 | (n,e) = fromMaybe (error "Unsupported key format") |
228 | $ SSH.blobkey bs | ||
228 | 229 | ||
229 | -- | Returns the given list with its last element modified. | 230 | -- | Returns the given list with its last element modified. |
230 | toLast :: (x -> x) -> [x] -> [x] | 231 | toLast :: (x -> x) -> [x] -> [x] |