1 (* HCoop
Domtool (http
://hcoop
.sourceforge
.net
/)
2 * Copyright (c
) 2006, Adam Chlipala
4 * This program is free software
; you can redistribute it
and/or
5 * modify it under the terms
of the GNU General Public License
6 * as published by the Free Software Foundation
; either version
2
7 * of the License
, or (at your option
) any later version
.
9 * This program is distributed
in the hope that it will be useful
,
10 * but WITHOUT ANY WARRANTY
; without even the implied warranty
of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE
. See the
12 * GNU General Public License for more details
.
14 * You should have received a copy
of the GNU General Public License
15 * along
with this program
; if not
, write to the Free Software
16 * Foundation
, Inc
., 51 Franklin Street
, Fifth Floor
, Boston
, MA
02110-1301, USA
.
21 structure Bind
:> BIND
= struct
25 val namedChanged
= ref
false
26 val zoneChanged
= ref
false
28 val didDomain
= ref
""
30 val () = Slave
.registerPreHandler (fn () => (namedChanged
:= false;
34 val dns
: TextIO.outstream option ref
= ref NONE
35 fun dnsF () = valOf (!dns
)
37 fun write s
= TextIO.output (dnsF (), s
)
39 val _
= Domain
.registerBefore
40 (fn _
=> dns
:= SOME (Domain
.domainFile
"dns"))
42 val _
= Domain
.registerAfter
43 (fn _
=> TextIO.closeOut (dnsF ()))
45 val dl
= ErrorMsg
.dummyLoc
49 | CNAME
of string * string
53 val record
= fn (EApp ((EApp ((EVar
"dnsA", _
), e1
), _
), e2
), _
) =>
54 (case (Env
.string e1
, Env
.string e2
) of
55 (SOME v1
, SOME v2
) => SOME (A (v1
, v2
))
57 |
(EApp ((EApp ((EVar
"dnsCNAME", _
), e1
), _
), e2
), _
) =>
58 (case (Env
.string e1
, Env
.string e2
) of
59 (SOME v1
, SOME v2
) => SOME (CNAME (v1
, v2
))
61 |
(EApp ((EApp ((EVar
"dnsMX", _
), e1
), _
), e2
), _
) =>
62 (case (Env
.int e1
, Env
.string e2
) of
63 (SOME v1
, SOME v2
) => SOME (MX (v1
, v2
))
65 |
(EApp ((EVar
"dnsNS", _
), e
), _
) =>
66 Option
.map
NS (Env
.string e
)
69 fun writeRecord (evs
, r
) =
71 val ttl
= Env
.env Env
.int (evs
, "TTL")
74 A (from
, to
) => (write from
;
76 write (Domain
.currentDomain ());
78 write (Int.toString ttl
);
82 |
CNAME (from
, to
) => (write from
;
84 write (Domain
.currentDomain ());
86 write (Int.toString ttl
);
87 write
"\tIN\tCNAME\t";
90 |
MX (num
, host
) => (write
"\t";
91 write (Int.toString ttl
);
93 write (Int.toString num
);
97 | NS host
=> (write
"\t";
98 write (Int.toString ttl
);
104 val () = Env
.actionV_one
"dns"
109 case TextIO.inputLine inf
of
110 NONE
=> raise Fail
"Expected a line for BIND"
111 | SOME s
=> String.substring (s
, 0, size s
- 1)
113 fun readILine inf
= valOf (Int.fromString (readLine inf
))
115 val () = Slave
.registerFileHandler (fn fs
=>
117 val {dir
, file
} = OS
.Path
.splitDirFile (#file fs
)
120 if #domain fs
= !didDomain
then
122 else if #action fs
= Slave
.Delete
then
124 val fname
= OS
.Path
.joinBaseExt
{base
= #domain fs
,
126 val fname
= OS
.Path
.joinDirFile
{dir
= Config
.Bind
.zonePath
,
129 OS
.FileSys
.remove fname
133 val inf
= TextIO.openIn (OS
.Path
.joinDirFile
{dir
= #dir fs
,
135 val kind
= readLine inf
136 val ttl
= readILine inf
137 val ns
= readLine inf
138 val serial
= case readLine inf
of
140 | s
=> Int.fromString s
141 val rf
= readILine inf
142 val ret
= readILine inf
143 val exp
= readILine inf
144 val min
= readILine inf
145 val () = TextIO.closeIn inf
147 val dns
= OS
.Path
.joinDirFile
{dir
= #dir fs
,
150 val fname
= OS
.Path
.joinBaseExt
{base
= #domain fs
,
152 val fname
= OS
.Path
.joinDirFile
{dir
= Config
.Bind
.zonePath
,
155 val outf
= TextIO.openOut fname
158 TextIO.output (outf
, "$TTL ");
159 TextIO.output (outf
, Int.toString ttl
);
160 TextIO.output (outf
, "\n\n@\tIN\tSOA\t");
161 TextIO.output (outf
, ns
);
162 TextIO.output (outf
, ".\thostmaster.");
163 TextIO.output (outf
, #domain fs
);
164 TextIO.output (outf
, ".\n( ");
165 TextIO.output (outf
, Int.toString
123456789);
166 TextIO.output (outf
, " ");
167 TextIO.output (outf
, Int.toString rf
);
168 TextIO.output (outf
, " ");
169 TextIO.output (outf
, Int.toString ret
);
170 TextIO.output (outf
, " ");
171 TextIO.output (outf
, Int.toString exp
);
172 TextIO.output (outf
, " ");
173 TextIO.output (outf
, Int.toString min
);
174 TextIO.output (outf
, " )\n\n");
175 TextIO.closeOut outf
;
176 Slave
.shellF ([Config
.cat
, " ", dns
, " >>", fname
],
177 fn cl
=> "Error concatenating file: " ^ cl
);
178 didDomain
:= #domain fs
182 "soa" => dnsChanged ()
183 |
"dns" => dnsChanged ()
184 |
"named.conf" => namedChanged
:= true
188 val () = Slave
.registerPostHandler
190 (if !namedChanged
then
191 Slave
.concatTo (fn s
=> s
= "named.conf") Config
.Bind
.namedConf
194 if !namedChanged
orelse !zoneChanged
then
195 Slave
.shellF ([Config
.Bind
.reload
],
196 fn cl
=> "Error reloading bind with " ^ cl
)