domtool-tail

diff --git a/Makefile b/Makefile
index b92bf32..41e920c 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/domtool-tail
 
 smlnj: $(COMMON_DEPS) openssl/smlnj/FFI/libssl.h.cm pcre/smlnj/FFI/libpcre.h.cm \
        src/domtool.cm
@@ -169,9 +169,12 @@ bin/smtplog: $(COMMON_MLTON_DEPS) src/smtplog.mlb
 bin/mysql-fixperms: $(COMMON_MLTON_DEPS) src/mysql-fixperms.mlb
        $(MLTON) -output bin/mysql-fixperms src/mysql-fixperms.mlb
 
-bin/webbw: $(COMMON_MLTON_DEPS) src/stats/webbw.mlb
+bin/webbw: $(COMMON_MLTON_DEPS) src/stats/webbw.mlb src/stats/*.sml
        mlton -output bin/webbw src/stats/webbw.mlb
 
+bin/domtool-tail: $(COMMON_MLTON_DEPS) src/tail/tail.mlb src/tail/*.sml
+       mlton -output bin/domtool-tail src/tail/tail.mlb
+
 elisp/domtool-tables.el: lib/*.dtl bin/domtool-doc
        bin/domtool-doc -basis -emacs >$@
 
@@ -189,6 +192,7 @@ install: install_sos
        cp scripts/domtool-addacl /usr/local/bin/
        cp scripts/domtool-rmuser /usr/local/bin/
        cp scripts/domtool-admin-sudo /usr/local/bin/
+       cp scripts/domtool-admin-sudo-noisy /usr/local/bin/
        cp scripts/domtool-server-logged /usr/local/bin/
        cp scripts/domtool-slave-logged /usr/local/bin/
        cp scripts/domtool-server /etc/init.d/
@@ -205,6 +209,8 @@ install: install_sos
        -cp bin/mysql-fixperms /usr/local/bin/
        -cp bin/vmailpasswd /usr/local/bin/
        -cp bin/webbw /usr/local/sbin/
+       -cp bin/domtool-tail /usr/local/bin/
+       -chmod +s /usr/local/bin/domtool-tail
        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 53d6037..01e502b 100644 (file)
--- a/bin/.cvsignore
+++ b/bin/.cvsignore
@@ -10,4 +10,4 @@ smtplog
 mysql-fixperms
 vmailpasswd
 webbw
-
+domtool-tail

diff --git a/scripts/domtool-admin-sudo b/scripts/domtool-admin-sudo
index 7934c45..13eaf19 100755 (executable)
--- a/scripts/domtool-admin-sudo
+++ b/scripts/domtool-admin-sudo
@@ -1,3 +1,5 @@
+#!/usr/bin/pagsh.openafs
+
 kinit -k -t /etc/keytabs/domtool domtool
 aklog
 domtool-admin $* >/dev/null 2>/dev/null

diff --git a/scripts/domtool-admin-sudo-noisy b/scripts/domtool-admin-sudo-noisy
new file mode 100755 (executable)
index 0000000..6faf512
--- /dev/null
+++ b/scripts/domtool-admin-sudo-noisy
@@ -0,0 +1,5 @@
+#!/usr/bin/pagsh.openafs
+
+kinit -k -t /etc/keytabs/domtool domtool
+aklog
+domtool-admin $*

diff --git a/src/tail/tail.mlb b/src/tail/tail.mlb
new file mode 100644 (file)
index 0000000..a2662f2
--- /dev/null
+++ b/src/tail/tail.mlb
@@ -0,0 +1,3 @@
+$(SML_LIB)/basis/basis.mlb
+
+tail.sml

diff --git a/src/tail/tail.sml b/src/tail/tail.sml
new file mode 100644 (file)
index 0000000..057853c
--- /dev/null
+++ b/src/tail/tail.sml
@@ -0,0 +1,95 @@
+(* HCoop Domtool (http://hcoop.sourceforge.net/)
+ * Copyright (c) 2008, 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., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+ *)
+
+(* Tailing Apache log files (locally) that you are allowed to see *)
+
+fun hostname () =
+    let
+       val inf = TextIO.openIn "/etc/hostname"
+    in
+       case TextIO.inputLine inf of
+           NONE => (TextIO.closeIn inf; raise Fail "No line in /etc/hostname")
+         | SOME line => (TextIO.closeIn inf; String.substring (line, 0, size line - 1))
+    end
+
+fun main args =
+    let
+       val (f, args) = foldl (fn (arg, (f, args)) =>
+                                  case arg of
+                                      "-f" => (true, args)
+                                    | _ => (f, arg :: args))
+                        (false, []) args
+       val args = rev args
+    in
+       case args of
+           [vhost] =>
+           let
+               val uid = Posix.ProcEnv.getuid ()
+               val uname = Posix.SysDB.Passwd.name (Posix.SysDB.getpwuid uid)
+
+               val proc = Unix.execute ("/usr/local/bin/domtool-admin-sudo-noisy", ["perms", uname])
+               val inf = Unix.textInstreamOf proc
+
+               fun allowed () =
+                   case TextIO.inputLine inf of
+                       NONE => []
+                     | SOME line =>
+                       case String.tokens Char.isSpace line of
+                           "domain:" :: domains => domains
+                         | _ => allowed ()
+
+               val domains = allowed ()
+
+               fun inDomains d = List.exists (fn s => s = d) domains
+
+               fun checker pieces =
+                   case pieces of
+                       [] => false
+                     | _ :: pieces =>
+                       inDomains (String.concatWith "." pieces)
+                       orelse checker pieces
+
+               val tailArgs = ["/var/log/apache2/user/"
+                               ^ String.substring (uname, 0, 1)
+                               ^ "/"
+                               ^ String.substring (uname, 0, 2)
+                               ^ "/"
+                               ^ uname
+                               ^ "/apache/log/"
+                               ^ hostname ()
+                               ^ "/"
+                               ^ vhost]
+
+               val tailArgs =
+                   if f then
+                       "-f" :: tailArgs
+                   else
+                       tailArgs
+           in
+               ignore (Unix.reap proc);
+               if inDomains vhost orelse checker (String.fields (fn ch => ch = #".") vhost) then
+                   Posix.Process.exec ("/usr/bin/tail", "/usr/bin/tail" :: tailArgs)
+               else
+                   (print "You're not authorized to view the logs for that vhost.\n";
+                    OS.Process.exit OS.Process.failure)
+           end
+         | _ => (print "Invalid arguments\n";
+                 OS.Process.exit OS.Process.failure)
+    end
+
+val () = main (CommandLine.arguments ())