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 | ||
39 | fun ioLoop next body init = impLoop next (fn s => s = "") body init | |
40 | fun ioOptLoop next body init = | |
41 | let | |
42 | fun loop state = | |
43 | case next () of | |
44 | NONE => () | |
45 | | SOME v => loop (body (v, state)) | |
46 | in | |
47 | loop init | |
48 | end | |
49 | ||
50 | fun isIdent ch = Char.isLower ch orelse Char.isDigit ch | |
51 | ||
52 | fun validHost s = | |
53 | size s > 0 andalso size s < 20 andalso List.all isIdent (String.explode s) | |
54 | ||
55 | fun validDomain s = | |
56 | size s > 0 andalso size s < 100 andalso List.all validHost (String.fields (fn ch => ch = #".") s) | |
57 | ||
58 | fun validUser s = | |
59 | size s > 0 andalso size s < 20 andalso List.all | |
60 | (fn ch => isIdent ch orelse ch = #"." orelse ch = #"_" orelse ch = #"-" orelse ch = #"+") | |
61 | (String.explode s) | |
62 | ||
63 | fun validEmail s = | |
64 | (case String.fields (fn ch => ch = #"@") s of | |
65 | [user, host] => validUser user andalso validDomain host | |
66 | | _ => false) | |
67 | ||
68 | fun isTmp s = | |
69 | List.exists (fn ch => ch = #"#" orelse ch = #"~") (String.explode s) | |
70 | ||
71 | fun validIp s = | |
72 | (case map Int.fromString (String.fields (fn ch => ch = #".") s) of | |
73 | [SOME n1, SOME n2, SOME n3, SOME n4] => | |
74 | n1 >= 0 andalso n1 < 256 andalso n2 >= 0 andalso n2 < 256 andalso n3 >= 0 andalso n3 < 256 andalso n4 >= 0 andalso n4 < 256 | |
75 | | _ => false) | |
76 | ||
77 | fun trimLast s = | |
78 | if size s = 0 then | |
79 | s | |
80 | else | |
81 | String.substring (s, 0, size s - 1) | |
82 | ||
83 | fun toDir s = | |
84 | foldr (fn (a, s) => s ^ "/" ^ a) "" (String.tokens (fn ch => ch = #".") s) | |
85 | ||
86 | fun checkPath (paths, path) = | |
87 | StringSet.exists (fn pref => path = pref orelse (size path >= size pref + 2 andalso substring (path, 0, size pref) = pref | |
88 | andalso String.sub (path, size pref) = #"/")) paths | |
89 | andalso List.all (fn s => s <> "..") (String.fields (fn ch => ch = #"/") path) | |
90 | ||
91 | fun resolveAddr (vars, s) = | |
92 | if validIp s then | |
93 | s | |
94 | else | |
95 | (case StringMap.find (vars, s) of | |
96 | NONE => "" | |
97 | | SOME v => | |
98 | if validIp v then | |
99 | v | |
100 | else | |
101 | "") | |
102 | ||
103 | fun resolveDomain (vars, s) = | |
104 | if validDomain s then | |
105 | s | |
106 | else | |
107 | (case StringMap.find (vars, s) of | |
108 | NONE => "" | |
109 | | SOME v => | |
110 | if validDomain v then | |
111 | v | |
112 | else | |
113 | "") | |
114 | end | |
115 |