From 77f46d6c08671d5e038e327cc5cd333df3aaf696 Mon Sep 17 00:00:00 2001
From: joe <joe@jerkface.net>
Date: Thu, 31 Jul 2014 02:59:46 -0400
Subject: hosts utility for editing /etc/hosts

---
 hosts.hs | 107 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 107 insertions(+)
 create mode 100644 hosts.hs

(limited to 'hosts.hs')

diff --git a/hosts.hs b/hosts.hs
new file mode 100644
index 0000000..afd60fc
--- /dev/null
+++ b/hosts.hs
@@ -0,0 +1,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')
-- 
cgit v1.2.3