]> matita.cs.unibo.it Git - helm.git/blob - helm/searchEngine/searchEngine.ml
MathQL query generator: new interface
[helm.git] / helm / searchEngine / searchEngine.ml
1 (* Copyright (C) 2002, HELM Team.
2  * 
3  * This file is part of HELM, an Hypertextual, Electronic
4  * Library of Mathematics, developed at the Computer Science
5  * Department, University of Bologna, Italy.
6  * 
7  * HELM is free software; you can redistribute it and/or
8  * modify it under the terms of the GNU General Public License
9  * as published by the Free Software Foundation; either version 2
10  * of the License, or (at your option) any later version.
11  * 
12  * HELM is distributed in the hope that it will be useful,
13  * but WITHOUT ANY WARRANTY; without even the implied warranty of
14  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15  * GNU General Public License for more details.
16  *
17  * You should have received a copy of the GNU General Public License
18  * along with HELM; if not, write to the Free Software
19  * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
20  * MA  02111-1307, USA.
21  * 
22  * For details, see the HELM World-Wide-Web page,
23  * http://cs.unibo.it/helm/.
24  *)
25
26 open Http_types ;;
27
28 let debug = true;;
29 let debug_print s = if debug then prerr_endline s;;
30 Http_common.debug := true;;
31 (* Http_common.debug := true;; *)
32
33   (** accepted HTTP servers for ask_uwobo method forwarding *)
34 let valid_servers = [ "mowgli.cs.unibo.it:58080" ; "mowgli.cs.unibo.it" ; "localhost:58080" ] ;;
35
36 let mqi_flags = [] (* default MathQL interpreter options *)
37
38 open Printf;;
39
40 let daemon_name = "Search Engine";;
41 let default_port = 58085;;
42 let port_env_var = "SEARCH_ENGINE_PORT";;
43
44 let pages_dir =
45   try
46     Sys.getenv "SEARCH_ENGINE_HTML_DIR"
47   with Not_found -> "html"  (* relative to searchEngine's document root *)
48 ;;
49 let interactive_user_uri_choice_TPL = pages_dir ^ "/templateambigpdq1.html";;
50 let interactive_interpretation_choice_TPL =
51   pages_dir ^ "/templateambigpdq2.html";;
52 let constraints_choice_TPL = pages_dir ^ "/constraints_choice_template.html";;
53 let final_results_TPL = pages_dir ^ "/templateambigpdq3.html";;
54
55 exception Chat_unfinished
56
57   (* build a bool from a 1-character-string *)
58 let bool_of_string' = function
59   | "0" -> false
60   | "1" -> true
61   | s -> failwith ("Can't parse a boolean from string: " ^ s)
62 ;;
63
64   (* build an int option from a string *)
65 let int_of_string' = function
66   | "_" -> None
67   | s ->
68       try
69         Some (int_of_string s)
70       with Failure "int_of_string" ->
71         failwith ("Can't parse an int option from string: " ^ s)
72 ;;
73
74 let is_concl_pos pos =
75   pos = "http://www.cs.unibo.it/helm/schemas/schema-helm#MainConclusion"
76   or
77   pos = "http://www.cs.unibo.it/helm/schemas/schema-helm#InConclusion"
78 ;;
79
80 let is_main_pos pos =
81   pos = "http://www.cs.unibo.it/helm/schemas/schema-helm#MainConclusion"
82   or
83   pos = "http://www.cs.unibo.it/helm/schemas/schema-helm#MainHypothesis"
84 ;;
85
86   (* HTML pretty printers for mquery_generator types *)
87
88 let html_of_r_obj (uri, pos, depth) =
89   sprintf
90     "<tr><td><input type='checkbox' name='constr_obj' checked='on'/></td><td>%s</td><td>%s</td><td>%s</td></tr>"
91     uri (Str.string_after pos ((String.rindex pos '#') + 1))
92     (if is_main_pos pos then
93       sprintf "<input name='obj_depth' size='2' type='text' value='%s' />"
94         (match depth with Some i -> string_of_int i | None -> "")
95     else
96       "<input type=\"hidden\" name=\"obj_depth\" />")
97 ;;
98
99 let html_of_r_rel (pos, depth) =
100   sprintf
101     "<tr><td><input type='checkbox' name='constr_rel' checked='on'/></td><td>%s</td><td><input name='rel_depth' size='2' type='text' value='%s' /></td></tr>"
102     pos (match depth with Some i -> string_of_int i | None -> "")
103 ;;
104
105 let html_of_r_sort (pos, depth, sort) =
106   sprintf
107     "<tr><td><input type='checkbox' name='constr_sort' checked='on'/></td><td>%s</td><td>%s</td><td><input name='sort_depth' size='2' type='text' value='%s'/></td></tr>"
108     sort pos (match depth with Some i -> string_of_int i | None -> "")
109 ;;
110
111   (** pretty print a MathQL query result to an HELM theory file *)
112 let theory_of_result result =
113  let results_no = List.length result in
114   if results_no > 0 then
115    let mode = if results_no > 10 then "linkonly" else "typeonly" in
116    let results =
117     let idx = ref (results_no + 1) in
118      List.fold_right
119       (fun (uri,attrs) i ->
120         decr idx ;
121         "<tr><td valign=\"top\">" ^ string_of_int !idx ^ ".</td><td><ht:OBJECT uri=\"" ^ uri ^ "\" mode=\"" ^ mode ^ "\"/></td></tr>" ^  i
122       ) result ""
123    in
124     "<h1>Query Results:</h1><table xmlns:ht=\"http://www.cs.unibo.it/helm/namespaces/helm-theory\">" ^ results ^ "</table>"
125   else
126     "<h1>Query Results:</h1><p>No results found!</p>"
127 ;;
128
129 let pp_result result =
130  "<html xmlns:ht=\"http://www.cs.unibo.it/helm/namespaces/helm-theory\">\n<head><title>Query Results</title><style> A { text-decoration: none } </style></head>\n<body>" ^ theory_of_result result ^ "</body></html>"
131 ;;
132
133   (** chain application of Pcre substitutions *)
134 let rec apply_substs substs line =
135   match substs with
136   | [] -> line
137   | (rex, templ) :: rest -> apply_substs rest (Pcre.replace ~rex ~templ line)
138   (** fold like function on files *)
139 let fold_file f init fname =
140   let inchan = open_in fname in
141   let rec fold_lines' value =
142     try 
143       let line = input_line inchan in 
144       fold_lines' (f value line)
145     with End_of_file -> value
146   in
147   let res = (try fold_lines' init with e -> (close_in inchan; raise e)) in
148   close_in inchan;
149   res
150   (** iter like function on files *)
151 let iter_file f = fold_file (fun _ line -> f line) ()
152
153 let (title_tag_RE, choices_tag_RE, msg_tag_RE, id_to_uris_RE, id_RE,
154     interpretations_RE, interpretations_labels_RE, results_RE, new_aliases_RE,
155     form_RE, variables_initialization_RE)
156   =
157   (Pcre.regexp "@TITLE@", Pcre.regexp "@CHOICES@", Pcre.regexp "@MSG@",
158   Pcre.regexp "@ID_TO_URIS@", Pcre.regexp "@ID@",
159   Pcre.regexp "@INTERPRETATIONS@", Pcre.regexp "@INTERPRETATIONS_LABELS@",
160   Pcre.regexp "@RESULTS@", Pcre.regexp "@NEW_ALIASES@", Pcre.regexp "@FORM@",
161   Pcre.regexp "@VARIABLES_INITIALIZATION@")
162 let server_and_port_url_RE = Pcre.regexp "^http://([^/]+)/.*$"
163
164 exception NotAnInductiveDefinition
165
166 let port =
167   try
168     int_of_string (Sys.getenv port_env_var)
169   with
170   | Not_found -> default_port
171   | Failure "int_of_string" ->
172       prerr_endline "Warning: invalid port, reverting to default";
173       default_port
174 in
175 let pp_error = sprintf "<html><body><h1>Error: %s</h1></body></html>" in
176 let bad_request body outchan =
177   Http_daemon.respond_error ~status:(`Client_error `Bad_request) ~body outchan
178 in
179 let contype = "Content-Type", "text/html" in
180
181 (* SEARCH ENGINE functions *)
182
183 let refine_constraints (constr_obj, constr_rel, constr_sort) =
184  function
185     "/searchPattern" ->
186       (constr_obj, constr_rel, constr_sort),
187        (Some constr_obj, Some constr_rel, Some constr_sort)
188   | "/matchConclusion" ->
189       let constr_obj' =
190        List.map
191         (function (uri,pos,_) -> (uri,pos,None))
192         (List.filter
193           (function (uri,pos,depth) as constr -> is_concl_pos pos)
194           constr_obj)
195       in
196        (*CSC: we must select the must constraints here!!! *)
197        (constr_obj',[],[]),(Some constr_obj', None, None)
198   | _ -> assert false
199 in
200
201 let get_constraints term =
202  function
203     "/locateInductivePrinciple" ->
204       let uri = 
205        match term with
206           Cic.MutInd (uri,t,_) -> MQueryUtil.string_of_uriref (uri,[t])
207         | _ -> raise NotAnInductiveDefinition
208       in
209       let constr_obj =
210        [uri,"http://www.cs.unibo.it/helm/schemas/schema-helm#InHypothesis",
211          None ;
212         uri,"http://www.cs.unibo.it/helm/schemas/schema-helm#MainHypothesis",
213          Some 0
214        ]
215       in
216       let constr_rel =
217        ["http://www.cs.unibo.it/helm/schemas/schema-helm#MainConclusion",
218         None] in
219       let constr_sort =
220        ["http://www.cs.unibo.it/helm/schemas/schema-helm#MainHypothesis",
221         Some 1, "http://www.cs.unibo.it/helm/schemas/schema-helm#Prop"]
222       in
223        (constr_obj, constr_rel, constr_sort), (None,None,None)
224   | req_path ->
225      let must = MQueryLevels2.get_constraints term in
226       refine_constraints must req_path
227 in
228
229 (*
230   format:
231     <must_obj> ':' <must_rel> ':' <must_sort> ':' <only_obj> ':' <only_rel> ':' <only_sort>
232
233     <must_*> ::= ('0'|'1') ('_'|<int>) (',' ('0'|'1') ('_'|<int>))*
234     <only> ::= '0'|'1'
235 *)
236 let add_user_constraints ~constraints
237  ((obj, rel, sort), (only_obj, only_rel, only_sort))
238 =
239   let parse_must s =
240     let l = Pcre.split ~pat:"," s in
241     (try
242       List.map
243         (fun s ->
244           let subs = Pcre.extract ~pat:"^(.)(\\d+|_)$" s in
245           (bool_of_string' subs.(1), int_of_string' subs.(2)))
246         l
247      with
248       Not_found -> failwith ("Can't parse constraint string: " ^ constraints)
249     )
250   in
251     (* to be used on "obj" *)
252   let add_user_must33 user_must must =
253     List.map2
254       (fun (b, i) (p1, p2, p3) -> if b then (p1, p2, i) else (p1, p2, None))
255       user_must must
256   in
257     (* to be used on "rel" *)
258   let add_user_must22 user_must must =
259     List.map2
260       (fun (b, i) (p1, p2) -> if b then (p1, i) else (p1, None))
261       user_must must
262   in
263     (* to be used on "sort" *)
264   let add_user_must32 user_must must =
265     List.map2
266       (fun (b, i) (p1, p2, p3) -> if b then (p1, i, p3) else (p1, None, p3))
267       user_must must
268   in
269   match Pcre.split ~pat:":" constraints with
270   | [user_obj;user_rel;user_sort;user_only_obj;user_only_rel;user_only_sort] ->
271       let
272        (user_obj,user_rel,user_sort,user_only_obj,user_only_rel,user_only_sort)
273       =
274         (parse_must user_obj,
275         parse_must user_rel,
276         parse_must user_sort,
277         bool_of_string' user_only_obj,
278         bool_of_string' user_only_rel,
279         bool_of_string' user_only_sort)
280       in
281       let only' =
282        (if user_only_obj  then only_obj else None),
283        (if user_only_rel  then only_rel else None),
284        (if user_only_sort then only_sort else None)
285       in
286       let must' =
287         add_user_must33 user_obj obj,
288         add_user_must22 user_rel rel,
289         add_user_must32 user_sort sort
290       in
291       (must', only')
292   | _ -> failwith ("Can't parse constraint string: " ^ constraints)
293 in
294
295 (* HTTP DAEMON CALLBACK *)
296
297 let callback (req: Http_types.request) outchan =
298   try
299     debug_print (sprintf "Received request: %s" req#path);
300     (match req#path with
301     | "/execute" ->
302         let mqi_handle = MQIConn.init mqi_flags debug_print in 
303         let query_string = req#param "query" in
304         let lexbuf = Lexing.from_string query_string in
305         let query = MQueryUtil.query_of_text lexbuf in
306         let result = MQueryInterpreter.execute mqi_handle query in
307         let result_string = pp_result result in
308               MQIConn.close mqi_handle;
309         Http_daemon.respond ~body:result_string ~headers:[contype] outchan
310     | "/locate" ->
311         let mqi_handle = MQIConn.init mqi_flags debug_print in
312         let id = req#param "id" in
313         let query = MQueryGenerator.locate id in
314         let result = MQueryInterpreter.execute mqi_handle query in
315               MQIConn.close mqi_handle;
316         Http_daemon.respond ~headers:[contype] ~body:(pp_result result) outchan
317     | "/getpage" ->
318         (* TODO implement "is_permitted" *)
319         (let is_permitted _ = true in
320         let remove_fragment uri = Pcre.replace ~pat:"#.*" uri in
321         let page = remove_fragment (req#param "url") in
322         let preprocess =
323           (try
324             bool_of_string (req#param "preprocess")
325           with Invalid_argument _ | Http_types.Param_not_found _ -> false)
326         in
327         (match page with
328         | page when is_permitted page ->
329             (let fname = sprintf "%s/%s" pages_dir (remove_fragment page) in
330             Http_daemon.send_basic_headers ~code:200 outchan;
331             Http_daemon.send_header "Content-Type" "text/html" outchan;
332             Http_daemon.send_CRLF outchan;
333             if preprocess then begin
334               iter_file
335                 (fun line ->
336                   output_string outchan
337                     ((apply_substs
338                        (List.map
339                          (function (key,value) ->
340                            let key' =
341                             (Pcre.extract ~pat:"param\\.(.*)" key).(1)
342                            in
343                             Pcre.regexp ("@" ^ key' ^ "@"), value
344                          )
345                          (List.filter
346                            (fun (key,_) as p-> Pcre.pmatch ~pat:"^param\\." key)
347                            req#params)
348                        )
349                        line) ^
350                     "\n"))
351                 fname
352             end else
353               Http_daemon.send_file ~src:(FileSrc fname) outchan)
354         | page -> Http_daemon.respond_forbidden ~url:page outchan))
355     | "/ask_uwobo" ->
356       let url = req#param "url" in
357       let server_and_port =
358         (Pcre.extract ~rex:server_and_port_url_RE url).(1)
359       in
360       if List.mem server_and_port valid_servers then
361         Http_daemon.respond
362           ~headers:["Content-Type", "text/html"]
363           ~body:(Http_client.Convenience.http_get url)
364           outchan
365       else
366         Http_daemon.respond
367           ~body:(pp_error ("Untrusted UWOBO server: " ^ server_and_port))
368           outchan
369     | "/searchPattern"
370     | "/matchConclusion"
371     | "/locateInductivePrinciple" ->
372         let mqi_handle = MQIConn.init mqi_flags debug_print in
373         let term_string = req#param "term" in
374         let lexbuf = Lexing.from_string term_string in
375         let (context, metasenv) = ([], []) in
376         let (dom, mk_metasenv_and_expr) =
377           CicTextualParserContext.main
378             ~context ~metasenv CicTextualLexer.token lexbuf
379         in
380         let id_to_uris_raw = req#param "aliases" in
381         let tokens = Pcre.split ~pat:"\\s" id_to_uris_raw in
382         let rec parse_tokens keys lookup = function (* TODO spostarla fuori *)
383           | [] -> keys, lookup
384           | "alias" :: key :: value :: rest ->
385               let key' = CicTextualParser0.Id key in
386                parse_tokens
387                  (key'::keys)
388                  (fun id ->
389                    if id = key' then
390                      Some
391                       (CicTextualParser0.Uri (MQueryMisc.cic_textual_parser_uri_of_string value))
392                    else lookup id)
393                  rest
394           | _ -> failwith "Can't parse aliases"
395         in
396         let parse_choices choices_raw =
397           let choices = Pcre.split ~pat:";" choices_raw in
398           List.fold_left
399             (fun f x ->
400               match Pcre.split ~pat:"\\s" x with
401               | ""::id::tail
402               | id::tail when id<>"" ->
403                   (fun id' ->
404 prerr_endline ("#### " ^ id ^ " :=");
405 List.iter (fun u -> prerr_endline ("<" ^ Netencoding.Url.decode u ^ ">")) tail;
406                     if id = id' then
407                       Some (List.map (fun u -> Netencoding.Url.decode u) tail)
408                     else
409                       f id')
410               | _ -> failwith "Can't parse choices")
411             (fun _ -> None)
412             choices
413         in
414         let (id_to_uris : Disambiguate.domain_and_interpretation) =
415          parse_tokens [] (fun _ -> None) tokens in
416         let id_to_choices =
417           try
418             let choices_raw = req#param "choices" in
419             parse_choices choices_raw
420           with Http_types.Param_not_found _ -> (fun _ -> None)
421         in
422         let module Chat: Disambiguate.Callbacks =
423           struct
424
425             let get_metasenv () =
426              !CicTextualParser0.metasenv
427
428             let set_metasenv metasenv =
429               CicTextualParser0.metasenv := metasenv
430
431             let output_html = prerr_endline
432
433             let interactive_user_uri_choice
434               ~selection_mode ?ok
435               ?enable_button_for_non_vars ~(title: string) ~(msg: string)
436               ~(id: string) (choices: string list)
437               =
438                 (match id_to_choices id with
439                 | Some choices -> choices
440                 | None ->
441                   let msg = Pcre.replace ~pat:"\'" ~templ:"\\\'" msg in
442                   (match selection_mode with
443                   | `SINGLE -> assert false
444                   | `EXTENDED ->
445                       Http_daemon.send_basic_headers ~code:200 outchan ;
446                       Http_daemon.send_CRLF outchan ;
447                       iter_file
448                         (fun line ->
449                           let formatted_choices =
450                             String.concat ","
451                               (List.map (fun uri -> sprintf "\'%s\'" uri) choices)
452                           in
453                           let processed_line =
454                             apply_substs
455                               [title_tag_RE, title;
456                                choices_tag_RE, formatted_choices;
457                                msg_tag_RE, msg;
458                                id_to_uris_RE, id_to_uris_raw;
459                                id_RE, id]
460                               line
461                           in
462                           output_string outchan (processed_line ^ "\n"))
463                         interactive_user_uri_choice_TPL;
464                       raise Chat_unfinished))
465
466             let interactive_interpretation_choice interpretations =
467               let html_interpretations_labels =
468                 String.concat ", "
469                   (List.map
470                     (fun l ->
471                       "\'" ^
472                       (String.concat "<br />"
473                         (List.map
474                           (fun (id, value) ->
475                             (sprintf "alias %s %s" id value))
476                           l)) ^
477                       "\'")
478                   interpretations)
479               in
480               let html_interpretations =
481                 String.concat ", "
482                   (List.map
483                     (fun l ->
484                       "\'" ^
485                       (String.concat " "
486                         (List.map
487                           (fun (id, value) ->
488                             (sprintf "alias %s %s"
489                               id
490                               (MQueryMisc.wrong_xpointer_format_from_wrong_xpointer_format'
491                                 value)))
492                           l)) ^
493                       "\'")
494                     interpretations)
495               in
496               Http_daemon.send_basic_headers ~code:200 outchan ;
497               Http_daemon.send_CRLF outchan ;
498               iter_file
499                 (fun line ->
500                   let processed_line =
501                     apply_substs
502                       [interpretations_RE, html_interpretations;
503                        interpretations_labels_RE, html_interpretations_labels]
504                       line
505                   in
506                   output_string outchan (processed_line ^ "\n"))
507                 interactive_interpretation_choice_TPL;
508               raise Chat_unfinished
509
510             let input_or_locate_uri ~title =
511               UriManager.uri_of_string "cic:/Coq/Init/DataTypes/nat_ind.con"
512
513           end
514         in
515         let module Disambiguate' = Disambiguate.Make (Chat) in
516         let (id_to_uris', metasenv', term') =
517           Disambiguate'.disambiguate_input mqi_handle
518             context metasenv dom mk_metasenv_and_expr id_to_uris
519         in
520         (match metasenv' with
521         | [] ->
522             let ((must_obj, must_rel, must_sort) as must'),
523                 ((only_obj, only_rel, only_sort) as only) =
524               get_constraints term' req#path
525             in
526             let must'', only' =
527               (try
528                 add_user_constraints
529                   ~constraints:(req#param "constraints")
530                   (must', only)
531               with Http_types.Param_not_found _ ->
532                 let variables =
533                  "var aliases = '" ^ id_to_uris_raw ^ "';\n" ^
534                  "var constr_obj_len = " ^
535                   string_of_int (List.length must_obj) ^ ";\n" ^
536                  "var constr_rel_len = " ^
537                   string_of_int (List.length must_rel) ^ ";\n" ^
538                  "var constr_sort_len = " ^
539                   string_of_int (List.length must_sort) ^ ";\n" in
540                 let form =
541                   (if must_obj = [] then "" else
542                     "<h4>Obj constraints</h4>" ^
543                     "<table>" ^
544                     (String.concat "\n" (List.map html_of_r_obj must_obj)) ^
545                     "</table>" ^
546                     (* The following three lines to make Javascript create *)
547                     (* the constr_obj[] and obj_depth[] arrays even if we  *)
548                     (* have only one real entry.                           *)
549                     "<input type=\"hidden\" name=\"constr_obj\" />" ^
550                     "<input type=\"hidden\" name=\"obj_depth\" />") ^
551                   (if must_rel = [] then "" else
552                    "<h4>Rel constraints</h4>" ^
553                    "<table>" ^
554                    (String.concat "\n" (List.map html_of_r_rel must_rel)) ^
555                    "</table>" ^
556                     (* The following two lines to make Javascript create *)
557                     (* the constr_rel[] and rel_depth[] arrays even if   *)
558                     (* we have only one real entry.                      *)
559                     "<input type=\"hidden\" name=\"constr_rel\" />" ^
560                     "<input type=\"hidden\" name=\"rel_depth\" />") ^
561                   (if must_sort = [] then "" else
562                     "<h4>Sort constraints</h4>" ^
563                     "<table>" ^
564                     (String.concat "\n" (List.map html_of_r_sort must_sort)) ^
565                     "</table>" ^
566                     (* The following two lines to make Javascript create *)
567                     (* the constr_sort[] and sort_depth[] arrays even if *)
568                     (* we have only one real entry.                      *)
569                     "<input type=\"hidden\" name=\"constr_sort\" />" ^
570                     "<input type=\"hidden\" name=\"sort_depth\" />") ^
571                     "<h4>Only constraints</h4>" ^
572                     "Enforce Only constraints for objects: " ^
573                       "<input type='checkbox' name='only_obj'" ^
574                       (if only_obj = None then "" else " checked='yes'") ^ " /><br />" ^
575                     "Enforce Rel constraints for objects: " ^
576                       "<input type='checkbox' name='only_rel'" ^
577                       (if only_rel = None then "" else " checked='yes'") ^ " /><br />" ^
578                     "Enforce Sort constraints for objects: " ^
579                       "<input type='checkbox' name='only_sort'" ^
580                       (if only_sort = None then "" else " checked='yes'") ^ " /><br />"
581                 in
582                 Http_daemon.send_basic_headers ~code:200 outchan ;
583                 Http_daemon.send_CRLF outchan ;
584                 iter_file
585                   (fun line ->
586                     let processed_line =
587                       apply_substs
588                        [form_RE, form ;
589                         variables_initialization_RE, variables] line
590                     in
591                     output_string outchan (processed_line ^ "\n"))
592                   constraints_choice_TPL;
593                   raise Chat_unfinished)
594             in
595             let query = MQueryGenerator.searchPattern must'' only' in
596             let results = MQueryInterpreter.execute mqi_handle query in 
597             Http_daemon.send_basic_headers ~code:200 outchan ;
598             Http_daemon.send_CRLF outchan ;
599             iter_file
600               (fun line ->
601                 let new_aliases =
602                   match id_to_uris' with
603                   | (domain, f) ->
604                       String.concat ", "
605                         (List.map
606                           (fun name ->
607                             sprintf "\'alias %s cic:%s\'"
608                               (match name with
609                                   CicTextualParser0.Id name -> name
610                                 | _ -> assert false (*CSC: completare *))
611                               (match f name with
612                               | None -> assert false
613                               | Some (CicTextualParser0.Uri t) ->
614                                   MQueryMisc.string_of_cic_textual_parser_uri
615                                     t
616                               | _ -> assert false (*CSC: completare *)))
617                           domain)
618                 in
619                 let processed_line =
620                   apply_substs
621                     [results_RE, theory_of_result results ;
622                      new_aliases_RE, new_aliases]
623                     line
624                 in
625                 output_string outchan (processed_line ^ "\n"))
626               final_results_TPL
627         | _ -> (* unable to instantiate some implicit variable *)
628             Http_daemon.respond
629               ~headers:[contype]
630               ~body:"some implicit variables are still unistantiated :-("
631               outchan);
632             MQIConn.close mqi_handle
633     | invalid_request ->
634         Http_daemon.respond_error ~status:(`Client_error `Bad_request) outchan);
635     debug_print (sprintf "%s done!" req#path)
636   with
637   | Chat_unfinished -> prerr_endline "Chat unfinished, Try again!"
638   | Http_types.Param_not_found attr_name ->
639       bad_request (sprintf "Parameter '%s' is missing" attr_name) outchan
640   | exc ->
641       Http_daemon.respond
642         ~body:(pp_error ("Uncaught exception: " ^ (Printexc.to_string exc)))
643         outchan
644 in
645 printf "%s started and listening on port %d\n" daemon_name port;
646 printf "Current directory is %s\n" (Sys.getcwd ());
647 printf "HTML directory is %s\n" pages_dir;
648 flush stdout;
649 Unix.putenv "http_proxy" "";
650 Http_daemon.start' ~port callback;
651 printf "%s is terminating, bye!\n" daemon_name
652