X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/8a7c40fa29ff18a437fcf4ee3f248a7aeb41c19c..559e89e9adf62c5faeb0e78e6b9fb8fe107b8c72:/src/domain.sml diff --git a/src/domain.sml b/src/domain.sml index aa392bc..27bc806 100644 --- a/src/domain.sml +++ b/src/domain.sml @@ -71,6 +71,29 @@ fun yourPath path = orelse ch = #"-" orelse ch = #"_") path andalso SS.exists (fn s' => path = s' orelse String.isPrefix (s' ^ "/") path) (your_paths ()) +fun yourDomainHost s = + yourDomain s + orelse let + val (pref, suf) = Substring.splitl (fn ch => ch <> #".") (Substring.full s) + in + Substring.size suf > 0 + andalso validHost (Substring.string pref) + andalso yourDomain (Substring.string + (Substring.slice (suf, 1, NONE))) + end + +fun validUser s = size s > 0 andalso size s < 20 + andalso CharVector.all Char.isAlphaNum s + +val validGroup = validUser + +val _ = Env.type_one "no_spaces" + Env.string + (CharVector.all (fn ch => not (Char.isSpace ch))) +val _ = Env.type_one "no_newlines" + Env.string + (CharVector.all (fn ch => ch <> #"\n" andalso ch <> #"\r")) + val _ = Env.type_one "ip" Env.string validIp @@ -87,6 +110,18 @@ val _ = Env.type_one "your_domain" Env.string yourDomain +val _ = Env.type_one "your_domain_host" + Env.string + yourDomainHost + +val _ = Env.type_one "user" + Env.string + validUser + +val _ = Env.type_one "group" + Env.string + validGroup + val _ = Env.type_one "your_user" Env.string yourUser @@ -187,6 +222,7 @@ val dnsKind = fn (EApp ((EApp ((EApp master = mstr, slaves = slaves}) | _ => NONE) + | (EVar "noDns", _) => SOME NoDns | _ => NONE val befores = ref (fn (_ : string) => ()) @@ -511,9 +547,9 @@ val () = Env.registerPost (fn () => if !ErrorMsg.anyErrors then () else - Slave.handleChanges (map #2 diffs)(*; + Slave.handleChanges (map #2 diffs); ignore (Slave.shellF ([Config.rm, " -rf ", Config.tmpDir, ""], - fn cl => "Temp file cleanup failed: " ^ cl))*) + fn cl => "Temp file cleanup failed: " ^ cl)) end)