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 | (* Utility functions *) | |
21 | ||
22 | structure Util :> UTIL = | |
23 | struct | |
24 | fun impLoop next stop body init = | |
25 | let | |
26 | fun loop state = | |
27 | let | |
28 | val v = next () | |
29 | in | |
30 | if stop v then | |
31 | () | |
32 | else | |
33 | loop (body (v, state)) | |
34 | end | |
35 | in | |
36 | loop init | |
37 | end | |
38 | ||
182a2654 AC |
39 | fun ioOptLoop next body init = |
40 | let | |
41 | fun loop state = | |
42 | case next () of | |
43 | NONE => () | |
44 | | SOME v => loop (body (v, state)) | |
45 | in | |
46 | loop init | |
47 | end | |
48 | ||
49 | fun isIdent ch = Char.isLower ch orelse Char.isDigit ch | |
50 | ||
05060d16 AC |
51 | fun isInt s = Int.fromString s <> NONE |
52 | ||
53 | fun isNat s = | |
54 | case Int.fromString s of | |
55 | NONE => false | |
56 | | SOME n => n >= 0 | |
57 | ||
58 | fun chop s = String.substring (s, 0, size s - 1) | |
59 | ||
182a2654 | 60 | fun validHost s = |
4d3abed7 AC |
61 | size s > 0 andalso size s < 20 andalso CharVector.all (fn ch => isIdent ch orelse ch = #"-") s |
62 | ||
63 | fun validVhostFilename s = | |
64 | case String.fields (fn ch => ch = #".") s of | |
65 | [s] => validHost s | |
66 | | [s, "ssl"] => validHost s | |
67 | | _ => false | |
68 | ||
182a2654 AC |
69 | fun validDomain s = |
70 | size s > 0 andalso size s < 100 andalso List.all validHost (String.fields (fn ch => ch = #".") s) | |
71 | ||
72 | fun validUser s = | |
4d3abed7 | 73 | size s > 0 andalso size s < 50 andalso CharVector.all |
182a2654 | 74 | (fn ch => isIdent ch orelse ch = #"." orelse ch = #"_" orelse ch = #"-" orelse ch = #"+") |
4d3abed7 | 75 | s |
182a2654 | 76 | |
05060d16 | 77 | fun validEmailUser s = |
4d3abed7 | 78 | size s > 0 andalso size s < 50 andalso CharVector.all |
05060d16 | 79 | (fn ch => Char.isAlphaNum ch orelse ch = #"." orelse ch = #"_" orelse ch = #"-" orelse ch = #"+") |
4d3abed7 | 80 | s |
182a2654 AC |
81 | fun validEmail s = |
82 | (case String.fields (fn ch => ch = #"@") s of | |
05060d16 | 83 | [user, host] => validEmailUser user andalso validDomain host |
182a2654 AC |
84 | | _ => false) |
85 | ||
86 | fun isTmp s = | |
4d3abed7 | 87 | CharVector.exists (fn ch => ch = #"#" orelse ch = #"~") s |
182a2654 AC |
88 | |
89 | fun validIp s = | |
90 | (case map Int.fromString (String.fields (fn ch => ch = #".") s) of | |
91 | [SOME n1, SOME n2, SOME n3, SOME n4] => | |
92 | n1 >= 0 andalso n1 < 256 andalso n2 >= 0 andalso n2 < 256 andalso n3 >= 0 andalso n3 < 256 andalso n4 >= 0 andalso n4 < 256 | |
93 | | _ => false) | |
94 | ||
95 | fun trimLast s = | |
96 | if size s = 0 then | |
97 | s | |
98 | else | |
99 | String.substring (s, 0, size s - 1) | |
100 | ||
101 | fun toDir s = | |
102 | foldr (fn (a, s) => s ^ "/" ^ a) "" (String.tokens (fn ch => ch = #".") s) | |
103 | ||
104 | fun checkPath (paths, path) = | |
105 | StringSet.exists (fn pref => path = pref orelse (size path >= size pref + 2 andalso substring (path, 0, size pref) = pref | |
106 | andalso String.sub (path, size pref) = #"/")) paths | |
107 | andalso List.all (fn s => s <> "..") (String.fields (fn ch => ch = #"/") path) | |
108 | ||
109 | fun resolveAddr (vars, s) = | |
110 | if validIp s then | |
111 | s | |
112 | else | |
113 | (case StringMap.find (vars, s) of | |
114 | NONE => "" | |
115 | | SOME v => | |
116 | if validIp v then | |
117 | v | |
118 | else | |
119 | "") | |
120 | ||
121 | fun resolveDomain (vars, s) = | |
122 | if validDomain s then | |
123 | s | |
124 | else | |
125 | (case StringMap.find (vars, s) of | |
126 | NONE => "" | |
127 | | SOME v => | |
128 | if validDomain v then | |
129 | v | |
130 | else | |
131 | "") | |
874b616a AC |
132 | |
133 | fun enrichSetFromFile (fname, set) = | |
134 | let | |
135 | open TextIO | |
136 | val uid = Posix.ProcEnv.wordToUid (SysWord.fromInt Config.uid) | |
137 | in | |
138 | if Posix.FileSys.access (fname, []) then | |
139 | (if Posix.FileSys.ST.uid (Posix.FileSys.stat fname) = uid then | |
140 | let | |
141 | val vf = openIn fname | |
142 | ||
143 | fun loop set = | |
144 | let | |
145 | val line = inputLine vf | |
146 | in | |
147 | case line of | |
148 | NONE => set | |
149 | | SOME "CLEAR\n" => loop StringSet.empty | |
150 | | SOME line => | |
151 | (case String.tokens Char.isSpace line of | |
152 | [item] => loop (StringSet.add (set, item)) | |
153 | | _ => loop set) | |
154 | end | |
155 | in | |
156 | loop set | |
157 | before TextIO.closeIn vf | |
158 | end | |
159 | else | |
160 | (print (fname ^ ": wrong owner to be used"); | |
161 | set)) | |
162 | else | |
163 | set | |
164 | end | |
4471dd55 AC |
165 | |
166 | fun merge (L1 : ('a * int) list, L2 : ('a * int) list) acc = | |
167 | case (L1, L2) of | |
168 | (_, []) => List.revAppend (acc, L1) | |
169 | | ([], _) => List.revAppend (acc, L2) | |
170 | | (n1::t1, n2::t2) => | |
171 | if #2 n1 > #2 n2 then | |
172 | merge (t1, L2) (n1 :: acc) | |
173 | else | |
174 | merge (L1, t2) (n2 :: acc) | |
175 | ||
176 | fun split n L acc = | |
177 | if n <= 0 then | |
178 | (acc, L) | |
179 | else | |
180 | case L of | |
181 | [] => (acc, []) | |
182 | | h::t => split (n-1) t (h::acc) | |
183 | ||
184 | fun mergeSort L = | |
185 | case L of | |
186 | [] => L | |
187 | | [a] => L | |
188 | | _ => | |
189 | let | |
190 | val mid = length L div 2 | |
191 | val (L1, L2) = split mid L [] | |
192 | in | |
193 | merge (mergeSort L1, mergeSort L2) [] | |
194 | end | |
182a2654 AC |
195 | end |
196 |