Commit | Line | Data |
---|---|---|
b6e23181 AC |
1 | structure Stats :> STATS = |
2 | struct | |
3 | val webbw = "/etc/stats/webbw" | |
4 | val webbw_last = "/etc/stats/webbw.last" | |
5 | val webbw_last2 = "/etc/stats/webbw.last2" | |
6 | ||
7 | type host = {ssl : bool, | |
8 | hostname : string, | |
9 | id : string} | |
10 | ||
b13a9a37 AC |
11 | fun checkSsl (node, host) = |
12 | let | |
13 | val id = case String.tokens (fn ch => ch = #".") host of | |
14 | [] => node ^ "/" ^ host | |
15 | | first :: rest => | |
16 | case rev (String.tokens (fn ch => ch = #"_") first) of | |
17 | "ssl" :: rest' => node ^ "/" ^ String.concatWith "_" (rev rest') | |
18 | ^ "." ^ String.concatWith "." rest ^ ".ssl" | |
19 | | _ => node ^ "/" ^ host | |
20 | in | |
21 | case String.fields (fn ch => ch = #".") host of | |
22 | first::rest => | |
23 | (case String.fields (fn ch => ch = #"_") first of | |
24 | [first, "ssl"] => {ssl = true, hostname = String.concatWith "." (first::rest), | |
25 | id = id} | |
26 | | _ => {ssl = false, hostname = host, id = id}) | |
27 | | _ => {ssl = false, hostname = host, id = id} | |
28 | end | |
b6e23181 AC |
29 | |
30 | fun getWebbw last = | |
31 | let | |
32 | val fname = | |
33 | case last of | |
34 | 2 => webbw_last2 | |
35 | | 1 => webbw_last | |
36 | | 0 => webbw | |
37 | | _ => raise Fail "Asked for too old of a bandwidth file" | |
38 | ||
39 | val inf = TextIO.openIn fname | |
40 | ||
41 | val sum = case TextIO.inputLine inf of | |
42 | NONE => raise Fail "Can't read webbw" | |
43 | | SOME l => | |
44 | ||
45 | case String.tokens Char.isSpace l of | |
46 | [_, n] => valOf (Int.fromString n) | |
47 | | _ => raise Fail "Bad total in webbw" | |
48 | ||
49 | fun readEm L = | |
50 | case TextIO.inputLine inf of | |
51 | (NONE | SOME "\n") => List.rev L | |
52 | | SOME l => | |
53 | case String.tokens (fn ch => Char.isSpace ch orelse ch = #":") l of | |
b13a9a37 AC |
54 | [d, n] => |
55 | (case String.tokens (fn ch => ch = #"@") d of | |
56 | [d, node] => readEm ({host = checkSsl (node, d), size = valOf (Int.fromString n)} :: L) | |
57 | | _ => raise Fail ("Bad row in webbw [2]: " ^ l)) | |
58 | | _ => raise Fail ("Bad row in webbw [1]: " ^ l) | |
b6e23181 AC |
59 | |
60 | fun splitLast [] = raise Fail "Not enough items for splitLast" | |
61 | | splitLast [x] = ([], x) | |
62 | | splitLast (h::t) = | |
63 | let | |
64 | val (l, x) = splitLast t | |
65 | in | |
66 | (h::l, x) | |
67 | end | |
68 | ||
69 | fun readGroups L = | |
70 | case TextIO.inputLine inf of | |
71 | NONE => List.rev L | |
72 | | SOME l => | |
73 | case String.tokens (fn ch => Char.isSpace ch orelse ch = #":" orelse ch = #"[" orelse ch = #"]" orelse ch = #",") l of | |
74 | d :: rest => | |
75 | let | |
76 | val (l, x) = splitLast rest | |
b13a9a37 AC |
77 | |
78 | fun split s = | |
79 | case String.tokens (fn ch => ch = #"@") s of | |
80 | [host, node] => (node, host) | |
81 | | _ => raise Fail ("Bad row in webbw [3]: " ^ s) | |
b6e23181 | 82 | in |
b13a9a37 | 83 | readGroups ({user = d, hosts = map (checkSsl o split) l, size = valOf (Int.fromString x)} :: L) |
b6e23181 | 84 | end |
b13a9a37 | 85 | | _ => raise Fail ("Bad row in webbw [4]: " ^ l) |
b6e23181 AC |
86 | in |
87 | TextIO.inputLine inf; | |
b13a9a37 | 88 | {total = sum, vhosts = readEm [], users = readGroups []} |
b6e23181 AC |
89 | before TextIO.closeIn inf |
90 | end | |
91 | ||
92 | type disk = {uname : string, | |
23bfc877 | 93 | kbs : int} |
b6e23181 AC |
94 | |
95 | fun getDiskUsage () = | |
96 | let | |
23bfc877 | 97 | val proc = Unix.execute ("/bin/sh", ["-c", "/usr/bin/sudo /usr/local/sbin/portal_quotas"]) |
b6e23181 AC |
98 | val inf = Unix.textInstreamOf proc |
99 | ||
23bfc877 AC |
100 | fun ignoreThis s = |
101 | String.isPrefix "Kerberos " s | |
b6e23181 | 102 | |
23bfc877 AC |
103 | fun loop acc = |
104 | case TextIO.inputLine inf of | |
105 | NONE => acc | |
106 | | SOME line => | |
107 | case String.tokens Char.isSpace line of | |
108 | [uname, kbs] => loop ({uname = uname, kbs = valOf (Int.fromString kbs)} :: acc) | |
109 | | _ => | |
110 | if ignoreThis line then | |
111 | loop acc | |
112 | else | |
113 | raise Fail ("Bad quotas output: " ^ line) | |
b6e23181 | 114 | in |
23bfc877 | 115 | loop [] |
b6e23181 AC |
116 | before ignore (Unix.reap proc) |
117 | end | |
118 | ||
119 | end |