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