stats.sml

   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