| 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 | |
| 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 |
| 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 |
| 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) |
| 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 |
| 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) |
| 82 | in |
| 83 | readGroups ({user = d, hosts = map (checkSsl o split) l, size = valOf (Int.fromString x)} :: L) |
| 84 | end |
| 85 | | _ => raise Fail ("Bad row in webbw [4]: " ^ l) |
| 86 | in |
| 87 | TextIO.inputLine inf; |
| 88 | {total = sum, vhosts = readEm [], users = readGroups []} |
| 89 | before TextIO.closeIn inf |
| 90 | end |
| 91 | |
| 92 | type disk = {uname : string, |
| 93 | blocks : int, |
| 94 | files : int} |
| 95 | |
| 96 | fun getDiskUsage () = |
| 97 | let |
| 98 | val proc = Unix.execute ("/usr/bin/sudo", ["/usr/sbin/repquota", "-g", "/home"]) |
| 99 | val inf = Unix.textInstreamOf proc |
| 100 | |
| 101 | fun skipUntilLine () = |
| 102 | case TextIO.inputLine inf of |
| 103 | NONE => raise Fail "No dividing line found in repquota output" |
| 104 | | SOME s => |
| 105 | if String.sub (s, 0) = #"-" then |
| 106 | () |
| 107 | else |
| 108 | skipUntilLine () |
| 109 | |
| 110 | fun readData acc = |
| 111 | let |
| 112 | fun done () = |
| 113 | ListMergeSort.sort (fn (d1, d2) => |
| 114 | #blocks d1 < #blocks d2) acc |
| 115 | in |
| 116 | case TextIO.inputLine inf of |
| 117 | NONE => done () |
| 118 | | SOME s => |
| 119 | case String.tokens Char.isSpace s of |
| 120 | [uname, "--", blocks, bsoft, bhard, files, fsoft, fhard] => |
| 121 | readData ({uname = uname, |
| 122 | blocks = valOf (Int.fromString blocks), |
| 123 | files = valOf (Int.fromString files)} :: acc) |
| 124 | | [uname, "+-", blocks, bsoft, bhard, _, files, fsoft, fhard] => |
| 125 | readData ({uname = uname, |
| 126 | blocks = valOf (Int.fromString blocks), |
| 127 | files = valOf (Int.fromString files)} :: acc) |
| 128 | | [uname, "-+", blocks, bsoft, bhard, files, fsoft, fhard, _] => |
| 129 | readData ({uname = uname, |
| 130 | blocks = valOf (Int.fromString blocks), |
| 131 | files = valOf (Int.fromString files)} :: acc) |
| 132 | | [uname, "++", blocks, bsoft, bhard, _, files, fsoft, fhard, _] => |
| 133 | readData ({uname = uname, |
| 134 | blocks = valOf (Int.fromString blocks), |
| 135 | files = valOf (Int.fromString files)} :: acc) |
| 136 | | [] => done () |
| 137 | | _ => raise Fail ("Bad repquota line: " ^ s) |
| 138 | end |
| 139 | in |
| 140 | skipUntilLine (); |
| 141 | readData [] |
| 142 | before ignore (Unix.reap proc) |
| 143 | end |
| 144 | |
| 145 | end |