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
: Domain
.files option ref
= ref NONE
36 val _
= Domain
.registerBefore
37 (fn _
=> dns
:= Option
.map (fn node
=> Domain
.domainsFile
{node
= node
,
39 (Domain
.dnsMaster ()))
41 val _
= Domain
.registerAfter
42 (fn _
=> (Option
.app (fn files
=> #close
files ()) (!dns
);
45 val dl
= ErrorMsg
.dummyLoc
49 | CNAME
of string * string
54 val record
= fn (EApp ((EApp ((EVar
"dnsA", _
), e1
), _
), e2
), _
) =>
55 (case (Env
.string e1
, Domain
.ip e2
) of
56 (SOME v1
, SOME v2
) => SOME (A (v1
, v2
))
58 |
(EApp ((EApp ((EVar
"dnsCNAME", _
), e1
), _
), e2
), _
) =>
59 (case (Env
.string e1
, Env
.string e2
) of
60 (SOME v1
, SOME v2
) => SOME (CNAME (v1
, v2
))
62 |
(EApp ((EApp ((EVar
"dnsMX", _
), e1
), _
), e2
), _
) =>
63 (case (Env
.int e1
, Env
.string e2
) of
64 (SOME v1
, SOME v2
) => SOME (MX (v1
, v2
))
66 |
(EApp ((EVar
"dnsNS", _
), e
), _
) =>
67 Option
.map
NS (Env
.string e
)
68 |
(EApp ((EVar
"dnsDefaultA", _
), e
), _
) =>
69 Option
.map
DefaultA (Env
.string e
)
72 fun writeRecord (evs
, r
) =
74 NONE
=> print
"Warning: DNS directive ignored because no master DNS server is configured for this domain\n"
77 fun write s
= #write files s
78 fun writeDom () = #writeDom
files ()
79 val ttl
= Env
.env Env
.int (evs
, "TTL")
82 A (from
, to
) => (write from
;
86 write (Int.toString ttl
);
90 | DefaultA to
=> (writeDom ();
92 write (Int.toString ttl
);
96 |
CNAME (from
, to
) => (write from
;
100 write (Int.toString ttl
);
101 write
"\tIN\tCNAME\t";
104 |
MX (num
, host
) => (write
"\t";
105 write (Int.toString ttl
);
107 write (Int.toString num
);
111 | NS host
=> (write
"\t";
112 write (Int.toString ttl
);
118 val () = Env
.actionV_one
"dns"
123 case TextIO.inputLine inf
of
124 NONE
=> raise Fail
"Expected a line for BIND"
125 | SOME s
=> String.substring (s
, 0, size s
- 1)
127 fun readILine inf
= valOf (Int.fromString (readLine inf
))
129 val monthToInt
= fn Date
.Jan
=> 1
144 CharVector
.tabulate (amt
- size s
, fn _
=> ch
) ^ s
150 val date
= Date
.fromTimeUniv (Time
.now ())
152 padBy #
"0" 4 (Int.toString (Date
.year date
))
153 ^ padBy #
"0" 2 (Int.toString (monthToInt (Date
.month date
)))
154 ^ padBy #
"0" 2 (Int.toString (Date
.day date
))
157 val () = Slave
.registerFileHandler (fn fs
=>
159 val {dir
, file
} = OS
.Path
.splitDirFile (#file fs
)
162 if #domain fs
= !didDomain
then
164 else if #action fs
= Slave
.Delete
then
166 val fname
= OS
.Path
.joinBaseExt
{base
= #domain fs
,
168 val fname
= OS
.Path
.joinDirFile
{dir
= Config
.Bind
.zonePath
,
171 Slave
.shellF ([Config
.rm
, " -f ", fname
],
172 fn cl
=> "Error deleting file: " ^ cl
)
176 val inf
= TextIO.openIn (OS
.Path
.joinDirFile
{dir
= #dir fs
,
178 val kind
= readLine inf
179 val ttl
= readILine inf
180 val ns
= readLine inf
181 val serial
= case readLine inf
of
183 | s
=> Int.fromString s
184 val rf
= readILine inf
185 val ret
= readILine inf
186 val exp
= readILine inf
187 val min
= readILine inf
188 val () = TextIO.closeIn inf
190 val serialPath
= OS
.Path
.joinDirFile
{dir
= Config
.serialDir
,
194 val inf
= TextIO.openIn serialPath
197 before TextIO.closeIn inf
198 end handle IO
.Io
{name
, ...} => NONE
202 SOME n
=> Int.toString n
205 val prefix
= dateString ()
211 if size old
>= 8 andalso
212 String.substring (old
, 0, 8) = prefix
then
213 case Int.fromString (String.extract (old
, 8, NONE
)) of
215 | SOME old
=> padBy #
"0" 2 (Int.toString (old
+1))
220 val outf
= TextIO.openOut serialPath
221 val _
= TextIO.output (outf
, newSerial
)
222 val _
= TextIO.closeOut outf
224 val dns
= OS
.Path
.joinDirFile
{dir
= #dir fs
,
227 val fname
= OS
.Path
.joinBaseExt
{base
= #domain fs
,
229 val fname
= OS
.Path
.joinDirFile
{dir
= Config
.Bind
.zonePath
,
232 val outf
= TextIO.openOut fname
235 TextIO.output (outf
, "$TTL ");
236 TextIO.output (outf
, Int.toString ttl
);
237 TextIO.output (outf
, "\n\n@\tIN\tSOA\t");
238 TextIO.output (outf
, ns
);
239 TextIO.output (outf
, ".\thostmaster.");
240 TextIO.output (outf
, #domain fs
);
241 TextIO.output (outf
, ". ( ");
242 TextIO.output (outf
, newSerial
);
243 TextIO.output (outf
, " ");
244 TextIO.output (outf
, Int.toString rf
);
245 TextIO.output (outf
, " ");
246 TextIO.output (outf
, Int.toString ret
);
247 TextIO.output (outf
, " ");
248 TextIO.output (outf
, Int.toString exp
);
249 TextIO.output (outf
, " ");
250 TextIO.output (outf
, Int.toString min
);
251 TextIO.output (outf
, " )\n\n");
252 TextIO.closeOut outf
;
253 if Posix
.FileSys
.access (dns
, []) then
254 Slave
.shellF ([Config
.cat
, " ", dns
, " >>", fname
],
255 fn cl
=> "Error concatenating file: " ^ cl
)
258 didDomain
:= #domain fs
262 "soa" => dnsChanged ()
263 |
"dns" => dnsChanged ()
264 |
"named.conf" => namedChanged
:= true
268 val () = Slave
.registerPostHandler
270 (if !namedChanged
then
271 Slave
.concatTo (fn s
=> s
= "named.conf") Config
.Bind
.namedConf
274 if !namedChanged
orelse !zoneChanged
then
275 Slave
.shellF ([Config
.Bind
.reload
],
276 fn cl
=> "Error reloading bind with " ^ cl
)
280 val () = Domain
.registerResetLocal (fn () =>
281 ignore (OS
.Process
.system (Config
.rm ^
" -rf /var/domtool/zones/*")))