--- /dev/null
+{{Controlling who can access sections of a virtual host}}
+
+extern type authType;
+extern val basic : authType;
+extern val digest : authType;
+extern val authType : authType -> [Location];
+{{See <a href="http://httpd.apache.org/docs/2.0/mod/core.html#authtype">the
+ Apache documentation</a>.}}
+
+extern val authName : no_newlines -> [Location];
+{{See <a href="http://httpd.apache.org/docs/2.0/mod/core.html#authname">the
+ Apache documentation</a>.}}
+
+extern val authUserFile : your_path -> [Location];
+{{See <a href="http://httpd.apache.org/docs/2.0/mod/core.html#authuserfile">the
+ Apache documentation</a>.}}
+
+extern val requireValidUser : [Location];
+extern val requireUser : [user] -> [Location];
+extern val requireGroup : [group] -> [Location];
+{{See <a href="http://httpd.apache.org/docs/2.0/mod/core.html#require">the
+ Apache documentation</a>.}}
+
+extern val orderAllowDeny : [Location];
+extern val orderDenyAllow : [Location];
+{{See <a href="http://httpd.apache.org/docs/2.0/mod/mod_access.html#order">the
+ Apache documentation</a>.}}
+
+extern val allowFromAll : [Location];
+extern val allowFrom : [no_spaces] -> [Location];
+{{See <a href="http://httpd.apache.org/docs/2.0/mod/mod_access.html#allow">the
+ Apache documentation</a>.}}
+
+extern val denyFromAll : [Location];
+extern val denyFrom : [no_spaces] -> [Location];
+{{See <a href="http://httpd.apache.org/docs/2.0/mod/mod_access.html#deny">the
+ Apache documentation</a>.}}
+
+extern val satisfyAll : [Location];
+extern val satisfyAny : [Location];
+{{See <a href="http://httpd.apache.org/docs/2.0/mod/core.html#satisfy">the
+ Apache documentation</a>.}}
extern type node;
{{The name of a server controlled by domtool}}
+extern type user;
+extern type group;
+{{UNIX users and groups}}
+
extern type your_user;
extern type your_group;
{{UNIX users and groups that you're allowed to run as}}
let
val (pref, suf) = Substring.splitl (fn ch => ch <> #".") (Substring.full s)
in
- print ("pref[" ^ Substring.string pref ^ "] suf[" ^ Substring.string suf ^ "]\n");
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)))
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
write host;
write "\n"))
+val authType = fn (EVar "basic", _) => SOME "basic"
+ | (EVar "digest", _) => SOME "digest"
+ | _ => NONE
+
+val () = Env.action_one "authType"
+ ("type", authType)
+ (fn ty =>
+ (write "\tAuthType ";
+ write ty;
+ write "\n"))
+
+val () = Env.action_one "authName"
+ ("name", Env.string)
+ (fn name =>
+ (write "\tAuthName \"";
+ write name;
+ write "\"\n"))
+
+val () = Env.action_one "authUserFile"
+ ("file", Env.string)
+ (fn name =>
+ (write "\tAuthUserFile ";
+ write name;
+ write "\n"))
+
+val () = Env.action_none "requireValidUser"
+ (fn () => write "\tRequire valid-user\n")
+
+val () = Env.action_one "requireUser"
+ ("users", Env.list Env.string)
+ (fn names =>
+ case names of
+ [] => ()
+ | _ => (write "\tRequire user";
+ app (fn name => (write " "; write name)) names;
+ write "\n"))
+
+val () = Env.action_one "requireGroup"
+ ("groups", Env.list Env.string)
+ (fn names =>
+ case names of
+ [] => ()
+ | _ => (write "\tRequire group";
+ app (fn name => (write " "; write name)) names;
+ write "\n"))
+
+val () = Env.action_none "orderAllowDeny"
+ (fn () => write "\tOrder allow,deny\n")
+
+val () = Env.action_none "orderDenyAllow"
+ (fn () => write "\tOrder deny,allow\n")
+
+val () = Env.action_none "allowFromAll"
+ (fn () => write "\tAllow from all\n")
+
+val () = Env.action_one "allowFrom"
+ ("entries", Env.list Env.string)
+ (fn names =>
+ case names of
+ [] => ()
+ | _ => (write "\tAllow from";
+ app (fn name => (write " "; write name)) names;
+ write "\n"))
+
+val () = Env.action_none "denyFromAll"
+ (fn () => write "\tDeny from all\n")
+
+val () = Env.action_one "denyFrom"
+ ("entries", Env.list Env.string)
+ (fn names =>
+ case names of
+ [] => ()
+ | _ => (write "\tDeny from";
+ app (fn name => (write " "; write name)) names;
+ write "\n"))
+
+val () = Env.action_none "satisfyAll"
+ (fn () => write "\tSatisfy all\n")
+
+val () = Env.action_none "satisfyAny"
+ (fn () => write "\tSatisfy any\n")
+
end
alias "/doc/mailman" "/home/adamc/mailman";
directoryIndex ["index.sml", "index.h", "index.v"]
- end
+ end;
+
+ vhost "secret" with
+ location "/" with
+ authType basic;
+ authName "Herman the skunk";
+ authUserFile "/home/adamc/passwds";
+
+ requireValidUser;
+ requireUser ["freddy", "flicky"];
+ requireGroup ["awesome"];
+
+ orderDenyAllow;
+ satisfyAny
+ end
+ end;
end