Make domtool-tail actually work

[hcoop/domtool2.git] / src / tail / tail.sml

(* 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, kind] =>
	    let
		val () = case kind of
			     "access" => ()
			   | "error" => ()
			   | "rewrite" => ()
			   | _ => (print "Unsupported logfile kind.  Use 'access', 'error', or 'rewrite'.\n";
				   OS.Process.exit OS.Process.failure)

		val uid = Posix.ProcEnv.getuid ()
		val uname = Posix.SysDB.Passwd.name (Posix.SysDB.getpwuid uid)

		val proc = Unix.execute ("/usr/local/bin/domtool-admin", ["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
				^ "/"
				^ kind
				^ ".log"]

		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 ())