Fixes to webbw while getting it parsed in the portal

[hcoop/domtool2.git] / src / stats / webbw.sml

(*
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