| 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 | |
| 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 | |
| 150 | fun addGroup (group, n, d, d') = |
| 151 | let |
| 152 | val groups' = if List.exists (fn ((x, _), _) => x = group) (!groups) then |
| 153 | map (fn v as ((gr, ds), n') => if gr = group then ((gr, d' ^ "@" ^ d :: ds), n + n') else v) (!groups) |
| 154 | else |
| 155 | ((group, [d' ^ "@" ^ d]), n) :: (!groups) |
| 156 | in |
| 157 | groups := groups' |
| 158 | end |
| 159 | |
| 160 | fun dodir {node, host} = |
| 161 | let |
| 162 | val fullHost = host |
| 163 | |
| 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 () |
| 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" |
| 215 | |
| 216 | val group = |
| 217 | if host <> Config.Webalizer.defaultHost then |
| 218 | let |
| 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 |
| 242 | (SOME ret, SOME group) => addGroup (group, ret, node, sslTweak fullHost) |
| 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 |
| 265 | | SOME n => loop' (((d, sslTweak d'), n) :: L) |
| 266 | |
| 267 | val L = |
| 268 | if d = "main" then |
| 269 | L |
| 270 | else |
| 271 | loop' L |
| 272 | in |
| 273 | loop L |
| 274 | end |
| 275 | |
| 276 | fun sort ls = ListMergeSort.sort (fn ((_, n1), (_, n2)) => n1 < n2) ls |
| 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"); |
| 285 | List.app (fn ((node, host), n) => print (host ^ "@" ^ node ^ ": " ^ Int.toString n ^ "\n")) doms; |
| 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 | |