-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)
-
-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 inGroup (uname, grp) =
- let
- val uname_under = uname ^ "_"
- val inf = TextIO.openIn "/etc/group"
-
- 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 ()
- 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
- NADA
- else
- SERVER_ONLY
- else if inGroup (uname, "no-serv-sockets") then
- CLIENT_ONLY
- else
- ANY
-
-fun isTpe uname = inGroup (uname, "only-tpe")
-
-fun findFirewallRules uname =
- let
- val inf = TextIO.openIn "/etc/firewall/users.rules"
-
- fun loop rules =
- case TextIO.inputLine inf of
- NONE => List.rev rules
- | SOME line =>
- if String.sub (line, 0) = #"#" then
- loop rules
- else case String.tokens Char.isSpace line of
- uname'::rest =>
- if uname = uname' then
- loop (String.concatWith " " rest :: rules)
- else
- loop rules
- | _ => loop rules
- in
- loop []
- before TextIO.closeIn inf
- end
-
-fun cronAllowed uname =
- let
- val inf = TextIO.openIn "/etc/cron.allow"
- val uname' = uname ^ "\n"
-
- fun loop () =
- case TextIO.inputLine inf of
- NONE => false
- | SOME line => line = uname' orelse loop ()
- in
- loop ()
- before TextIO.closeIn inf
- end
-
-end
+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 /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 /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
+ []
+ 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
+ | _ => false
+
+end
HCoop / hcoop / zz_old / portal.git / blobdiff