X-Git-Url: https://git.hcoop.net/hcoop/portal.git/blobdiff_plain/e84aceccd570655fbd36593ca20302456e1b501a..HEAD:/stats.sml?ds=sidebyside

diff --git a/stats.sml b/stats.sml
dissimilarity index 61%
index db719b3..e8a9edf 100644
--- a/stats.sml
+++ b/stats.sml
@@ -1,127 +1,151 @@
-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
+structure Stats :> STATS =
+struct
+   val webbw = Config.statsRoot ^ "webbw"
+   val webbw_last = Config.statsRoot ^ "webbw.last"
+   val webbw_last2 = Config.statsRoot ^ "webbw.last2"
+
+   type host = {ssl : bool,
+		hostname : string,
+		id : string}
+
+   fun checkSsl (node, host) =
+       let
+	   val id = case String.tokens (fn ch => ch = #".") host of
+			[] => node ^ "/" ^ host
+		      | first :: rest =>
+			case rev (String.tokens (fn ch => ch = #"_") first) of
+			    "ssl" :: rest' => node ^ "/" ^ String.concatWith "_" (rev rest')
+					      ^ "." ^ String.concatWith "." rest ^ ".ssl"
+			  | _ => node ^ "/" ^ host
+       in
+	   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 = id}
+		  | _ => {ssl = false, hostname = host, id = id})
+	     | _ => {ssl = false, hostname = host, id = id}
+       end
+
+   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] =>
+		       (case String.tokens (fn ch => ch = #"@") d of
+			    [d, node] => readEm ({host = checkSsl (node, d), size = valOf (Int.fromString n)} :: L)
+			  | _ => raise Fail ("Bad row in webbw [2]: " ^ l))
+		     | _ => raise Fail ("Bad row in webbw [1]: " ^ l)
+
+	   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
+
+			   fun split s =
+			       case String.tokens (fn ch => ch = #"@") s of
+				   [host, node] => (node, host)
+				 | _ => raise Fail ("Bad row in webbw [3]: " ^ s)
+		       in
+			   readGroups ({user = d, hosts = map (checkSsl o split) l, size = valOf (Int.fromString x)} :: L)
+		       end
+		     | _ => raise Fail ("Bad row in webbw [4]: " ^ l)
+       in
+	   TextIO.inputLine inf;
+	   {total = sum, vhosts = readEm [], users = readGroups []}
+	   before TextIO.closeIn inf
+       end
+
+   fun getWebbwUser {user, last} =
+       let
+	   val {vhosts, users, ...} = getWebbw last
+       in
+	   case List.find (fn {user = u, ...} => u = user) users of
+	       NONE => {total = 0, vhosts = []}
+	     | SOME {hosts, size, ...} =>
+	       {total = size, vhosts = List.filter (fn {host, ...} => List.exists (fn host' => host' = host) hosts) vhosts}
+       end
+	   
+
+   type disk = {uname : string,
+		 kbs : int}
+
+    structure StringKey = struct
+    type ord_key = string
+    val compare = String.compare
+    end
+			  
+    structure SM = BinaryMapFn(StringKey)
+
+    fun getDiskUsage () =
+	let
+	    val proc = Unix.execute ("/bin/sh", ["-c", "/usr/bin/vos listvol gibran"])
+	    val inf = Unix.textInstreamOf proc
+
+	    fun loop acc =
+		case TextIO.inputLine inf of
+		    NONE => acc
+		  | SOME line =>
+		    case String.tokens Char.isSpace line of
+			[vol, _, _, kbs, _, _] =>
+			let
+			    val kbsOld = case SM.find (acc, vol) of
+					     NONE => 0
+					   | SOME n => n
+
+			    val uname = case String.tokens (fn ch => ch = #".") vol of
+					    [_, uname] =>
+					    ((Posix.SysDB.getpwnam uname;
+					      SOME uname)
+					     handle OS.SysErr _ => NONE)
+					  | _ => NONE
+
+			    val acc = case uname of
+					  NONE => acc
+					| SOME uname => SM.insert (acc, uname, valOf (Int.fromString kbs) + kbsOld)
+			in
+			    loop acc
+			end
+		      | _ => acc
+
+	    val _ = TextIO.inputLine inf
+	    val users = map (fn (uname, kbs) => {uname = uname, kbs = kbs}) (SM.listItemsi (loop SM.empty))
+	in
+	    ignore (Unix.reap proc);
+	    ListMergeSort.sort (fn ({kbs = kbs1, ...}, {kbs = kbs2, ...}) => kbs1 < kbs2) users
+	end
+
+end