Commit | Line | Data |
---|---|---|
182a2654 AC |
1 | (* |
2 | Domtool (http://hcoop.sf.net/) | |
3 | Copyright (C) 2004 Adam Chlipala | |
4 | ||
5 | This program is free software; you can redistribute it and/or | |
6 | modify it under the terms of the GNU General Public License | |
7 | as published by the Free Software Foundation; either version 2 | |
8 | of the License, or (at your option) any later version. | |
9 | ||
10 | This program is distributed in the hope that it will be useful, | |
11 | but WITHOUT ANY WARRANTY; without even the implied warranty of | |
12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
13 | GNU General Public License for more details. | |
14 | ||
15 | You should have received a copy of the GNU General Public License | |
16 | along with this program; if not, write to the Free Software | |
17 | Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. | |
18 | *) | |
19 | ||
20 | (* Djbdns DNS mapping config *) | |
21 | ||
22 | structure Djbdns :> DJBDNS = | |
23 | struct | |
24 | open Config DjbdnsConfig Util | |
25 | ||
26 | val ldHandler = ref (fn _ : string => ()) | |
27 | fun setLocalDomainHandler f = ldHandler := f | |
28 | ||
29 | val dns = ref (NONE : TextIO.outstream option) | |
30 | ||
31 | fun init () = dns := SOME (TextIO.openOut (scratchDir ^ "/data.shared")) | |
32 | fun finish () = (TextIO.closeOut (valOf (!dns)); | |
33 | dns := NONE) | |
34 | ||
35 | fun handler {path, domain, parent, vars, paths, users, groups} = | |
36 | let | |
37 | val _ = Domtool.dprint ("Reading dns " ^ path ^ " for " ^ parent ^ "....") | |
38 | ||
39 | val dns = valOf (!dns) | |
40 | ||
41 | val al = TextIO.openIn path | |
42 | ||
43 | val hasEmail = ref false | |
44 | ||
45 | fun loop (line, mxnum) = | |
46 | let | |
47 | fun err () = (Domtool.error (path, "Invalid entry: " ^ trimLast line); | |
48 | mxnum) | |
49 | in | |
50 | case String.tokens Char.isSpace line of | |
51 | [] => mxnum | |
52 | | ["Default", addr] => | |
53 | (case resolveAddr (vars, addr) of | |
54 | "" => err () | |
55 | | addr => (TextIO.output (dns, "=" ^ parent ^ ":" ^ addr ^ "\n"); | |
56 | mxnum)) | |
57 | | [ty, host, addr] => | |
58 | let | |
59 | val pre = | |
60 | (case ty of | |
61 | "Primary" => "." | |
62 | | "Secondary" => "&" | |
63 | | "Host" => "=" | |
64 | | "Alias" => "+" | |
65 | | "Mail" => "@" | |
66 | | "Redir" => "C" | |
67 | | _ => "") | |
68 | in | |
69 | if pre = "C" then | |
70 | (case resolveDomain (vars, addr) of | |
71 | "" => err () | |
72 | | host' => | |
73 | if validHost host then | |
74 | (TextIO.output (dns, pre ^ host ^ "." ^ parent ^ ":" ^ addr ^ "\n"); | |
75 | mxnum) | |
76 | else | |
77 | err ()) | |
78 | else case (resolveAddr (vars, addr), pre) of | |
79 | ("", _) => err () | |
80 | | (addr, ".") => | |
81 | if validHost host then | |
82 | (TextIO.output (dns, pre ^ parent ^ ":" ^ addr ^ ":" ^ host ^ "." ^ parent ^ "\n"); | |
83 | mxnum) | |
84 | else | |
85 | err () | |
86 | | (addr, "&") => | |
87 | if validHost host then | |
88 | (TextIO.output (dns, pre ^ parent ^ ":" ^ addr ^ ":" ^ host ^ "." ^ parent ^ "\n"); | |
89 | mxnum) | |
90 | else | |
91 | err () | |
92 | | (addr, "@") => | |
93 | (if not (!hasEmail) then | |
94 | (hasEmail := true; | |
95 | !ldHandler parent) | |
96 | else | |
97 | (); | |
98 | if validHost host then | |
99 | (TextIO.output (dns, pre ^ parent ^ ":" ^ addr ^ ":" ^ host ^ "." ^ parent ^ ":" ^ Int.toString mxnum ^ "\n"); | |
100 | mxnum+1) | |
101 | else | |
102 | err ()) | |
103 | | (addr, "=") => | |
104 | if validHost host then | |
105 | (TextIO.output (dns, pre ^ host ^ "." ^ parent ^ ":" ^ addr ^ "\n"); | |
106 | mxnum) | |
107 | else | |
108 | err () | |
109 | | (addr, "+") => | |
110 | if validHost host then | |
111 | (TextIO.output (dns, pre ^ host ^ "." ^ parent ^ ":" ^ addr ^ "\n"); | |
112 | mxnum) | |
113 | else | |
114 | err () | |
115 | | _ => err () | |
116 | end | |
117 | | _ => err () | |
118 | end | |
119 | in | |
120 | ioLoop (fn () => Domtool.inputLine al) loop 0; | |
121 | TextIO.closeIn al | |
122 | end handle Io => Domtool.error (path, "IO error") | |
123 | ||
124 | fun publish () = | |
125 | if OS.Process.isSuccess (OS.Process.system | |
126 | (diff ^ " " ^ scratchDir ^ "/data.shared " ^ dataFile)) then | |
127 | OS.Process.success | |
128 | else if not (OS.Process.isSuccess (OS.Process.system | |
129 | (cp ^ " " ^ scratchDir ^ "/data.shared " ^ dataFile))) then | |
130 | (print "Error copying data.shared\n"; | |
131 | OS.Process.failure) | |
132 | else if OS.Process.isSuccess (OS.Process.system pubCommand) then | |
133 | OS.Process.success | |
134 | else | |
135 | (print "Error publishing data.shared\n"; | |
136 | OS.Process.failure) | |
137 | ||
138 | fun mkdom {path, ...} = OS.Process.system (cp ^ " " ^ defaultFile ^ " " ^ path ^ "/.dns") | |
139 | ||
140 | val _ = Domtool.setHandler (".dns", {init = init, | |
141 | file = handler, | |
142 | finish = finish, | |
143 | publish = publish, | |
144 | mkdom = mkdom}) | |
145 | end |