Commit | Line | Data |
---|---|---|
f086616f AC |
1 | (* |
2 | Domtool 2 (http://hcoop.sf.net/) | |
3 | Copyright (C) 2004-2007 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 | (* Generation of aggregate per-user/per-vhost web bandwidth statistics *) | |
21 | ||
22 | structure Webbw = struct | |
23 | ||
24 | val groupsBase = Config.Webalizer.defaultOutput | |
25 | (* Where to look for grouped user statistics *) | |
26 | ||
27 | fun mots m = | |
28 | let | |
29 | open Date | |
30 | in | |
31 | case m of | |
32 | Jan => "Jan" | |
33 | | Feb => "Feb" | |
34 | | Mar => "Mar" | |
35 | | Apr => "Apr" | |
36 | | May => "May" | |
37 | | Jun => "Jun" | |
38 | | Jul => "Jul" | |
39 | | Aug => "Aug" | |
40 | | Sep => "Sep" | |
41 | | Oct => "Oct" | |
42 | | Nov => "Nov" | |
43 | | Dec => "Dec" | |
44 | end | |
45 | ||
46 | fun motn m = | |
47 | let | |
48 | open Date | |
49 | in | |
50 | case m of | |
51 | Jan => "01" | |
52 | | Feb => "02" | |
53 | | Mar => "03" | |
54 | | Apr => "04" | |
55 | | May => "05" | |
56 | | Jun => "06" | |
57 | | Jul => "07" | |
58 | | Aug => "08" | |
59 | | Sep => "09" | |
60 | | Oct => "10" | |
61 | | Nov => "11" | |
62 | | Dec => "12" | |
63 | end | |
64 | ||
65 | val monthInc = Time.fromSeconds (LargeInt.fromInt 2592000) | |
66 | ||
67 | fun doit () = | |
68 | let | |
69 | val now = Date.fromTimeLocal (Time.now ()) | |
70 | ||
71 | fun backupMonth t = | |
72 | let | |
73 | val now = Date.fromTimeLocal t | |
74 | ||
75 | fun backupMonth' t = | |
76 | let | |
77 | val d = Date.fromTimeLocal t | |
78 | in | |
79 | if Date.month d = Date.month now then | |
80 | backupMonth' (Time.- (t, monthInc)) | |
81 | else | |
82 | t | |
83 | end | |
84 | in | |
85 | backupMonth' t | |
86 | end | |
87 | ||
88 | fun backupMulti n = | |
89 | if n = 0 then | |
90 | Time.now () | |
91 | else | |
92 | backupMonth (backupMulti (n-1)) | |
93 | ||
94 | val now = | |
95 | case CommandLine.arguments () of | |
96 | [n] => | |
97 | (case Int.fromString n of | |
98 | NONE => raise Fail "Invalid integer parameter" | |
99 | | SOME n => | |
100 | if n >= 0 then | |
101 | Date.fromTimeLocal (backupMulti n) | |
102 | else | |
103 | raise Fail "Negative parameter") | |
104 | | _ => now | |
105 | ||
106 | val when = mots (Date.month now) ^ " " ^ Int.toString (Date.year now) | |
107 | ||
108 | val groups = let | |
109 | val inf = TextIO.openIn (groupsBase ^ Int.toString (Date.year now) ^ motn (Date.month now) ^ ".html") | |
110 | val _ = TextIO.inputLine inf | |
111 | val _ = TextIO.inputLine inf | |
112 | val _ = TextIO.inputLine inf | |
113 | val _ = TextIO.inputLine inf | |
114 | ||
115 | fun loop groups = | |
116 | case TextIO.inputLine inf of | |
117 | NONE => groups | |
118 | | SOME line => | |
119 | case String.tokens Char.isSpace line of | |
120 | [hits, perc, kb, kbperc, url] => | |
121 | if size url >= 4 | |
122 | andalso String.sub (url, 0) = #"/" | |
123 | andalso String.sub (url, 1) = #"~" | |
124 | andalso String.sub (url, size url - 2) = #"/" | |
125 | andalso String.sub (url, size url - 1) = #"*" then | |
126 | let | |
127 | val uname = String.substring (url, 2, size url - 4) | |
128 | in | |
129 | loop (((uname, ["www.hcoop.net"]), | |
130 | valOf (Int.fromString kb)) :: groups) | |
131 | end | |
132 | else | |
133 | loop groups | |
134 | | _ => groups | |
135 | ||
136 | val groups : ((string * string list) * int) list ref = ref (loop []) | |
137 | val _ = TextIO.closeIn inf | |
138 | in | |
139 | groups | |
140 | end handle ex => ref [] | |
141 | ||
2dd2f9a6 AC |
142 | fun sslTweak s = |
143 | case rev (String.tokens (fn ch => ch = #".") s) of | |
144 | "ssl" :: rest => | |
145 | (case rev rest of | |
146 | [] => raise Fail ("SSL goofyness: " ^ s) | |
147 | | first :: rest => first ^ "_ssl." ^ String.concatWith "." rest) | |
148 | | _ => s | |
149 | ||
f086616f AC |
150 | fun addGroup (group, n, d, d') = |
151 | let | |
152 | val groups' = if List.exists (fn ((x, _), _) => x = group) (!groups) then | |
2dd2f9a6 | 153 | map (fn v as ((gr, ds), n') => if gr = group then ((gr, d' ^ "@" ^ d :: ds), n + n') else v) (!groups) |
f086616f | 154 | else |
2dd2f9a6 | 155 | ((group, [d' ^ "@" ^ d]), n) :: (!groups) |
f086616f AC |
156 | in |
157 | groups := groups' | |
158 | end | |
159 | ||
160 | fun dodir {node, host} = | |
161 | let | |
2dd2f9a6 AC |
162 | val fullHost = host |
163 | ||
f086616f AC |
164 | val file = Config.Webalizer.outputDir ^ "/" ^ node ^ "/" ^ host ^ "/index.html" |
165 | in | |
166 | if not (Posix.FileSys.access (file, [])) then | |
167 | NONE | |
168 | else | |
169 | let | |
170 | val inf = TextIO.openIn file | |
171 | ||
172 | fun andWeep () = | |
173 | let | |
174 | fun waste n = | |
175 | if n <= 0 then | |
176 | () | |
177 | else | |
178 | (TextIO.inputLine inf; | |
179 | waste (n-1)) | |
180 | ||
181 | val _ = waste 5 | |
182 | ||
183 | val l = valOf (TextIO.inputLine inf) | |
184 | val num = String.extract (l, 32, NONE) | |
185 | ||
186 | fun getNum i = | |
187 | if Char.isDigit (String.sub (num, i)) then | |
188 | getNum (i+1) | |
189 | else | |
190 | valOf (Int.fromString (String.substring (num, 0, i))) | |
191 | in | |
192 | getNum 0 | |
193 | end | |
194 | ||
195 | fun readEm () = | |
196 | case TextIO.inputLine inf of | |
197 | NONE => NONE | |
198 | | SOME l => | |
199 | if Substring.isSubstring when (Substring.full l) then | |
200 | SOME (andWeep ()) | |
201 | else | |
202 | readEm () | |
203 | ||
204 | val ret = readEm () | |
2dd2f9a6 AC |
205 | |
206 | val tokens = String.tokens (fn ch => ch = #".") host | |
207 | val (tokens, ssl) = | |
208 | case rev tokens of | |
209 | "ssl" :: tokens => (rev tokens, true) | |
210 | | _ => (tokens, false) | |
211 | val (host, tokens) = | |
212 | case tokens of | |
213 | host :: tokens => (host, tokens) | |
214 | | _ => raise Fail "Host name too short" | |
f086616f AC |
215 | |
216 | val group = | |
217 | if host <> Config.Webalizer.defaultHost then | |
218 | let | |
f086616f AC |
219 | val file = Config.resultRoot ^ "/" ^ node ^ "/" ^ String.concatWith "/" (rev tokens) |
220 | ^ "/" ^ host ^ "." ^ String.concatWith "." tokens ^ ".vhost" | |
221 | val file = if ssl then | |
222 | file ^ "_ssl" | |
223 | else | |
224 | file | |
225 | ||
226 | val inf = TextIO.openIn file | |
227 | val line = case TextIO.inputLine inf of | |
228 | NONE => raise Fail ("Empty file: " ^ file) | |
229 | | SOME line => line | |
230 | ||
231 | val user = case String.tokens Char.isSpace line of | |
232 | [_, _, user] => user | |
233 | | _ => raise Fail ("Bad vhost file format in " ^ file) | |
234 | in | |
235 | TextIO.closeIn inf; | |
236 | SOME user | |
237 | end | |
238 | else | |
239 | NONE | |
240 | in | |
241 | (case (ret, group) of | |
2dd2f9a6 | 242 | (SOME ret, SOME group) => addGroup (group, ret, node, sslTweak fullHost) |
f086616f AC |
243 | | _ => ()); |
244 | TextIO.closeIn inf; | |
245 | ret | |
246 | end handle IO.Io {name, function, ...} => NONE | |
247 | end | |
248 | ||
249 | val dir = Posix.FileSys.opendir Config.Webalizer.outputDir | |
250 | ||
251 | fun loop L = | |
252 | case Posix.FileSys.readdir dir of | |
253 | NONE => L | |
254 | | SOME d => | |
255 | let | |
256 | val dir = Posix.FileSys.opendir (OS.Path.joinDirFile {dir = Config.Webalizer.outputDir, | |
257 | file = d}) | |
258 | ||
259 | fun loop' L = | |
260 | case Posix.FileSys.readdir dir of | |
261 | NONE => L | |
262 | | SOME d' => | |
263 | case dodir {node = d, host = d'} of | |
264 | NONE => loop' L | |
2dd2f9a6 | 265 | | SOME n => loop' (((d, sslTweak d'), n) :: L) |
f086616f AC |
266 | |
267 | val L = | |
268 | if d = "main" then | |
269 | L | |
270 | else | |
271 | loop' L | |
272 | in | |
273 | loop L | |
274 | end | |
275 | ||
2dd2f9a6 | 276 | fun sort ls = ListMergeSort.sort (fn ((_, n1), (_, n2)) => n1 < n2) ls |
f086616f AC |
277 | |
278 | val doms = loop [] | |
279 | val doms = sort doms | |
280 | val groups = sort (!groups) | |
281 | ||
282 | val sum = List.foldl (fn ((_, n), s) => s+n) 0 doms | |
283 | in | |
284 | print ("TOTAL: " ^ Int.toString sum ^ "\n\n"); | |
2dd2f9a6 | 285 | List.app (fn ((node, host), n) => print (host ^ "@" ^ node ^ ": " ^ Int.toString n ^ "\n")) doms; |
f086616f AC |
286 | print "\n"; |
287 | List.app (fn ((d, ds), n) => print (d ^ "[" ^ String.concatWith "," ds ^ "]: " ^ Int.toString n ^ "\n")) groups; | |
288 | Posix.FileSys.closedir dir | |
289 | end | |
290 | ||
291 | end | |
292 |