summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--hosts.hs107
1 files changed, 107 insertions, 0 deletions
diff --git a/hosts.hs b/hosts.hs
new file mode 100644
index 0000000..afd60fc
--- /dev/null
+++ b/hosts.hs
@@ -0,0 +1,107 @@
1import Data.Maybe
2import Data.List
3import Data.Either
4import Control.Monad
5import System.Environment
6import Hosts
7import qualified Data.ByteString.Lazy.Char8 as L
8import System.IO
9import System.Exit
10import Network.Socket ( SockAddr )
11
12data HostsArgs addr = HostsArgs
13 { dbfile :: FilePath
14 , hquery :: Bool
15 , makeCanon :: Bool
16 , keyvals :: [(String,addr)]
17 }
18 deriving (Eq,Show)
19
20parseArgs :: [String] -> (HostsArgs String, String)
21parseArgs args = ( HostsArgs { dbfile = dbfile
22 , hquery = hquery
23 , makeCanon = canon
24 , keyvals = keyvals }
25 , bad )
26 where
27 singles = "lc"
28 doubles = "f"
29
30 filterDoubles (x:xs) =
31 if take 2 x `elem` map (\c->'-':c:[]) doubles
32 then let (ds,ns) = filterDoubles xs'
33 (x',xs') = case drop 1 x of
34 [c] -> (c:concat (take 1 xs), drop 1 xs)
35 v -> (v, xs)
36 in (x':ds, ns)
37 else let (ds,ns) = filterDoubles xs
38 in (ds, x:ns)
39 filterDoubles _ = ([],[])
40
41 pairs (x:y:ys) = (x,y):pairs ys
42 pairs _ = []
43
44 (as,bs) = span (/="--") args
45 (dbs,as') = filterDoubles as
46 (ss0,as'') = partition ("-" `isPrefixOf`) as'
47 ss = ss0 >>= drop 1
48 (ks,bad) = partition (`elem` singles) ss
49
50 dbfile = case drop 1 $ concat $ take 1 $ filter ("f" `isPrefixOf`) dbs of
51 "" -> "/etc/hosts"
52 x -> x
53 hquery = 'l' `elem` ks
54 canon = 'c' `elem` ks
55 keyvals = pairs $ as'' ++ drop 1 bs
56
57
58
59
60crap strs = do
61 forM_ strs $ hPutStrLn stderr
62 exitFailure
63
64grokPairing :: Bool -> Hosts -> (String,Either String SockAddr) -> Hosts
65grokPairing bCanon hosts (name,eaddr) =
66 case eaddr of
67 Right addr -> assign addr (L.pack name) hosts
68 Left "delete" -> error "deletion not implemented."
69 where
70 assign = if bCanon then assignNewName else assignName
71
72main = do
73 args <- getArgs
74 let (cmd,badness) = parseArgs args
75 if not (null badness)
76 then crap ["Bad options: " ++ badness]
77 else do
78 let cmd' = cmd { keyvals = map (\(n,a) -> (n, maybe (Left a) Right $ inet_pton a))
79 $ keyvals cmd }
80 let badaddrs = filter (/="delete") $ lefts (map snd $ keyvals cmd')
81 if not $ null badaddrs
82 then crap $ map ("Expected \"delete\" or an ip address: "++) badaddrs
83 else do
84 if null $ keyvals cmd'
85 then crap ["hosts [-f file] [-l | -c] hostname (address|delete) ..."
86 ,""
87 ," address: an ip address"
88 ," delete: the literal word \"delete\""
89 ," hostname: a host name to assign to"
90 ," file: a file to edit (default: /etc/hosts)"
91 ,""
92 ," -l Instead of editing, set error code to indicate the"
93 ," absense of a pairing"
94 ,""
95 ," -c New assignments will change the cannonical name for"
96 ," the given address."
97 ]
98 else do
99 return ()
100 hosts <- fmap decode $ L.readFile (dbfile cmd')
101 if hquery cmd' then crap ["query not implemented"] else do
102 let hosts' = foldl' (grokPairing (makeCanon cmd'))
103 hosts
104 (keyvals cmd')
105 d = diff hosts hosts'
106 forM_ d $ L.putStrLn
107 L.writeFile (dbfile cmd') (encode hosts')