Refactor webbw

[hcoop/zz_old/domtool.git] / src / apache / stats / webbw.sml

(*
Domtool (http://hcoop.sf.net/)
Copyright (C) 2004-2005  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 *)

open Config
open ApacheConfig
open Util

val groupsBase = wblDocDir ^ "/" ^ defaultHost ^ "/url_"
(* 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 inf = TextIO.openIn nogroups
	fun readNogr L =
	    case TextIO.inputLine inf of
		NONE => L
	      | SOME s => readNogr ((hd (String.tokens Char.isSpace s)) :: L)
	val nogr = readNogr []
	val _ = TextIO.closeIn inf

	val now = Date.fromTimeLocal (Time.now ())

	val dir = Posix.FileSys.opendir wblDocDir

	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 addGroup (group, n, d) =
	    if List.exists (fn x => x = d) nogr then
		()
	    else 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 :: ds), n + n') else v) (!groups)
				  else
				      ((group, [d]), n) :: (!groups)
		in
		    groups := groups'
		end

	fun dodir d =
	    let
		val inf = TextIO.openIn (wblDocDir ^ "/" ^ d ^ "/index.html")

		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 group =
		    if d <> defaultHost then
			let
			    val domdir = "/etc/domains/" ^ String.concatWith "/" (rev (String.tokens (fn ch => ch = #".") d))
			    val stat = Posix.FileSys.stat domdir
			in
			    SOME (Posix.SysDB.Group.name (Posix.SysDB.getgrgid (Posix.FileSys.ST.gid stat)))
			end
		    else
			NONE
	    in
		(case (ret, group) of
		   (SOME ret, SOME group) => addGroup (group, ret, d)
		 | _ => ());
		TextIO.closeIn inf;
		ret
	    end handle IO => NONE

	fun loop L =
	    case Posix.FileSys.readdir dir of
		NONE => L
	      | SOME d => (case dodir d of
			       NONE => loop L
			     | SOME n => loop ((d, n) :: L))

	val doms = loop []
	val doms = mergeSort doms
	val groups = mergeSort (!groups)

	val sum = List.foldl (fn ((_, n), s) => s+n) 0 doms
    in
	print ("TOTAL: " ^ Int.toString sum ^ "\n\n");
	List.app (fn (d, n) => print (d ^ ": " ^ 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

val _ = doit ()