* http://helm.cs.unibo.it/
*)
-open Printf;;
+open Printf ;;
-exception Uwobo_failure of string;;
+exception Uwobo_failure of string ;;
+
+let uwobo_namespace = "http://helm.cs.unibo.it/uwobo" ;;
+let xsl_namespace = "http://helm.cs.unibo.it/uwobo" ;;
let supported_properties = [
"cdata-section-elements";
let is_supported_property name = List.mem name supported_properties
+let version = "0.3.0" ;;
+
let usage_string =
sprintf
-"
+ "
<html>
<head>
<title>UWOBO's help message</title>
</head>
<body>
+ <h1>UWOBO (version: %s)</h1>
+ <h2>Information</h2>
+ Version: %s
+ <h2>Usage</h2>
<p>
Usage: <kbd>http://hostname:uwoboport/</kbd><em>command</em>
</p>
</p>
<p>
<b><kbd>help</kbd></b><br />
- display this help message
+ displays this help message
+ </p>
+ <p>
+ <b><kbd>newsession?port=p</kbd></b><br />
+ starts a new daemon on a given port <em>p</em>
+ </p>
+ <p>
+ <b><kbd>kill</kbd></b><br />
+ kills the daemon. The log file is mantained.
</p>
<p>
<b><kbd>add?bind=key,uri[&bind=key,uri[&...]]</kbd></b><br />
- load a new stylesheet, specified by <em>uri</em>, and bind it to key
+ loads a new stylesheet, specified by <em>uri</em>, and bind it to key
<em>key</em>
</p>
<p>
- <b><kbd>remove[?keys=key1,key2,...]</kbd></b><br />
+ <b><kbd>remove?keys=[key1,key2,...]</kbd></b><br />
unload stylesheets specified by <em>key1, key2, ...</em> or all
stylesheets if no key was given
</p>
<p>
- <b><kbd>reload[?keys=key1,key2,...]</kbd></b><br />
- reload stylesheets specified by <em>key1, key2, ...</em> or all
- stylesheets if no key was given
+ <b><kbd>reload?keys=[key1,key2,...]</kbd></b><br />
+ reloads the stylesheets specified by <em>key1, key2, ...</em>. Reloads all
+ the stylesheets if no key was given
</p>
<p>
<b><kbd>list</kbd></b><br />
- return a list of loaded stylesheets
+ returns the list of loaded stylesheets
</p>
<p>
- <b><kbd>apply?xmluri=uri&keys=key1,key2,...[¶m.name=value[¶m.name=value[&...]]][¶m.key.name=value[¶m.key.name=value[&...]]][&prop.name[=value][&prop.name[=value][&...]]]</kbd></b><br />
- apply a chain of stylesheets, specified by <em>key1, key2, ...</em>, to an
+ <b><kbd>apply?xmluri=uri&keys=key1,key2,...[&errormode={ignore|comment|embed}][&debugmode={ignore|comment|embed}][&profile=id][&password=password][¶m.name=value[¶m.name=value[&...]]][¶m.key.name=value[¶m.key.name=value[&...]]][&prop.name[=value][&prop.name[=value][&...]]]</kbd></b><br />
+ applies a chain of stylesheets, specified by <em>key1, key2, ...</em>, to an
input document, specified by <em>uri</em>.<br />
+ Error and debugging modes could be ste to three different values.
+ <em>ignore</em> means that LibXSLT messages are ignored; <em>comment</em>
+ meanst that LibXSLT messages are embedded in the result document inside an
+ XML like comment; <em>embed</em> means that LibXSLT messages are embedded
+ at the beginning of the result document (as childs of the root node) in
+ XML elements in the UWOBO namespace<br />
Additional parameters can be set for each stylesheet application: global
parameters (i.e. parameters passed to all stylesheets) are set using
<em>param.name=value</em> syntax, per stylesheet parameters are set using
<em>param.key.name=value</em> where <em>key</em> is the key of a loaded
stylesheet.<br />
- Properties of the final chain output can be set too: valueless properties
+ Moreover, it is possible to specify a <em>profile</em> that is searched for
+ additional global and local parameters. The parameters stored in the profile
+ have lower precedence with respect to those provided in the URL. A
+ <em>password</em> for the profile must be provided if the read permission
+ of the profile is set to false.<br />
+ Properties of the final chain output can be set as well: valueless properties
can be set using <em>prop.name</em> syntax, others can be set using
<em>prop.name=value</em> syntax.<br />
Current supported properties are: %s.
</p>
+ <p>
+ <b><kbd>listprofiles</kbd></b><br />
+ returns the list of profiles available
+ </p>
+ <p>
+ <b><kbd>createprofile?[id=id][&orig=orig][&origpassword=origpassword][&readperm={public|private}][&writeperm={public|private}][&adminperm={public|private}][&password=password]</kbd></b><br />
+ creates a new profile. The id of the created profile is <em>id</em> (if provided); otherwise it is a fresh id.
+ The parameters are inherited from the profile <em>orig</em>, if provided. <em>origpassword</em> is the password of the
+ profile being copied in case the read permission of that profile is set to false. The default for
+ <em>password</em> is no password, the defaults for <em>readper,writeperm,adminperm</em> are public, public, public.
+ </p>
+ <p>
+ <b><kbd>removeprofile?id=id[&password=password]</kbd></b><br />
+ removes the profile <em>id</em>. The password is required if the profile administrative permission
+ is set to false.
+ </p>
+ <p>
+ <b><kbd>setparam?id=id[&password=password]&key=key[&value=value]</kbd></b><br />
+ sets the parameter <em>key</em> to <em>value</em>, if <em>value</em> is provided; otherwise
+ the parameter is unset. The password is required if the profile writing permission is set to
+ false.
+ </p>
+ <p>
+ <b><kbd>setpassword?id=id[&oldpassword=oldpassword][&password=password]</kbd></b><br />
+ changes or unset the password for a profile. The old password is required if it was set.
+ </p>
+ <p>
+ <b><kbd>setpermission?id=id[&password=password]&permission={read|write|admin}&value={public|private}</kbd></b><br />
+ changes the permission <em>permission</em>. The password is required if the administrative permission
+ is set to false.
+ </p>
+ <p>
+ <b><kbd>getparams?id=id[&password=password]</kbd></b><br />
+ returns all the parameters of the profile <em>id</em>. The password is required if the read permission
+ is set to false.
+ </p>
+ <p>
+ <b><kbd>getparam?id=id[&password=password]&key=key</kbd></b><br />
+ returns the value of the parameter <em>key</em> of the profile <em>id</em>. The password is required if the read permission
+ is set to false.
+ </p>
+ <p>
+ <b><kbd>getpermission?id=id[&password=password]&for={read|write|admin}</kbd></b><br />
+ returns the value of the permission <em>key</em> of the profile <em>id</em>. The password is required if the administrative
+ permission is set to false.
+ </p>
</body>
</html>
"
- (String.concat ", " supported_properties);;
+ version version
+ (String.concat ", " supported_properties) (* supported properties *)
+;;
-let pp_error = sprintf "<html><body><h1>Error: %s</h1></body></html>";;
-let return_error msg outchan =
- Http_daemon.respond ~body:(pp_error msg) outchan;;
+let pp_error =
+ sprintf
+ "<html><body><span style=\"color:red\">Error: %s</span>%s</body></html>"
+;;
+let return_error msg ?(body = "") outchan =
+ Http_daemon.respond ~body:(pp_error msg body) outchan;;
let bad_request body outchan =
- Http_daemon.respond_error ~code:400 ~body outchan
+ Http_daemon.respond_error ~code:(`Code 400) ~body outchan
+;;
+
+ (** {2 LibXSLT logging} *)
+
+type xslt_msg =
+ | LibXsltErrorMsg of string
+ | LibXsltDebugMsg of string
+;;
+
+let string_of_xslt_msg = function
+ | LibXsltErrorMsg msg -> "LibXSLT ERROR: " ^ msg
+ | LibXsltDebugMsg msg -> "LibXSLT DEBUG: " ^ msg
+;;
+
+type xslt_msg_mode =
+ | LibXsltMsgIgnore
+ | LibXsltMsgComment
+ | LibXsltMsgEmbed
;;
+class libXsltLogger =
+ let is_libxslt_error = function LibXsltErrorMsg _ -> true | _ -> false in
+ let is_libxslt_debug = function LibXsltDebugMsg _ -> true | _ -> false in
+ let flatten_libxslt_msg = function
+ | LibXsltErrorMsg msg -> msg
+ | LibXsltDebugMsg msg -> msg
+ in
+ object (self)
+
+ initializer
+ Gdome_xslt.setErrorCallback
+ (Some (fun msg -> self#appendMsg (LibXsltErrorMsg msg)));
+ Gdome_xslt.setDebugCallback
+ (Some (fun msg -> self#appendMsg (LibXsltDebugMsg msg)))
+
+ val mutable libXsltMsgs = [] (** libxslt's error and debugging messages *)
+
+ (* libxslt's error and debugging messages handling *)
+
+ method private appendMsg msg = libXsltMsgs <- msg :: libXsltMsgs
+
+ method clearMsgs = libXsltMsgs <- []
+ method clearErrorMsgs =
+ libXsltMsgs <- List.filter is_libxslt_debug libXsltMsgs
+ method clearDebugMsgs =
+ libXsltMsgs <- List.filter is_libxslt_error libXsltMsgs
+
+ method msgs = libXsltMsgs
+ method errorMsgs =
+ List.map flatten_libxslt_msg (List.filter is_libxslt_error libXsltMsgs)
+ method debugMsgs =
+ List.map flatten_libxslt_msg (List.filter is_libxslt_debug libXsltMsgs)
+
+ end
+;;
projects / helm.git / blobdiff