Increase domain component length limit

[hcoop/zz_old/portal.git] / stats.sml

structure Stats :> STATS =
struct
   val webbw = "/etc/stats/webbw"
   val webbw_last = "/etc/stats/webbw.last"
   val webbw_last2 = "/etc/stats/webbw.last2"

   type host = {ssl : bool,
		hostname : string,
		id : string}

   fun checkSsl host =
       case String.fields (fn ch => ch = #".") host of
	   first::rest =>
	   (case String.fields (fn ch => ch = #"_") first of
		[first, "ssl"] => {ssl = true, hostname = String.concatWith "." (first::rest),
				   id = host}
	      | _ => {ssl = false, hostname = host, id = host})
	 | _ => {ssl = false, hostname = host, id = host}

   fun getWebbw last =
       let
	   val fname =
	       case last of
		   2 => webbw_last2
		 | 1 => webbw_last
		 | 0 => webbw
		 | _ => raise Fail "Asked for too old of a bandwidth file"

	   val inf = TextIO.openIn fname

	   val sum = case TextIO.inputLine inf of
			 NONE => raise Fail "Can't read webbw"
		       | SOME l =>

			 case String.tokens Char.isSpace l of
			     [_, n] => valOf (Int.fromString n)
			   | _ => raise Fail "Bad total in webbw"

	   fun readEm L =
	       case TextIO.inputLine inf of
		   (NONE | SOME "\n") => List.rev L
		 | SOME l =>
		   case String.tokens (fn ch => Char.isSpace ch orelse ch = #":") l of
		       [d, n] => readEm ((checkSsl d, valOf (Int.fromString n)) :: L)
		     | _ => raise Fail "Bad row in webbw"

	   fun splitLast [] = raise Fail "Not enough items for splitLast"
	     | splitLast [x] = ([], x)
	     | splitLast (h::t) =
	       let
		   val (l, x) = splitLast t
	       in
		   (h::l, x)
	       end

	   fun readGroups L =
	       case TextIO.inputLine inf of
		   NONE => List.rev L
		 | SOME l =>
		   case String.tokens (fn ch => Char.isSpace ch orelse ch = #":" orelse ch = #"[" orelse ch = #"]" orelse ch = #",") l of
		       d :: rest =>
		       let
			   val (l, x) = splitLast rest
		       in
			   readGroups ((d, map checkSsl l, valOf (Int.fromString x)) :: L)
		       end
		     | _ => raise Fail "Bad row in webbw, part 2"
       in
	   TextIO.inputLine inf;
	   (sum, readEm [], readGroups [])
	   before TextIO.closeIn inf
       end

    type disk = {uname : string,
		 blocks : int,
		 files : int}

    fun getDiskUsage () =
	let
	    val proc = Unix.execute ("/usr/bin/sudo", ["/usr/sbin/repquota", "-g", "/home"])
	    val inf = Unix.textInstreamOf proc

	    fun skipUntilLine () =
		case TextIO.inputLine inf of
		    NONE => raise Fail "No dividing line found in repquota output"
		  | SOME s =>
		    if String.sub (s, 0) = #"-" then
			()
		    else
			skipUntilLine ()

	    fun readData acc =
		let
		    fun done () =
			ListMergeSort.sort (fn (d1, d2) =>
					       #blocks d1 < #blocks d2) acc
		in
		    case TextIO.inputLine inf of
			NONE => done ()
		      | SOME s =>
			case String.tokens Char.isSpace s of
			    [uname, "--", blocks, bsoft, bhard, files, fsoft, fhard] =>
			    readData ({uname = uname,
				       blocks = valOf (Int.fromString blocks),
				       files = valOf (Int.fromString files)} :: acc)
			  | [uname, "+-", blocks, bsoft, bhard, _, files, fsoft, fhard] =>
			    readData ({uname = uname,
				       blocks = valOf (Int.fromString blocks),
				       files = valOf (Int.fromString files)} :: acc)
			  | [uname, "-+", blocks, bsoft, bhard, files, fsoft, fhard, _] =>
			    readData ({uname = uname,
				       blocks = valOf (Int.fromString blocks),
				       files = valOf (Int.fromString files)} :: acc)
			  | [uname, "++", blocks, bsoft, bhard, _, files, fsoft, fhard, _] =>
			    readData ({uname = uname,
				       blocks = valOf (Int.fromString blocks),
				       files = valOf (Int.fromString files)} :: acc)
			  | [] => done ()
			  | _ => raise Fail ("Bad repquota line: " ^ s)
		end
	in
	    skipUntilLine ();
	    readData []
	    before ignore (Unix.reap proc)
	end

end