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
|
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Regfish.Parser
( readZone
) where
import qualified Data.ByteString.Lazy.Char8 as LBS8
import Regfish.Types
import Text.HTML.TagSoup
readZone :: LBS8.ByteString -> [Record]
readZone = parseRecords . dnszone
parseRecords :: [Tag LBS8.ByteString] -> [Record]
parseRecords =
map toRecord . filter knownRecord . rec []
where
knownRecord (_ : _ : _ : namespace : type_ : _) =
namespace == "IN" && type_ `elem` ["MX", "A", "CNAME"]
knownRecord x =
errorBadArgument "parseRecords.knownRecord" x
rec ys = \case
(TagOpen "tr" attrs:xs) ->
case getRecordId attrs of
Just id_ ->
let (r,_:xs') = span (/=TagClose "tr") xs
in rec (parseRecord id_ r:ys) xs'
_ ->
let xs' = drop 1 $ dropWhile (/=TagClose "tr") xs
in rec ys xs'
[] -> ys
x -> errorBadArgument "parseRecords.rec" x
getRecordId attrs =
case maybe Nothing (Just . LBS8.unpack) $ lookup "id" attrs of
Just ('a':'_':xs) -> Just (LBS8.pack xs)
_ -> Nothing
toRecord :: [LBS8.ByteString] -> Record
toRecord xs = case map LBS8.unpack xs of
[rrid, rrname, rrttl, "IN", rrtype, rraux, rrdata] ->
Record rrid rrtype rrname (read rrttl) (read rraux) rrdata
[rrid, rrname, rrttl, "IN", rrtype, rrdata] ->
Record rrid rrtype rrname (read rrttl) 0 rrdata
x ->
errorBadArgument "toRecord" x
dnszone :: LBS8.ByteString -> [Tag LBS8.ByteString]
dnszone =
filter p . (dnszoneSoup . parseTags)
where
p = \case
TagOpen "tr" _ -> True
TagClose "tr" -> True
TagText x
| x /= "\n" -> True
| otherwise -> False
_ -> False
parseRecord :: LBS8.ByteString -> [Tag LBS8.ByteString] -> [LBS8.ByteString]
parseRecord id_ =
(id_:) . add_def_ttl "0" . filter p . map f
where
f (TagText x) = x
f x = errorBadArgument "parseRecord" x
p x
| x == "\160" = False
| x == " " = False
| otherwise = True
add_def_ttl def_ttl (x:"IN":xs) = x : def_ttl : "IN" : xs
add_def_ttl _ xs = xs
dnszoneSoup :: [Tag LBS8.ByteString] -> [Tag LBS8.ByteString]
dnszoneSoup =
takeWhile (\t -> not $ t ~== dnszoneClose) .
dropWhile (\t -> not $ t ~== dnszoneOpen)
dnszoneOpen, dnszoneClose :: Tag LBS8.ByteString
dnszoneOpen = TagOpen "table" [("id", "dnszone")]
dnszoneClose = TagClose "table"
errorBadArgument :: Show a => String -> a -> b
errorBadArgument name x =
error $ "Regfish.Parser." ++ name ++ ": bad argument: " ++ show x
|
