| 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 host = |
| 12 | case String.fields (fn ch => ch = #".") host of |
| 13 | first::rest => |
| 14 | (case String.fields (fn ch => ch = #"_") first of |
| 15 | [first, "ssl"] => {ssl = true, hostname = String.concatWith "." (first::rest), |
| 16 | id = host} |
| 17 | | _ => {ssl = false, hostname = host, id = host}) |
| 18 | | _ => {ssl = false, hostname = host, id = host} |
| 19 | |
| 20 | fun getWebbw last = |
| 21 | let |
| 22 | val fname = |
| 23 | case last of |
| 24 | 2 => webbw_last2 |
| 25 | | 1 => webbw_last |
| 26 | | 0 => webbw |
| 27 | | _ => raise Fail "Asked for too old of a bandwidth file" |
| 28 | |
| 29 | val inf = TextIO.openIn fname |
| 30 | |
| 31 | val sum = case TextIO.inputLine inf of |
| 32 | NONE => raise Fail "Can't read webbw" |
| 33 | | SOME l => |
| 34 | |
| 35 | case String.tokens Char.isSpace l of |
| 36 | [_, n] => valOf (Int.fromString n) |
| 37 | | _ => raise Fail "Bad total in webbw" |
| 38 | |
| 39 | fun readEm L = |
| 40 | case TextIO.inputLine inf of |
| 41 | (NONE | SOME "\n") => List.rev L |
| 42 | | SOME l => |
| 43 | case String.tokens (fn ch => Char.isSpace ch orelse ch = #":") l of |
| 44 | [d, n] => readEm ((checkSsl d, valOf (Int.fromString n)) :: L) |
| 45 | | _ => raise Fail "Bad row in webbw" |
| 46 | |
| 47 | fun splitLast [] = raise Fail "Not enough items for splitLast" |
| 48 | | splitLast [x] = ([], x) |
| 49 | | splitLast (h::t) = |
| 50 | let |
| 51 | val (l, x) = splitLast t |
| 52 | in |
| 53 | (h::l, x) |
| 54 | end |
| 55 | |
| 56 | fun readGroups L = |
| 57 | case TextIO.inputLine inf of |
| 58 | NONE => List.rev L |
| 59 | | SOME l => |
| 60 | case String.tokens (fn ch => Char.isSpace ch orelse ch = #":" orelse ch = #"[" orelse ch = #"]" orelse ch = #",") l of |
| 61 | d :: rest => |
| 62 | let |
| 63 | val (l, x) = splitLast rest |
| 64 | in |
| 65 | readGroups ((d, map checkSsl l, valOf (Int.fromString x)) :: L) |
| 66 | end |
| 67 | | _ => raise Fail "Bad row in webbw, part 2" |
| 68 | in |
| 69 | TextIO.inputLine inf; |
| 70 | (sum, readEm [], readGroups []) |
| 71 | before TextIO.closeIn inf |
| 72 | end |
| 73 | |
| 74 | type disk = {uname : string, |
| 75 | blocks : int, |
| 76 | files : int} |
| 77 | |
| 78 | fun getDiskUsage () = |
| 79 | let |
| 80 | val proc = Unix.execute ("/usr/bin/sudo", ["/usr/sbin/repquota", "-g", "/home"]) |
| 81 | val inf = Unix.textInstreamOf proc |
| 82 | |
| 83 | fun skipUntilLine () = |
| 84 | case TextIO.inputLine inf of |
| 85 | NONE => raise Fail "No dividing line found in repquota output" |
| 86 | | SOME s => |
| 87 | if String.sub (s, 0) = #"-" then |
| 88 | () |
| 89 | else |
| 90 | skipUntilLine () |
| 91 | |
| 92 | fun readData acc = |
| 93 | let |
| 94 | fun done () = |
| 95 | ListMergeSort.sort (fn (d1, d2) => |
| 96 | #blocks d1 < #blocks d2) acc |
| 97 | in |
| 98 | case TextIO.inputLine inf of |
| 99 | NONE => done () |
| 100 | | SOME s => |
| 101 | case String.tokens Char.isSpace s of |
| 102 | [uname, "--", blocks, bsoft, bhard, files, fsoft, fhard] => |
| 103 | readData ({uname = uname, |
| 104 | blocks = valOf (Int.fromString blocks), |
| 105 | files = valOf (Int.fromString files)} :: acc) |
| 106 | | [uname, "+-", blocks, bsoft, bhard, _, files, fsoft, fhard] => |
| 107 | readData ({uname = uname, |
| 108 | blocks = valOf (Int.fromString blocks), |
| 109 | files = valOf (Int.fromString files)} :: acc) |
| 110 | | [uname, "-+", blocks, bsoft, bhard, files, fsoft, fhard, _] => |
| 111 | readData ({uname = uname, |
| 112 | blocks = valOf (Int.fromString blocks), |
| 113 | files = valOf (Int.fromString files)} :: acc) |
| 114 | | [uname, "++", blocks, bsoft, bhard, _, files, fsoft, fhard, _] => |
| 115 | readData ({uname = uname, |
| 116 | blocks = valOf (Int.fromString blocks), |
| 117 | files = valOf (Int.fromString files)} :: acc) |
| 118 | | [] => done () |
| 119 | | _ => raise Fail ("Bad repquota line: " ^ s) |
| 120 | end |
| 121 | in |
| 122 | skipUntilLine (); |
| 123 | readData [] |
| 124 | before ignore (Unix.reap proc) |
| 125 | end |
| 126 | |
| 127 | end |