From ae9572076483acb16c70fb060e0fc3a158b06ab7 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@hcoop.net>
Date: Sun, 9 Dec 2007 21:20:49 +0000
Subject: [PATCH] quotas

---
 Makefile                  |  6 ++-
 bin/.cvsignore            |  1 +
 src/stats/quotas-main.sml |  1 +
 src/stats/quotas.mlb      |  5 +++
 src/stats/quotas.sml      | 86 +++++++++++++++++++++++++++++++++++++++
 5 files changed, 98 insertions(+), 1 deletion(-)
 create mode 100644 src/stats/quotas-main.sml
 create mode 100644 src/stats/quotas.mlb
 create mode 100644 src/stats/quotas.sml

diff --git a/Makefile b/Makefile
index 9396f38..f05c0f1 100644
--- 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
--- 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
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
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
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
-- 
2.20.1