(* Domtool 2 (http://hcoop.sf.net/) Copyright (C) 2004-2007 Adam Chlipala This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) (* Generation of aggregate per-user/per-vhost web bandwidth statistics *) structure Webbw = struct val groupsBase = Config.Webalizer.defaultOutput (* Where to look for grouped user statistics *) fun mots m = let open Date in case m of Jan => "Jan" | Feb => "Feb" | Mar => "Mar" | Apr => "Apr" | May => "May" | Jun => "Jun" | Jul => "Jul" | Aug => "Aug" | Sep => "Sep" | Oct => "Oct" | Nov => "Nov" | Dec => "Dec" end fun motn m = let open Date in case m of Jan => "01" | Feb => "02" | Mar => "03" | Apr => "04" | May => "05" | Jun => "06" | Jul => "07" | Aug => "08" | Sep => "09" | Oct => "10" | Nov => "11" | Dec => "12" end val monthInc = Time.fromSeconds (LargeInt.fromInt 2592000) fun doit () = let val now = Date.fromTimeLocal (Time.now ()) fun backupMonth t = let val now = Date.fromTimeLocal t fun backupMonth' t = let val d = Date.fromTimeLocal t in if Date.month d = Date.month now then backupMonth' (Time.- (t, monthInc)) else t end in backupMonth' t end fun backupMulti n = if n = 0 then Time.now () else backupMonth (backupMulti (n-1)) val now = case CommandLine.arguments () of [n] => (case Int.fromString n of NONE => raise Fail "Invalid integer parameter" | SOME n => if n >= 0 then Date.fromTimeLocal (backupMulti n) else raise Fail "Negative parameter") | _ => now val when = mots (Date.month now) ^ " " ^ Int.toString (Date.year now) val groups = let val inf = TextIO.openIn (groupsBase ^ Int.toString (Date.year now) ^ motn (Date.month now) ^ ".html") val _ = TextIO.inputLine inf val _ = TextIO.inputLine inf val _ = TextIO.inputLine inf val _ = TextIO.inputLine inf fun loop groups = case TextIO.inputLine inf of NONE => groups | SOME line => case String.tokens Char.isSpace line of [hits, perc, kb, kbperc, url] => if size url >= 4 andalso String.sub (url, 0) = #"/" andalso String.sub (url, 1) = #"~" andalso String.sub (url, size url - 2) = #"/" andalso String.sub (url, size url - 1) = #"*" then let val uname = String.substring (url, 2, size url - 4) in loop (((uname, ["www.hcoop.net"]), valOf (Int.fromString kb)) :: groups) end else loop groups | _ => groups val groups : ((string * string list) * int) list ref = ref (loop []) val _ = TextIO.closeIn inf in groups end handle ex => ref [] fun sslTweak s = case rev (String.tokens (fn ch => ch = #".") s) of "ssl" :: rest => (case rev rest of [] => raise Fail ("SSL goofyness: " ^ s) | first :: rest => first ^ "_ssl." ^ String.concatWith "." rest) | _ => s fun addGroup (group, n, d, d') = let val groups' = if List.exists (fn ((x, _), _) => x = group) (!groups) then map (fn v as ((gr, ds), n') => if gr = group then ((gr, d' ^ "@" ^ d :: ds), n + n') else v) (!groups) else ((group, [d' ^ "@" ^ d]), n) :: (!groups) in groups := groups' end fun dodir {node, host} = let val fullHost = host val file = Config.Webalizer.outputDir ^ "/" ^ node ^ "/" ^ host ^ "/index.html" in if not (Posix.FileSys.access (file, [])) then NONE else let val inf = TextIO.openIn file fun andWeep () = let fun waste n = if n <= 0 then () else (TextIO.inputLine inf; waste (n-1)) val _ = waste 5 val l = valOf (TextIO.inputLine inf) val num = String.extract (l, 32, NONE) fun getNum i = if Char.isDigit (String.sub (num, i)) then getNum (i+1) else valOf (Int.fromString (String.substring (num, 0, i))) in getNum 0 end fun readEm () = case TextIO.inputLine inf of NONE => NONE | SOME l => if Substring.isSubstring when (Substring.full l) then SOME (andWeep ()) else readEm () val ret = readEm () val tokens = String.tokens (fn ch => ch = #".") host val (tokens, ssl) = case rev tokens of "ssl" :: tokens => (rev tokens, true) | _ => (tokens, false) val (host, tokens) = case tokens of host :: tokens => (host, tokens) | _ => raise Fail "Host name too short" val group = if host <> Config.Webalizer.defaultHost then let val file = Config.resultRoot ^ "/" ^ node ^ "/" ^ String.concatWith "/" (rev tokens) ^ "/" ^ host ^ "." ^ String.concatWith "." tokens ^ ".vhost" val file = if ssl then file ^ "_ssl" else file val inf = TextIO.openIn file val line = case TextIO.inputLine inf of NONE => raise Fail ("Empty file: " ^ file) | SOME line => line val user = case String.tokens Char.isSpace line of [_, _, user] => user | _ => raise Fail ("Bad vhost file format in " ^ file) in TextIO.closeIn inf; SOME user end else NONE in (case (ret, group) of (SOME ret, SOME group) => addGroup (group, ret, node, sslTweak fullHost) | _ => ()); TextIO.closeIn inf; ret end handle IO.Io {name, function, ...} => NONE end val dir = Posix.FileSys.opendir Config.Webalizer.outputDir fun loop L = case Posix.FileSys.readdir dir of NONE => L | SOME d => let val dir = Posix.FileSys.opendir (OS.Path.joinDirFile {dir = Config.Webalizer.outputDir, file = d}) fun loop' L = case Posix.FileSys.readdir dir of NONE => L | SOME d' => case dodir {node = d, host = d'} of NONE => loop' L | SOME n => loop' (((d, sslTweak d'), n) :: L) val L = if d = "main" then L else loop' L in loop L end fun sort ls = ListMergeSort.sort (fn ((_, n1), (_, n2)) => n1 < n2) ls val doms = loop [] val doms = sort doms val groups = sort (!groups) val sum = List.foldl (fn ((_, n), s) => s+n) 0 doms in print ("TOTAL: " ^ Int.toString sum ^ "\n\n"); List.app (fn ((node, host), n) => print (host ^ "@" ^ node ^ ": " ^ Int.toString n ^ "\n")) doms; print "\n"; List.app (fn ((d, ds), n) => print (d ^ "[" ^ String.concatWith "," ds ^ "]: " ^ Int.toString n ^ "\n")) groups; Posix.FileSys.closedir dir end end