domtool-tail
[hcoop/domtool2.git] / src / tail / tail.sml
diff --git a/src/tail/tail.sml b/src/tail/tail.sml
new file mode 100644 (file)
index 0000000..057853c
--- /dev/null
@@ -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 ())