X-Git-Url: http://git.hcoop.net/bpt/portal.git/blobdiff_plain/b6e2318111ec35ec2015ddf17679dd31270d77cb..ddc53b567f705a72730b21c2e7f02faba478f80a:/stats.sml

diff --git a/stats.sml b/stats.sml
index 620b71e..72b5836 100644
--- a/stats.sml
+++ b/stats.sml
@@ -8,14 +8,24 @@ struct
 		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 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
@@ -41,8 +51,11 @@ struct
 		   (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"
+		       [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)
@@ -61,55 +74,67 @@ struct
 		       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 ((d, map checkSsl l, valOf (Int.fromString x)) :: L)
+			   readGroups ({user = d, hosts = map (checkSsl o split) l, size = valOf (Int.fromString x)} :: L)
 		       end
-		     | _ => raise Fail "Bad row in webbw, part 2"
+		     | _ => raise Fail ("Bad row in webbw [4]: " ^ l)
        in
 	   TextIO.inputLine inf;
-	   (sum, readEm [], readGroups [])
+	   {total = sum, vhosts = readEm [], users = readGroups []}
 	   before TextIO.closeIn inf
        end
 
     type disk = {uname : string,
-		 blocks : int,
-		 files : int}
+		 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 ("/usr/bin/sudo", ["/usr/sbin/repquota", "-g", "/home"])
+	    val proc = Unix.execute ("/bin/sh", ["-c", "/usr/bin/vos listvol deleuze"])
 	    val inf = Unix.textInstreamOf proc
 
-	    fun skipUntilLine () =
+	    fun loop acc =
 		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, dash, 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
+		    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
-	    skipUntilLine ();
-	    readData []
-	    before ignore (Unix.reap proc)
+	    ignore (Unix.reap proc);
+	    ListMergeSort.sort (fn ({kbs = kbs1, ...}, {kbs = kbs2, ...}) => kbs1 < kbs2) users
 	end
 
 end