-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
HCoop / hcoop / portal.git / blobdiff