helm/uwobo/uwobo_common.ml

   1 (*
   2  * Copyright (C) 2003:
   3  *    Stefano Zacchiroli <zack@cs.unibo.it>
   4  *    for the HELM Team http://helm.cs.unibo.it/
   5  *
   6  *  This file is part of HELM, an Hypertextual, Electronic
   7  *  Library of Mathematics, developed at the Computer Science
   8  *  Department, University of Bologna, Italy.
   9  *
  10  *  HELM is free software; you can redistribute it and/or
  11  *  modify it under the terms of the GNU General Public License
  12  *  as published by the Free Software Foundation; either version 2
  13  *  of the License, or (at your option) any later version.
  14  *
  15  *  HELM is distributed in the hope that it will be useful,
  16  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
  17  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18  *  GNU General Public License for more details.
  19  *
  20  *  You should have received a copy of the GNU General Public License
  21  *  along with HELM; if not, write to the Free Software
  22  *  Foundation, Inc., 59 Temple Place - Suite 330, Boston,
  23  *  MA  02111-1307, USA.
  24  *
  25  *  For details, see the HELM World-Wide-Web page,
  26  *  http://helm.cs.unibo.it/
  27  *)
  28
  29 open Printf ;;
  30
  31 exception Uwobo_failure of string ;;
  32
  33 let uwobo_namespace = "http://helm.cs.unibo.it/uwobo" ;;
  34 let xsl_namespace = "http://helm.cs.unibo.it/uwobo" ;;
  35
  36 let supported_properties = [
  37   "cdata-section-elements";
  38   "doctype-public";
  39   "doctype-system";
  40   "encoding";
  41   "indent";
  42   "media-type";
  43   "method";
  44   "omit-xml-declaration";
  45   "standalone";
  46   "version"
  47 ]
  48
  49 let is_supported_property name = List.mem name supported_properties
  50
  51 let version = "0.3.0" ;;
  52
  53 let usage_string =
  54   sprintf
  55     "
  56 <html>
  57   <head>
  58     <title>UWOBO's help message</title>
  59   </head>
  60   <body>
  61     <h1>UWOBO (version: %s)</h1>
  62     <h2>Information</h2>
  63     Version: %s
  64     <h2>Usage</h2>
  65     <p>
  66     Usage: <kbd>http://hostname:uwoboport/</kbd><em>command</em>
  67     </p>
  68     <p>
  69     Available commands:
  70     </p>
  71     <p>
  72       <b><kbd>help</kbd></b><br />
  73       displays this help message
  74     </p>
  75     <p>
  76       <b><kbd>newsession?port=p</kbd></b><br />
  77       starts a new daemon on a given port <em>p</em>
  78     </p>
  79     <p>
  80       <b><kbd>kill</kbd></b><br />
  81       kills the daemon. The log file is mantained.
  82     </p>
  83     <p>
  84       <b><kbd>add?bind=key,uri[&bind=key,uri[&...]]</kbd></b><br />
  85       loads a new stylesheet, specified by <em>uri</em>, and bind it to key
  86           <em>key</em>
  87     </p>
  88     <p>
  89       <b><kbd>remove?keys=[key1,key2,...]</kbd></b><br />
  90       unload stylesheets specified by <em>key1, key2, ...</em> or all
  91           stylesheets if no key was given
  92     </p>
  93     <p>
  94       <b><kbd>reload?keys=[key1,key2,...]</kbd></b><br />
  95       reloads the stylesheets specified by <em>key1, key2, ...</em>. Reloads all
  96           the stylesheets if no key was given
  97     </p>
  98     <p>
  99       <b><kbd>list</kbd></b><br />
 100       returns the list of loaded stylesheets
 101     </p>
 102     <p>
 103       <b><kbd>apply?xmluri=uri&keys=key1,key2,...[&errormode={ignore|comment|embed}][&debugmode={ignore|comment|embed}][&profile=id][&password=password][&param.name=value[&param.name=value[&...]]][&param.key.name=value[&param.key.name=value[&...]]][&prop.name[=value][&prop.name[=value][&...]]]</kbd></b><br />
 104       applies a chain of stylesheets, specified by <em>key1, key2, ...</em>, to an
 105       input document, specified by <em>uri</em>.<br />
 106       Error and debugging modes could be ste to three different values.
 107       <em>ignore</em> means that LibXSLT messages are ignored; <em>comment</em>
 108       meanst that LibXSLT messages are embedded in the result document inside an
 109       XML like comment; <em>embed</em> means that LibXSLT messages are embedded
 110       at the beginning of the result document (as childs of the root node) in
 111       XML elements in the UWOBO namespace<br />
 112       Additional parameters can be set for each stylesheet application: global
 113       parameters (i.e. parameters passed to all stylesheets) are set using
 114       <em>param.name=value</em> syntax, per stylesheet parameters are set using
 115       <em>param.key.name=value</em> where <em>key</em> is the key of a loaded
 116       stylesheet.<br />
 117       Moreover, it is possible to specify a <em>profile</em> that is searched for
 118       additional global and local parameters. The parameters stored in the profile
 119       have lower precedence with respect to those provided in the URL. A
 120       <em>password</em> for the profile must be provided if the read permission
 121       of the profile is set to false.<br />
 122       Properties of the final chain output can be set as well: valueless properties
 123       can be set using <em>prop.name</em> syntax, others can be set using
 124       <em>prop.name=value</em> syntax.<br />
 125       Current supported properties are: %s.
 126     </p>
 127     <p>
 128       <b><kbd>listprofiles</kbd></b><br />
 129       returns the list of profiles available
 130     </p>
 131     <p>
 132       <b><kbd>createprofile?[id=id][&orig=orig][&origpassword=origpassword][&readperm={public|private}][&writeperm={public|private}][&adminperm={public|private}][&password=password]</kbd></b><br />
 133       creates a new profile. The id of the created profile is <em>id</em> (if provided); otherwise it is a fresh id.
 134       The parameters are inherited from the profile <em>orig</em>, if provided. <em>origpassword</em> is the password of the
 135       profile being copied in case the read permission of that profile is set to false. The default for
 136       <em>password</em> is no password, the defaults for <em>readper,writeperm,adminperm</em> are public, public, public.
 137     </p>
 138     <p>
 139       <b><kbd>removeprofile?id=id[&password=password]</kbd></b><br />
 140       removes the profile <em>id</em>. The password is required if the profile administrative permission
 141       is set to false.
 142     </p>
 143     <p>
 144       <b><kbd>setparam?id=id[&password=password]&key=key[&value=value]</kbd></b><br />
 145       sets the parameter <em>key</em> to <em>value</em>, if <em>value</em> is provided; otherwise
 146       the parameter is unset. The password is required if the profile writing permission is set to
 147       false.
 148     </p>
 149     <p>
 150       <b><kbd>setpassword?id=id[&oldpassword=oldpassword][&password=password]</kbd></b><br />
 151       changes or unset the password for a profile. The old password is required if it was set.
 152     </p>
 153     <p>
 154       <b><kbd>setpermission?id=id[&password=password]&permission={read|write|admin}&value={public|private}</kbd></b><br />
 155       changes the permission <em>permission</em>. The password is required if the administrative permission
 156       is set to false.
 157     </p>
 158     <p>
 159       <b><kbd>getparams?id=id[&password=password]</kbd></b><br />
 160       returns all the parameters of the profile <em>id</em>. The password is required if the read permission
 161       is set to false.
 162     </p>
 163     <p>
 164       <b><kbd>getparam?id=id[&password=password]&key=key</kbd></b><br />
 165       returns the value of the parameter <em>key</em> of the profile <em>id</em>. The password is required if the read permission
 166       is set to false.
 167     </p>
 168     <p>
 169       <b><kbd>getpermission?id=id[&password=password]&for={read|write|admin}</kbd></b><br />
 170       returns the value of the permission <em>key</em> of the profile <em>id</em>. The password is required if the administrative
 171       permission is set to false.
 172     </p>
 173   </body>
 174 </html>
 175 "
 176     version version
 177     (String.concat ", " supported_properties) (* supported properties *)
 178 ;;
 179
 180 let pp_error =
 181   sprintf
 182     "<html><body><span style=\"color:red\">Error: %s</span>%s</body></html>"
 183 ;;
 184 let return_error msg ?(body = "") outchan =
 185   Http_daemon.respond ~body:(pp_error msg body) outchan;;
 186 let bad_request body outchan =
 187   Http_daemon.respond_error ~code:(`Code 400) ~body outchan
 188 ;;
 189
 190   (** {2 LibXSLT logging} *)
 191
 192 type xslt_msg =
 193   | LibXsltErrorMsg of string
 194   | LibXsltDebugMsg of string
 195 ;;
 196
 197 let string_of_xslt_msg = function
 198   | LibXsltErrorMsg msg -> "LibXSLT ERROR: " ^ msg
 199   | LibXsltDebugMsg msg -> "LibXSLT DEBUG: " ^ msg
 200 ;;
 201
 202 type xslt_msg_mode =
 203   | LibXsltMsgIgnore
 204   | LibXsltMsgComment
 205   | LibXsltMsgEmbed
 206 ;;
 207
 208 class libXsltLogger =
 209   let is_libxslt_error = function LibXsltErrorMsg _ -> true | _ -> false in
 210   let is_libxslt_debug = function LibXsltDebugMsg _ -> true | _ -> false in
 211   let flatten_libxslt_msg = function
 212     | LibXsltErrorMsg msg -> msg
 213     | LibXsltDebugMsg msg -> msg
 214   in
 215   object (self)
 216
 217     initializer
 218       Gdome_xslt.setErrorCallback
 219         (Some (fun msg -> self#appendMsg (LibXsltErrorMsg msg)));
 220       Gdome_xslt.setDebugCallback
 221         (Some (fun msg -> self#appendMsg (LibXsltDebugMsg msg)))
 222
 223     val mutable libXsltMsgs = []  (** libxslt's error and debugging messages *)
 224
 225       (* libxslt's error and debugging messages handling *)
 226
 227     method private appendMsg msg = libXsltMsgs <- msg :: libXsltMsgs
 228
 229     method clearMsgs = libXsltMsgs <- []
 230     method clearErrorMsgs =
 231       libXsltMsgs <- List.filter is_libxslt_debug libXsltMsgs
 232     method clearDebugMsgs =
 233       libXsltMsgs <- List.filter is_libxslt_error libXsltMsgs
 234
 235     method msgs = libXsltMsgs
 236     method errorMsgs =
 237       List.map flatten_libxslt_msg (List.filter is_libxslt_error libXsltMsgs)
 238     method debugMsgs =
 239       List.map flatten_libxslt_msg (List.filter is_libxslt_debug libXsltMsgs)
 240
 241   end
 242 ;;
 243