X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fuwobo%2Fuwobo_common.ml;h=8952f8132c11954a5ce54d468d60e4f3cd2fcde3;hb=4167cea65ca58897d1a3dbb81ff95de5074700cc;hp=7664c93b2047e32fc95bd2e219d4dcc892b9aad2;hpb=47b0c2c1b421b62302b1957954912b4c0dfba9fa;p=helm.git diff --git a/helm/uwobo/uwobo_common.ml b/helm/uwobo/uwobo_common.ml index 7664c93b2..8952f8132 100644 --- a/helm/uwobo/uwobo_common.ml +++ b/helm/uwobo/uwobo_common.ml @@ -26,9 +26,12 @@ * 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"; @@ -45,14 +48,20 @@ let supported_properties = [ let is_supported_property name = List.mem name supported_properties +let version = "0.3.0" ;; + let usage_string = sprintf -" + " UWOBO's help message +

UWOBO (version: %s)

+

Information

+ Version: %s +

Usage

Usage: http://hostname:uwoboport/command

@@ -61,51 +70,174 @@ let usage_string =

help
- display this help message + displays this help message +

+

+ newsession?port=p
+ starts a new daemon on a given port p +

+

+ kill
+ kills the daemon. The log file is mantained.

add?bind=key,uri[&bind=key,uri[&...]]
- load a new stylesheet, specified by uri, and bind it to key + loads a new stylesheet, specified by uri, and bind it to key key

- remove[?keys=key1,key2,...]
+ remove?keys=[key1,key2,...]
unload stylesheets specified by key1, key2, ... or all stylesheets if no key was given

- reload[?keys=key1,key2,...]
- reload stylesheets specified by key1, key2, ... or all - stylesheets if no key was given + reload?keys=[key1,key2,...]
+ reloads the stylesheets specified by key1, key2, .... Reloads all + the stylesheets if no key was given

list
- return a list of loaded stylesheets + returns the list of loaded stylesheets

- 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][&...]]]
- apply a chain of stylesheets, specified by key1, key2, ..., to an + 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][&...]]]
+ applies a chain of stylesheets, specified by key1, key2, ..., to an input document, specified by uri.
+ Error and debugging modes could be ste to three different values. + ignore means that LibXSLT messages are ignored; comment + meanst that LibXSLT messages are embedded in the result document inside an + XML like comment; embed 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
Additional parameters can be set for each stylesheet application: global parameters (i.e. parameters passed to all stylesheets) are set using param.name=value syntax, per stylesheet parameters are set using param.key.name=value where key is the key of a loaded stylesheet.
- Properties of the final chain output can be set too: valueless properties + Moreover, it is possible to specify a profile 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 + password for the profile must be provided if the read permission + of the profile is set to false.
+ Properties of the final chain output can be set as well: valueless properties can be set using prop.name syntax, others can be set using prop.name=value syntax.
Current supported properties are: %s.

+

+ listprofiles
+ returns the list of profiles available +

+

+ createprofile?[id=id][&orig=orig][&origpassword=origpassword][&readperm={public|private}][&writeperm={public|private}][&adminperm={public|private}][&password=password]
+ creates a new profile. The id of the created profile is id (if provided); otherwise it is a fresh id. + The parameters are inherited from the profile orig, if provided. origpassword is the password of the + profile being copied in case the read permission of that profile is set to false. The default for + password is no password, the defaults for readper,writeperm,adminperm are public, public, public. +

+

+ removeprofile?id=id[&password=password]
+ removes the profile id. The password is required if the profile administrative permission + is set to false. +

+

+ setparam?id=id[&password=password]&key=key[&value=value]
+ sets the parameter key to value, if value is provided; otherwise + the parameter is unset. The password is required if the profile writing permission is set to + false. +

+

+ setpassword?id=id[&oldpassword=oldpassword][&password=password]
+ changes or unset the password for a profile. The old password is required if it was set. +

+

+ setpermission?id=id[&password=password]&permission={read|write|admin}&value={public|private}
+ changes the permission permission. The password is required if the administrative permission + is set to false. +

+

+ getparams?id=id[&password=password]
+ returns all the parameters of the profile id. The password is required if the read permission + is set to false. +

+

+ getparam?id=id[&password=password]&key=key
+ returns the value of the parameter key of the profile id. The password is required if the read permission + is set to false. +

+

+ getpermission?id=id[&password=password]&for={read|write|admin}
+ returns the value of the permission key of the profile id. The password is required if the administrative + permission is set to false. +

" - (String.concat ", " supported_properties);; + version version + (String.concat ", " supported_properties) (* supported properties *) +;; -let pp_error = sprintf "

Error: %s

";; -let return_error msg outchan = - Http_daemon.respond ~body:(pp_error msg) outchan;; +let pp_error = + sprintf + "Error: %s%s" +;; +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 +;;