payment: note that Stripe has instituted an additional 1% fee for non-US cards

[hcoop/portal.git] / sec.sml

structure Sec :> SEC = struct

open Init Util Sql

structure Req = RequestH(struct
			 val table = "Sec"
			 val adminGroup = "server"
			 fun subject _ = "Security permissions change request"
			 val template = "sec"
			 val descr = "change"
			 fun body {node, mail, data = req} =
			     (Mail.mwrite (mail, req);
			      Mail.mwrite (mail, "\n"))
			 end)

fun findSubusers uname =
    let
	val uname_under = uname ^ "_"
	val inf = TextIO.openIn "/etc/passwd"

	fun loop subs =
	    case TextIO.inputLine inf of
		NONE => ListMergeSort.sort (fn (x, y) => String.compare (x, y) = GREATER) subs
	      | SOME line =>
		case String.fields (fn ch => ch = #":") line of
		    uname'::_ =>
		    if size uname' >= size uname_under
		       andalso String.substring (uname', 0, size uname_under) = uname_under then
			loop (uname' :: subs)
		    else
			loop subs
		  | _ => loop subs
    in
	loop []
	before TextIO.closeIn inf
    end

datatype socket_perms =
	 ANY
       | CLIENT_ONLY
       | SERVER_ONLY
       | NADA

fun socketPerms {node, uname} =
    let
	val proc = Unix.execute ("/bin/sh",
				 ["-c",
				  "DOMTOOL_USER=hcoop.daemon /usr/local/bin/domtool-admin sockperm "
				  ^ Init.nodeName node ^ " " ^ uname])
		   
	val inf = Unix.textInstreamOf proc

	val p = case TextIO.inputLine inf of
		    SOME "Any\n" => ANY
		  | SOME "Client\n" => CLIENT_ONLY
		  | SOME "Server\n" => SERVER_ONLY
		  | _ => NADA
    in
	TextIO.closeIn inf;
	if OS.Process.isSuccess (Unix.reap proc) then
	    p
	else
	    NADA
    end

fun checkIt cmd {node, uname} =
    OS.Process.isSuccess (OS.Process.system
			      ("DOMTOOL_USER=hcoop.daemon /usr/local/bin/domtool-admin "
			       ^ cmd ^ " " ^ Init.nodeName node ^ " " ^ uname ^ " >/dev/null 2>/dev/null"))

val isTpe = checkIt "tpe"
val cronAllowed = checkIt "cron"

fun findFirewallRules {node, uname} =
    let
	val proc = Unix.execute ("/bin/sh",
				 ["-c",
				  "DOMTOOL_USER=hcoop.daemon /usr/local/bin/domtool-admin firewall "
				  ^ Init.nodeName node ^ " " ^ uname])
		   
	val inf = Unix.textInstreamOf proc

	fun readEm lines =
	    case TextIO.inputLine inf of
		    SOME line => readEm (String.substring (line, 0, size line - 1) :: lines)
		  | NONE => rev lines

	val lines = readEm []
    in
	TextIO.closeIn inf;
	if OS.Process.isSuccess (Unix.reap proc) then
	    lines
	else
	    []
    end

fun intFromString s =
    if CharVector.all Char.isDigit s andalso size s > 0 then
	Int.fromString s
    else
	NONE

fun validPort port =
    case intFromString port of
	NONE => false
      | SOME n => n > 0

fun validPortPiece pp =
    case String.fields (fn ch => ch = #":") pp of
	[port] => validPort port
      | [port1, port2] => validPort port1 andalso validPort port2

fun validPorts ports =
    List.all validPortPiece (String.fields (fn ch => ch = #",") ports)

fun validIp s =
    case map intFromString (String.fields (fn ch => ch = #".") s) of
        [SOME n1, SOME n2, SOME n3, SOME n4] =>
        n1 >= 0 andalso n1 < 256 andalso n2 >= 0 andalso n2 < 256 andalso n3 >= 0 andalso n3 < 256 andalso n4 >= 0 andalso n4 < 256
      | _ => false

fun isIdent ch = Char.isLower ch orelse Char.isDigit ch

fun validHost s =
    size s > 0 andalso size s < 20
    andalso CharVector.all (fn ch => isIdent ch orelse ch = #"-") s

fun validDomain s =
    size s > 0 andalso size s < 100
    andalso List.all validHost (String.fields (fn ch => ch = #".") s)

val validHosts = List.all (fn x => validIp x orelse validDomain x)

fun validRule rule =
    case String.tokens Char.isSpace rule of
	"Client" :: ports :: hosts => validPorts ports andalso validHosts hosts
      | "Server" :: ports :: hosts => validPorts ports andalso validHosts hosts
      | ["LocalServer", ports] => validPorts ports
      | ["ProxiedServer", ports] => validPorts ports
      | _ => false

fun fulldomain (sub, dom) = 
    sub ^ (if String.size sub <> 0 then "." else "") ^ dom

end