quotas

diff --git a/Makefile b/Makefile
index 9396f38..f05c0f1 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -15,7 +15,7 @@ config.sml:
 
 mlton: bin/domtool-server bin/domtool-client bin/domtool-slave \
        bin/domtool-admin bin/domtool-doc bin/dbtool bin/vmail \
-       bin/smtplog bin/setsa bin/mysql-fixperms bin/webbw
+       bin/smtplog bin/setsa bin/mysql-fixperms bin/webbw bin/quotas
 
 smlnj: $(COMMON_DEPS) openssl/smlnj/FFI/libssl.h.cm src/domtool.cm
 
@@ -152,6 +152,9 @@ bin/mysql-fixperms: $(COMMON_MLTON_DEPS) src/mysql-fixperms.mlb
 bin/webbw: $(COMMON_MLTON_DEPS) src/stats/webbw.mlb
        mlton -output bin/webbw src/stats/webbw.mlb
 
+bin/quotas: $(COMMON_MLTON_DEPS) src/stats/quotas.mlb
+       mlton -output bin/quotas src/stats/quotas.mlb
+
 elisp/domtool-tables.el: lib/*.dtl bin/domtool-doc
        bin/domtool-doc -basis -emacs >$@
 
@@ -182,6 +185,7 @@ install:
        -cp bin/mysql-fixperms /usr/local/bin/
        -cp bin/vmailpasswd /usr/local/bin/
        -cp bin/webbw /usr/local/sbin/
+       -cp bin/quotas /usr/local/sbin/
        cp src/plugins/domtool-postgres /usr/local/sbin/
        cp src/plugins/domtool-mysql /usr/local/sbin/
        -mkdir -p $(EMACS_DIR)

diff --git a/bin/.cvsignore b/bin/.cvsignore
index e350300..b988798 100644 (file)
--- a/bin/.cvsignore
+++ b/bin/.cvsignore
@@ -10,3 +10,4 @@ smtplog
 mysql-fixperms
 vmailpasswd
 webbw
+quotas

diff --git a/src/stats/quotas-main.sml b/src/stats/quotas-main.sml
new file mode 100644 (file)
index 0000000..b12dd56
--- /dev/null
+++ b/src/stats/quotas-main.sml
@@ -0,0 +1 @@
+val () = Quotas.getDiskUsage ()

diff --git a/src/stats/quotas.mlb b/src/stats/quotas.mlb
new file mode 100644 (file)
index 0000000..7ad43ac
--- /dev/null
+++ b/src/stats/quotas.mlb
@@ -0,0 +1,5 @@
+$(SML_LIB)/basis/basis.mlb
+$(SML_LIB)/smlnj-lib/Util/smlnj-lib.mlb
+
+quotas.sml
+quotas-main.sml

diff --git a/src/stats/quotas.sml b/src/stats/quotas.sml
new file mode 100644 (file)
index 0000000..217d121
--- /dev/null
+++ b/src/stats/quotas.sml
@@ -0,0 +1,86 @@
+(*
+Domtool 2 (http://hcoop.sf.net/)
+Copyright (C) 2007  Adam Chlipala
+
+This program is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public License
+as published by the Free Software Foundation; either version 2
+of the License, or (at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+*)
+
+structure Quotas = struct
+
+    fun homedir s = Posix.SysDB.Passwd.home (Posix.SysDB.getpwnam s)
+    fun userVols s = [homedir s]
+
+    fun used path =
+       let
+           val proc = Unix.execute ("/bin/sh", ["-c", "/usr/bin/fs listquota -path " ^ path])
+           val inf = Unix.textInstreamOf proc
+       in
+           (case TextIO.inputLine inf of
+                NONE => NONE
+              | SOME line =>
+                if String.isPrefix "fs: " line then
+                    NONE
+                else
+                    case TextIO.inputLine inf of
+                        NONE => NONE
+                      | SOME line =>
+                        case String.tokens Char.isSpace line of
+                            _ :: _ :: n :: _ => Int.fromString n
+                          | _ => NONE)
+           before ignore (Unix.reap proc)
+       end
+
+    fun getDiskUsage () =
+       let
+          fun explorer (level, path, acc) =
+               let
+                   val dir = Posix.FileSys.opendir path
+
+                   fun loop acc =
+                       case Posix.FileSys.readdir dir of
+                           NONE => acc
+                         | SOME file =>
+                           let
+                               val acc =
+                                   if level = 2 then
+                                       file :: acc
+                                   else
+                                       explorer (level+1, OS.Path.joinDirFile {dir = path, file = file}, acc)
+                           in
+                               loop acc
+                           end
+               in
+                   loop acc
+                   before Posix.FileSys.closedir dir
+               end
+
+           val users = explorer (0, "/afs/hcoop.net/user", [])
+
+           fun count uname =
+               foldl (fn (vol, total) => case used vol of
+                                             NONE => total
+                                           | SOME n => total + n) 0 (userVols uname)
+
+           val users = ListMergeSort.sort (fn (s1, s2) => String.compare (s1, s2) = GREATER) users
+           val all = List.map (fn user => {uname = user, kbs = count user}) users
+           val all = ListMergeSort.sort (fn ({kbs = kb1, ...}, {kbs = kb2, ...}) => kb1 > kb2) all
+       in
+           app (fn {uname, kbs} => (print uname;
+                                    print " ";
+                                    print (Int.toString kbs);
+                                    print "\n")) all
+       end
+
+end