diff options
Diffstat (limited to 'Hosts.hs')
-rw-r--r-- | Hosts.hs | 16 |
1 files changed, 13 insertions, 3 deletions
@@ -30,17 +30,15 @@ import qualified Data.Map as Map | |||
30 | import Data.Map (Map) | 30 | import Data.Map (Map) |
31 | import qualified Data.ByteString.Lazy.Char8 as L | 31 | import qualified Data.ByteString.Lazy.Char8 as L |
32 | import System.IO.Unsafe (unsafePerformIO) | 32 | import System.IO.Unsafe (unsafePerformIO) |
33 | import Control.Exception as Exception (IOException(..),catch) | ||
34 | import Control.Applicative ( (<$>), (<*>) ) | 33 | import Control.Applicative ( (<$>), (<*>) ) |
35 | import Control.Monad (mplus) | 34 | import Control.Monad (mplus) |
36 | import Network.Socket | 35 | import Network.Socket |
36 | import ControlMaybe ( handleIO_ ) | ||
37 | 37 | ||
38 | #if ! MIN_VERSION_network(2,4,0) | 38 | #if ! MIN_VERSION_network(2,4,0) |
39 | deriving instance Ord SockAddr | 39 | deriving instance Ord SockAddr |
40 | #endif | 40 | #endif |
41 | 41 | ||
42 | handleIO_ h a = Exception.catch a (\(_ :: IOException) -> h) | ||
43 | |||
44 | inet_pton :: String -> Maybe SockAddr | 42 | inet_pton :: String -> Maybe SockAddr |
45 | inet_pton p = n | 43 | inet_pton p = n |
46 | where | 44 | where |
@@ -68,8 +66,10 @@ data Hosts = Hosts | |||
68 | instance Show Hosts where | 66 | instance Show Hosts where |
69 | show = L.unpack . encode | 67 | show = L.unpack . encode |
70 | 68 | ||
69 | encode :: Hosts -> L.ByteString | ||
71 | encode = L.unlines . map snd . Map.assocs . numline | 70 | encode = L.unlines . map snd . Map.assocs . numline |
72 | 71 | ||
72 | parseLine :: L.ByteString -> (Maybe SockAddr, [L.ByteString]) | ||
73 | parseLine s = (addr,names) | 73 | parseLine s = (addr,names) |
74 | where | 74 | where |
75 | (addr0,names) = splitAt 1 $ L.words (uncom s) | 75 | (addr0,names) = splitAt 1 $ L.words (uncom s) |
@@ -80,6 +80,7 @@ parseLine s = (addr,names) | |||
80 | 80 | ||
81 | uncom s = fst $ L.break (=='#') s | 81 | uncom s = fst $ L.break (=='#') s |
82 | 82 | ||
83 | empty :: Hosts | ||
83 | empty = Hosts { lineCount = 0 | 84 | empty = Hosts { lineCount = 0 |
84 | , numline = Map.empty | 85 | , numline = Map.empty |
85 | , addrnum = Map.empty | 86 | , addrnum = Map.empty |
@@ -92,6 +93,7 @@ parseHosts fname = do | |||
92 | return $ decode input | 93 | return $ decode input |
93 | -} | 94 | -} |
94 | 95 | ||
96 | decode :: L.ByteString -> Hosts | ||
95 | decode input = | 97 | decode input = |
96 | let ls = L.lines input | 98 | let ls = L.lines input |
97 | ans = map (\l->(parseLine l,l)) ls | 99 | ans = map (\l->(parseLine l,l)) ls |
@@ -118,6 +120,8 @@ hasName name hosts = Map.member name $ namenum hosts | |||
118 | hasAddr :: SockAddr -> Hosts -> Bool | 120 | hasAddr :: SockAddr -> Hosts -> Bool |
119 | hasAddr addr hosts = Map.member addr $ addrnum hosts | 121 | hasAddr addr hosts = Map.member addr $ addrnum hosts |
120 | 122 | ||
123 | scrubName :: | ||
124 | ([L.ByteString] -> [L.ByteString]) -> L.ByteString -> L.ByteString | ||
121 | scrubName f line = line' | 125 | scrubName f line = line' |
122 | where | 126 | where |
123 | (x,ign) = L.break (=='#') line | 127 | (x,ign) = L.break (=='#') line |
@@ -140,8 +144,10 @@ scrubName f line = line' | |||
140 | else "# " <> vs'' | 144 | else "# " <> vs'' |
141 | in L.concat (a'++ws'') <> vs''' | 145 | in L.concat (a'++ws'') <> vs''' |
142 | 146 | ||
147 | assignName :: SockAddr -> L.ByteString -> Hosts -> Hosts | ||
143 | assignName addr name hosts = assignName0 False addr name hosts | 148 | assignName addr name hosts = assignName0 False addr name hosts |
144 | 149 | ||
150 | assignName0 :: Bool -> SockAddr -> L.ByteString -> Hosts -> Hosts | ||
145 | assignName0 iscannon addr name hosts = hosts' | 151 | assignName0 iscannon addr name hosts = hosts' |
146 | where | 152 | where |
147 | ns = Map.lookup name (namenum hosts) | 153 | ns = Map.lookup name (namenum hosts) |
@@ -170,10 +176,12 @@ assignName0 iscannon addr name hosts = hosts' | |||
170 | line = L.pack (inet_ntop addr) <> " " <> name | 176 | line = L.pack (inet_ntop addr) <> " " <> name |
171 | cons v xs = Just $ maybe [v] (v:) xs | 177 | cons v xs = Just $ maybe [v] (v:) xs |
172 | 178 | ||
179 | assignNewName :: SockAddr -> L.ByteString -> Hosts -> Hosts | ||
173 | assignNewName addr name hosts = | 180 | assignNewName addr name hosts = |
174 | if hasName name hosts then hosts | 181 | if hasName name hosts then hosts |
175 | else assignName0 True addr name hosts | 182 | else assignName0 True addr name hosts |
176 | 183 | ||
184 | appendName :: Bool -> L.ByteString -> Hosts -> Int -> Hosts | ||
177 | appendName iscannon name hosts num = hosts | 185 | appendName iscannon name hosts num = hosts |
178 | { numline = Map.adjust (scrubName f) num (numline hosts) | 186 | { numline = Map.adjust (scrubName f) num (numline hosts) |
179 | , namenum = Map.alter (cons num) name (namenum hosts) | 187 | , namenum = Map.alter (cons num) name (namenum hosts) |
@@ -204,6 +212,7 @@ diff as bs = cs | |||
204 | namesForAddress :: SockAddr -> Hosts -> [L.ByteString] | 212 | namesForAddress :: SockAddr -> Hosts -> [L.ByteString] |
205 | namesForAddress addr hosts = snd $ _namesForAddress addr hosts | 213 | namesForAddress addr hosts = snd $ _namesForAddress addr hosts |
206 | 214 | ||
215 | _namesForAddress :: SockAddr -> Hosts -> (Int, [L.ByteString]) | ||
207 | _namesForAddress addr (Hosts {numline=numline, addrnum=addrnum}) = ns | 216 | _namesForAddress addr (Hosts {numline=numline, addrnum=addrnum}) = ns |
208 | where | 217 | where |
209 | ns = maybe (-1,[]) id $ do | 218 | ns = maybe (-1,[]) id $ do |
@@ -212,6 +221,7 @@ _namesForAddress addr (Hosts {numline=numline, addrnum=addrnum}) = ns | |||
212 | return (n, snd $ parseLine line) | 221 | return (n, snd $ parseLine line) |
213 | 222 | ||
214 | 223 | ||
224 | plus :: Hosts -> Hosts -> Hosts | ||
215 | plus a b = Map.foldlWithKey' mergeAddr a (addrnum b) | 225 | plus a b = Map.foldlWithKey' mergeAddr a (addrnum b) |
216 | where | 226 | where |
217 | mergeAddr a addr bnum = a' | 227 | mergeAddr a addr bnum = a' |