diff options
-rw-r--r-- | KnownHosts.hs | 28 |
1 files changed, 25 insertions, 3 deletions
diff --git a/KnownHosts.hs b/KnownHosts.hs index e04ad90..e19e68e 100644 --- a/KnownHosts.hs +++ b/KnownHosts.hs | |||
@@ -1,9 +1,17 @@ | |||
1 | {-# LANGUAGE OverloadedStrings #-} | 1 | {-# LANGUAGE OverloadedStrings #-} |
2 | module KnownHosts where | 2 | module KnownHosts |
3 | ( KnownHosts(..) | ||
4 | , decode | ||
5 | , encode | ||
6 | , assignKey | ||
7 | , parseLine | ||
8 | , serializeLine ) where | ||
3 | 9 | ||
4 | import qualified Data.ByteString.Lazy.Char8 as L | 10 | import qualified Data.ByteString.Lazy.Char8 as L |
5 | import Data.Char | 11 | import Data.Char |
6 | import Data.List | 12 | import Data.List |
13 | import Data.Ord | ||
14 | import Data.Maybe | ||
7 | import qualified SSHKey as SSH | 15 | import qualified SSHKey as SSH |
8 | 16 | ||
9 | data KnownHostsEntry = KnownHostsEntry | 17 | data KnownHostsEntry = KnownHostsEntry |
@@ -61,14 +69,28 @@ data KnownHosts = KnownHosts | |||
61 | , khentries :: [KnownHostsEntry] | 69 | , khentries :: [KnownHostsEntry] |
62 | } | 70 | } |
63 | 71 | ||
72 | renum kh = kh { khentries = zipWith setnum [1..] (khentries kh) } | ||
73 | where setnum n e = e { eLineno=n } | ||
74 | |||
64 | decode :: L.ByteString -> KnownHosts | 75 | decode :: L.ByteString -> KnownHosts |
65 | decode input = renum $ foldr grok (KnownHosts 0 []) ls | 76 | decode input = renum $ foldr grok (KnownHosts 0 []) ls |
66 | where | 77 | where |
67 | ls = L.lines input | 78 | ls = L.lines input |
68 | grok x (KnownHosts cnt es) = | 79 | grok x (KnownHosts cnt es) = |
69 | KnownHosts (cnt+1) (parseLine 0 x:es) | 80 | 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 | 81 | ||
73 | encode :: KnownHosts -> L.ByteString | 82 | encode :: KnownHosts -> L.ByteString |
74 | encode kh = L.unlines $ map serializeLine (khentries kh) | 83 | encode kh = L.unlines $ map serializeLine (khentries kh) |
84 | |||
85 | assignKey :: SSH.Key -> L.ByteString -> KnownHosts -> KnownHosts | ||
86 | assignKey key name kh = renum KnownHosts { khcount = khcount kh - length ds | ||
87 | , khentries = es } | ||
88 | where | ||
89 | (ms,ns) = partition (\e -> eKey e == Just key) $ khentries kh | ||
90 | ms' = map (\e -> e { eHosts = eHosts e `union` [name]}) ms | ||
91 | ns' = map (\e -> e { eHosts = eHosts e \\ if isJust (eKey e) then [name] | ||
92 | else [] | ||
93 | }) | ||
94 | ns | ||
95 | (ds,ns'') = partition (\e -> null (eHosts e)) ns' | ||
96 | es = sortBy (comparing eLineno) $ ms' ++ ns'' | ||