X-Git-Url: http://git.hcoop.net/hcoop/portal.git/blobdiff_plain/dfb0d0d7748a9bd707705e0a676529a771366180..ff21b0b604e36522aa9d91d90d6e93d792c438cf:/sec.sml

diff --git a/sec.sml b/sec.sml
index 5974bc2..bdbc2c0 100644
--- a/sec.sml
+++ b/sec.sml
@@ -2,16 +2,16 @@ structure Sec :> SEC = struct
 
 open Init Util Sql
 
-structure Req = Request(struct
-			val table = "Sec"
-			val adminGroup = "server"
-			fun subject _ = "Security permissions change request"
-			val template = "sec"
-			val descr = "change"
-			fun body (mail, req) =
-			    (Mail.mwrite (mail, req);
-			     Mail.mwrite (mail, "\n"))
-			end)
+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
@@ -41,40 +41,103 @@ datatype socket_perms =
        | SERVER_ONLY
        | NADA
 
-fun inGroup (uname, grp) =
+fun socketPerms {node, uname} =
     let
-	val uname_under = uname ^ "_"
-	val inf = TextIO.openIn "/etc/group"
+	val proc = Unix.execute ("/bin/sh",
+				 ["-c",
+				  "DOMTOOL_USER=hcoop /usr/local/bin/domtool-admin sockperm "
+				  ^ Init.nodeName node ^ " " ^ uname])
+		   
+	val inf = Unix.textInstreamOf proc
 
-	fun loop () =
-	    case TextIO.inputLine inf of
-		NONE => false
-	      | SOME line =>
-		case String.fields (fn ch => ch = #":") line of
-		    [gname, _, _, members]  =>
-		    if gname = grp then
-			mem (uname, String.fields (fn ch => ch = #",") members)
-		    else
-			loop ()
-		  | _ => loop ()
+	val p = case TextIO.inputLine inf of
+		    SOME "Any\n" => ANY
+		  | SOME "Client\n" => CLIENT_ONLY
+		  | SOME "Server\n" => SERVER_ONLY
+		  | _ => NADA
     in
-	loop ()
-	before TextIO.closeIn inf
-    end    
-
-fun socketPerms uname =
-    if inGroup (uname, "no-sockets") then
-	NADA
-    else if inGroup (uname, "no-cli-sockets") then
-	if inGroup (uname, "no-serv-sockets") then
+	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 /usr/local/bin/domtool-admin "
+			       ^ cmd ^ " " ^ Init.nodeName node ^ " " ^ uname ^ " >/dev/null 2>/dev/null"))
+
+val isTpe = checkIt "tpe"
+val cronAllowed = checkIt "cron"
+val ftpAllowed = checkIt "ftp"
+
+fun findFirewallRules {node, uname} =
+    let
+	val proc = Unix.execute ("/bin/sh",
+				 ["-c",
+				  "DOMTOOL_USER=hcoop /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
-	    SERVER_ONLY
-    else if inGroup (uname, "no-serv-sockets") then
-	CLIENT_ONLY
+	    []
+    end
+
+fun intFromString s =
+    if CharVector.all Char.isDigit s andalso size s > 0 then
+	Int.fromString s
     else
-	ANY
+	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 isTpe uname = inGroup (uname, "only-tpe")
+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
 
 end