matita/matita/contribs/lambdadelta/bin/roles/webLWS.ml

   1 (*
   2     ||M||  This file is part of HELM, an Hypertextual, Electronic
   3     ||A||  Library of Mathematics, developed at the Computer Science
   4     ||T||  Department, University of Bologna, Italy.
   5     ||I||
   6     ||T||  HELM is free software; you can redistribute it and/or
   7     ||A||  modify it under the terms of the GNU General Public License
   8     \   /  version 2 or (at your option) any later version.
   9      \ /   This software is distributed as is, NO WARRANTY.
  10       V_______________________________________________________________ *)
  11
  12 module KL = List
  13 module KP = Printf
  14 module KR = Random
  15 module KT = String
  16
  17 type request = (string * string) list * string
  18
  19 (* internals *)
  20
  21 let opt_map = function
  22   | opt, ""  -> opt
  23   | opt, arg -> KP.sprintf "%s=%s" opt arg
  24
  25 let get_random () =
  26   KP.sprintf "%08X" (KR.bits ())
  27
  28 (* interface *)
  29
  30 let open_out enc len =
  31   KP.printf "%s %u\n" enc len
  32
  33 let close_out () =
  34   KP.printf "\x04"
  35
  36 let loop_in context handler eot st =
  37   let read () = KT.trim (read_line ()) in
  38   let rec aux st =
  39     let opt = read () in
  40     let arg = read () in
  41     match opt with
  42       | "control-stop"    -> st
  43       | "control-random"  -> aux st
  44       | "control-context" -> aux (context st)
  45       | "control-eot"     -> aux (eot st)
  46       | _                 ->
  47         let st = handler opt arg st in
  48         aux st
  49   in
  50   aux st
  51
  52 let string_of_request cx (opts, fi) =
  53   let str =
  54     if opts = [] then "" else
  55     let opts = ("control-random", get_random ()) :: opts in
  56     let str = KT.concat "&amp;" (KL.map opt_map opts) in
  57     KP.sprintf "/%s?%s" cx str
  58   in
  59   KP.sprintf "%s#%s" str fi
  60
  61 let control_input form =
  62   KP.printf "<input form=\"%s\" type=\"hidden\" name=\"%s\" value=\"%s\"/>"
  63     form "control-random" (get_random ())
  64
  65 let open_out_html author description title css icon =
  66   open_out "application/xhtml+xml" 0;
  67   KP.printf "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
  68   KP.printf "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">\n";
  69   KP.printf "<html xmlns=\"http://www.w3.org/1999/xhtml\" dir=\"ltr\" lang=\"en-us\">\n";
  70   KP.printf "<head>\n";
  71   KP.printf "  <meta http-equiv=\"Pragma\" content=\"no-cache\"/>\n";
  72   KP.printf "  <meta http-equiv=\"Expires\" content=\"-1\"/>\n";
  73   KP.printf "  <meta http-equiv=\"CACHE-CONTROL\" content=\"NO-CACHE\"/>\n";
  74   KP.printf "  <meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\"/>\n";
  75   KP.printf "  <meta http-equiv=\"Content-Language\" content=\"en-us\"/>\n";
  76   KP.printf "  <meta http-equiv=\"Content-Style-Type\" content=\"text/css\"/>\n";
  77   KP.printf "  <meta name=\"author\" content=\"%s\"/>\n" author;
  78   KP.printf "  <meta name=\"description\" content=\"%s\"/>\n" description;
  79   KP.printf "  <title>%s</title>" title;
  80   KP.printf "  <link rel=\"stylesheet\" type=\"text/css\" href=\"%s\"/>\n" css;
  81   KP.printf "  <link rel=\"shortcut icon\" href=\"%s\"/>\n" icon;
  82   KP.printf "</head>\n";
  83   KP.printf "<body lang=\"en-US\">\n"
  84
  85 let close_out_html () =
  86   KP.printf "</body>\n";
  87   KP.printf "</html>\n";
  88   close_out ()