1 (* Copyright (C) 2002-2004, HELM Team.
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.
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.
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.
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,
22 * For details, see the HELM World-Wide-Web page,
23 * http://cs.unibo.it/helm/.
28 module G = MQueryGenerator
34 let debug_print s = if debug then prerr_endline s
35 let _ = Http_common.debug := true
36 (* let _ = Http_common.debug := false *)
40 let daemon_name = "Search Engine"
43 let len = String.length s in
44 String.sub s 1 (len-1)
46 (* First of all we load the configuration *)
48 let configuration_file = "/projects/helm/etc/searchEngine.conf.xml" in
49 Helm_registry.load_from configuration_file
51 let port = Helm_registry.get_int "search_engine.port"
53 let pages_dir = Helm_registry.get "search_engine.html_dir"
55 (** accepted HTTP servers for ask_uwobo method forwarding *)
56 let valid_servers= Helm_registry.get_string_list "search_engine.valid_servers"
58 let interactive_user_uri_choice_TPL = pages_dir ^ "/moogle_chat1.html"
59 let interactive_interpretation_choice_TPL = pages_dir ^ "/moogle_chat2.html"
60 let constraints_choice_TPL = pages_dir ^ "/moogle_constraints_choice.html"
61 let moogle_TPL = pages_dir ^ "/moogle.html"
64 let ic = Unix.open_process_in "hostname -f" in
65 let hostname = input_line ic in
66 ignore (Unix.close_process_in ic);
67 sprintf "http://%s:%d" hostname port
69 exception Chat_unfinished
70 exception Invalid_action of string (* invalid action for "/search" method *)
71 exception Unbound_identifier of string
73 let javascript_quote s =
74 let rex = Pcre.regexp "'" in
75 let rex' = Pcre.regexp "\"" in
76 Pcre.replace ~rex ~templ:"\\'"
77 (Pcre.replace ~rex:rex' ~templ:"\\\"" s)
79 (* build a bool from a 1-character-string *)
80 let bool_of_string' = function
83 | s -> failwith ("Can't parse a boolean from string: " ^ s)
85 (* build an int option from a string *)
86 let int_of_string' = function
90 Some (int_of_string s)
91 with Failure "int_of_string" ->
92 failwith ("Can't parse an int option from string: " ^ s)
94 (* HTML pretty printers for mquery_generator types *)
96 let html_of_r_obj (pos, uri) =
98 "<tr><td><input type='checkbox' name='constr_obj' checked='on'/></td><td>%s</td><td>%s</td><td>%s</td></tr>"
99 uri (U.text_of_position pos)
100 (if U.is_main_position pos then
101 sprintf "<input name='obj_depth' size='2' type='text' value='%s' />"
102 (U.text_of_depth pos "")
104 "<input type=\"hidden\" name=\"obj_depth\" />")
106 let html_of_r_rel pos =
108 "<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>"
109 (U.text_of_position (pos:>T.full_position)) (U.text_of_depth (pos:>T.full_position) "")
111 let html_of_r_sort (pos, sort) =
113 "<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>"
114 (U.text_of_sort sort) (U.text_of_position (pos:>T.full_position)) (U.text_of_depth (pos:>T.full_position) "")
116 let query_of_req (req: Http_types.request) =
119 | "/match" -> "Match"
121 | "/locate" -> "Locate"
124 (** pretty print a MathQL query result to an HELM theory file *)
125 let theory_of_result req result =
126 let results_no = List.length result in
127 if results_no > 0 then
128 let mode = if results_no > 10 then "linkonly" else "typeonly" in
130 let idx = ref (results_no + 1) in
136 <td valign=\"top\">%d.</td>
137 <td><ht:OBJECT uri=\"%s\" mode=\"%s\"/></td>
143 "<div class='resultsbar'>
144 <table width='100%%'>
146 <td class='left'><b class='query_kind'>%s</b></td>
147 <td class='right'><b>%d</b> result%s found</td>
153 <table xmlns:ht=\"http://www.cs.unibo.it/helm/namespaces/helm-theory\">%s</table>
156 results_no (if results_no > 1 then "s" else "") results
158 "<div class='resultsbar'>no results found</div>"
160 let pp_result req result =
162 "<html xmlns:ht=\"http://www.cs.unibo.it/helm/namespaces/helm-theory\">
164 <title>Query results</title>
165 <style> A { text-decoration: none } </style>
169 (theory_of_result req result)
171 (** chain application of Pcre substitutions *)
172 let rec apply_substs substs line =
175 | (rex, templ) :: rest -> apply_substs rest (Pcre.replace ~rex ~templ line)
176 (** fold like function on files *)
177 let fold_file f init fname =
178 let inchan = open_in fname in
179 let rec fold_lines' value =
181 let line = input_line inchan in
182 fold_lines' (f value line)
183 with End_of_file -> value
185 let res = (try fold_lines' init with e -> (close_in inchan; raise e)) in
188 (** iter like function on files *)
189 let iter_file f = fold_file (fun _ line -> f line) ()
191 let (expression_tag_RE, action_tag_RE, advanced_tag_RE,
192 advanced_checked_RE, simple_checked_RE,
193 title_tag_RE, no_choices_tag_RE, current_choices_tag_RE,
194 choices_tag_RE, msg_tag_RE, id_to_uris_RE, id_RE, iden_tag_RE,
195 interpretations_RE, interpretations_labels_RE, results_RE, new_aliases_RE,
196 form_RE, variables_initialization_RE, search_engine_url_RE)
198 (Pcre.regexp "@EXPRESSION@", Pcre.regexp "@ACTION@", Pcre.regexp "@ADVANCED@",
199 Pcre.regexp "@ADVANCED_CHECKED@", Pcre.regexp "@SIMPLE_CHECKED@",
200 Pcre.regexp "@TITLE@", Pcre.regexp "@NO_CHOICES@",
201 Pcre.regexp "@CURRENT_CHOICES@",
202 Pcre.regexp "@CHOICES@", Pcre.regexp "@MSG@",
203 Pcre.regexp "@ID_TO_URIS@", Pcre.regexp "@ID@", Pcre.regexp "@IDEN@",
204 Pcre.regexp "@INTERPRETATIONS@", Pcre.regexp "@INTERPRETATIONS_LABELS@",
205 Pcre.regexp "@RESULTS@", Pcre.regexp "@NEW_ALIASES@", Pcre.regexp "@FORM@",
206 Pcre.regexp "@VARIABLES_INITIALIZATION@", Pcre.regexp "@SEARCH_ENGINE_URL@")
207 let server_and_port_url_RE = Pcre.regexp "^http://([^/]+)/.*$"
209 (* let pp_error = sprintf "<html><body><h1>Error: %s</h1></body></html>" *)
210 let pp_error title msg =
211 sprintf "<hr size='1' /><div><b class='error'>%s:</b> %s</div>" title msg
213 let bad_request body outchan =
214 Http_daemon.respond_error ~code:(`Status (`Client_error `Bad_request)) ~body
217 let contype = "Content-Type", "text/html"
219 (* SEARCH ENGINE functions *)
221 let get_constraints term =
225 (CGLocateInductive.get_constraints term),
228 let constr_obj, constr_rel, constr_sort =
229 CGSearchPattern.get_constraints term in
230 (Some CGSearchPattern.universe),
231 (constr_obj, constr_rel, constr_sort),
232 (Some constr_obj, Some constr_rel, Some constr_sort)
234 let list_of_must, only = CGMatchConclusion.get_constraints [] [] term in
235 (* FG: there is no way to choose the block number ***************************)
236 let block = pred (List.length list_of_must) in
237 (Some CGMatchConclusion.universe),
238 (List.nth list_of_must block, [], []), (Some only, None, None)
243 <must_obj> ':' <must_rel> ':' <must_sort> ':' <only_obj> ':' <only_rel> ':' <only_sort>
245 <must_*> ::= ('0'|'1') ('_'|<int>) (',' ('0'|'1') ('_'|<int>))*
248 let add_user_constraints ~constraints
249 ((obj, rel, sort), (only_obj, only_rel, only_sort))
252 let l = Pcre.split ~pat:"," s in
256 let subs = Pcre.extract ~pat:"^(.)(\\d+|_)$" s in
257 (bool_of_string' subs.(1), int_of_string' subs.(2)))
260 Not_found -> failwith ("Can't parse constraint string: " ^ constraints)
263 (* to be used on "obj" *)
264 let add_user_must33 user_must must =
266 (fun (b, i) (p, u) ->
267 if b then Some (U.set_full_position p i, u) else None)
270 (* to be used on "rel" *)
271 let add_user_must22 user_must must =
273 (fun (b, i) p -> if b then Some (U.set_main_position p i) else None)
276 (* to be used on "sort" *)
277 let add_user_must32 user_must must =
279 (fun (b, i) (p, s)-> if b then Some (U.set_main_position p i, s) else None)
282 match Pcre.split ~pat:":" constraints with
283 | [user_obj;user_rel;user_sort;user_only_obj;user_only_rel;user_only_sort] ->
285 (user_obj,user_rel,user_sort,user_only_obj,user_only_rel,user_only_sort)
287 (parse_must user_obj,
289 parse_must user_sort,
290 bool_of_string' user_only_obj,
291 bool_of_string' user_only_rel,
292 bool_of_string' user_only_sort)
295 (if user_only_obj then only_obj else None),
296 (if user_only_rel then only_rel else None),
297 (if user_only_sort then only_sort else None)
300 let rec filter_some =
303 | None::tl -> filter_some tl
304 | (Some x)::tl -> x::(filter_some tl)
306 filter_some (add_user_must33 user_obj obj),
307 filter_some (add_user_must22 user_rel rel),
308 filter_some (add_user_must32 user_sort sort)
311 | _ -> failwith ("Can't parse constraint string: " ^ constraints)
313 let send_results results
314 ?(id_to_uris = DisambiguatingParser.EnvironmentP3.of_string "")
315 (req: Http_types.request) outchan
317 Http_daemon.send_basic_headers ~code:(`Code 200) outchan ;
318 Http_daemon.send_header "Content-Type" "text/xml" outchan;
319 Http_daemon.send_CRLF outchan ;
322 | `Results r -> theory_of_result req r
326 (search_engine_url_RE, my_own_url) ::
327 (results_RE, results_string)::
328 (advanced_tag_RE, req#param "advanced")::
329 (expression_tag_RE, req#param "expression")::
331 (function (key,value) ->
332 let key' = (Pcre.extract ~pat:"param\\.(.*)" key).(1) in
333 Pcre.regexp ("@" ^ key' ^ "@"), value)
335 (fun (key,_) as p-> Pcre.pmatch ~pat:"^param\\." key)
337 (if req#param "advanced" = "no" then
338 [ simple_checked_RE, "checked='true'";
339 advanced_checked_RE, "" ]
341 [ simple_checked_RE, "";
342 advanced_checked_RE, "checked='true'" ])
347 DisambiguatingParser.EnvironmentP3.to_string id_to_uris
351 (* CSC: Bug here: this is a string, not an array! *)
352 ((new_aliases_RE, "'" ^ javascript_quote new_aliases ^ "'")::subst)
355 output_string outchan (processed_line ^ "\n"))
358 let exec_action mqi_handle (req: Http_types.request) outchan =
359 let term_string = req#param "expression" in
360 let (context, metasenv) = ([], []) in
362 try req#param "aliases"
363 with Http_types.Param_not_found _ -> ""
365 let parse_interpretation_choices choices =
366 List.map int_of_string (Pcre.split ~pat:" " choices) in
367 let parse_choices choices_raw =
368 let choices = Pcre.split ~pat:";" choices_raw in
371 match Pcre.split ~pat:"\\s" x with
373 | id::tail when id<>"" ->
376 Some (List.map (fun u -> Netencoding.Url.decode u) tail)
379 | _ -> failwith "Can't parse choices")
384 DisambiguatingParser.EnvironmentP3.of_string id_to_uris_raw in
387 let choices_raw = req#param "choices" in
388 parse_choices choices_raw
389 with Http_types.Param_not_found _ -> (fun _ -> None)
391 let interpretation_choices =
393 let choices_raw = req#param "interpretation_choices" in
394 if choices_raw = "" then None
395 else Some (parse_interpretation_choices choices_raw)
396 with Http_types.Param_not_found _ -> None
398 let module Chat: DisambiguateTypes.Callbacks =
401 let interactive_user_uri_choice
403 ?enable_button_for_non_vars ~(title: string) ~(msg: string)
404 ~(id: string) (choices: string list)
406 (match id_to_choices id with
407 | Some choices -> choices
409 if req#param "advanced" = "no" then
411 let len = String.length s in
412 let suffix = String.sub s (len-4) 4 in
413 not (suffix = ".var") in
414 List.filter isvar choices
416 let msg = Pcre.replace ~pat:"\'" ~templ:"\\\'" msg in
417 (match selection_mode with
418 | `SINGLE -> assert false
420 Http_daemon.send_basic_headers ~code:(`Code 200) outchan;
421 Http_daemon.send_CRLF outchan ;
423 "<input type=\"checkbox\" name=\"param.choices\"
425 uri ^ "\" />" ^ "<b>" ^ uri ^ "</b>" in
426 (* aggiungere gli hyperlinks? *)
428 String.concat "<br />"
429 (List.map check_box choices) in
434 [advanced_tag_RE, req#param "advanced";
435 choices_tag_RE, check_boxes;
437 string_of_int (List.length choices);
439 current_choices_tag_RE, req#param "choices";
440 expression_tag_RE, req#param "expression";
441 action_tag_RE, string_tail req#path ]
444 output_string outchan (processed_line ^ "\n"))
445 interactive_user_uri_choice_TPL;
446 raise Chat_unfinished))
448 let interactive_interpretation_choice interpretations =
449 match interpretation_choices with
450 Some l -> prerr_endline "CARRAMBA" ; l
452 let html_interpretations =
454 "<input type=\"radio\" name=\"param.interp\" value=\"" ^
455 (string_of_int n) ^ "\" />" in
457 String.concat "<br />"
460 sprintf "<span>%s = %s</span>" id value)
466 ((radio_button n)^(text interp))::(aux (n+1) tl) in
467 String.concat "<br />" (aux 0 interpretations)
469 Http_daemon.send_basic_headers ~code:(`Code 200) outchan ;
470 Http_daemon.send_CRLF outchan ;
475 [advanced_tag_RE, req#param "advanced";
476 interpretations_RE, html_interpretations;
477 current_choices_tag_RE, req#param "choices";
478 expression_tag_RE, req#param "expression";
479 action_tag_RE, string_tail req#path ]
482 output_string outchan (processed_line ^ "\n"))
483 interactive_interpretation_choice_TPL;
484 raise Chat_unfinished
486 let input_or_locate_uri ~title ?id () =
488 | Some id -> raise (Unbound_identifier id)
489 | None -> assert false
493 let module Disambiguate' = DisambiguatingParser.Make(Chat) in
494 let (id_to_uris', metasenv', term') =
496 Disambiguate'.disambiguate_term mqi_handle
497 context metasenv term_string id_to_uris
499 [id_to_uris',metasenv',term'] -> id_to_uris',metasenv',term'
503 ((must_obj, must_rel, must_sort) as must'),
504 ((only_obj, only_rel, only_sort) as only) =
505 get_constraints term' req#path
508 (try ignore (req#param "constraints"); false
509 with Http_types.Param_not_found _ -> true) &&
510 (req#param "advanced" = "no") && (req#path = "/hint")
513 match mqi_handle.MQIConn.pgc with
514 | MQIConn.MySQL_C conn -> conn
517 let results = List.map snd (Match_concl.cmatch dbd term') in
518 send_results (`Results results) ~id_to_uris:id_to_uris' req outchan
523 ~constraints:(req#param "constraints")
525 with Http_types.Param_not_found _ ->
526 if req#param "advanced" = "no" then
530 "var aliases = '" ^ id_to_uris_raw ^ "';\n" ^
531 "var constr_obj_len = " ^
532 string_of_int (List.length must_obj) ^ ";\n" ^
533 "var constr_rel_len = " ^
534 string_of_int (List.length must_rel) ^ ";\n" ^
535 "var constr_sort_len = " ^
536 string_of_int (List.length must_sort) ^ ";\n" in
538 (if must_obj = [] then "" else
539 "<h4>Obj constraints</h4>" ^
541 (String.concat "\n" (List.map html_of_r_obj must_obj)) ^
543 (* The following three lines to make Javascript create *)
544 (* the constr_obj[] and obj_depth[] arrays even if we *)
545 (* have only one real entry. *)
546 "<input type=\"hidden\" name=\"constr_obj\" />" ^
547 "<input type=\"hidden\" name=\"obj_depth\" />") ^
548 (if must_rel = [] then "" else
549 "<h4>Rel constraints</h4>" ^
551 (String.concat "\n" (List.map html_of_r_rel must_rel)) ^
553 (* The following two lines to make Javascript create *)
554 (* the constr_rel[] and rel_depth[] arrays even if *)
555 (* we have only one real entry. *)
556 "<input type=\"hidden\" name=\"constr_rel\" />" ^
557 "<input type=\"hidden\" name=\"rel_depth\" />") ^
558 (if must_sort = [] then "" else
559 "<h4>Sort constraints</h4>" ^
561 (String.concat "\n" (List.map html_of_r_sort must_sort)) ^
563 (* The following two lines to make Javascript create *)
564 (* the constr_sort[] and sort_depth[] arrays even if *)
565 (* we have only one real entry. *)
566 "<input type=\"hidden\" name=\"constr_sort\" />" ^
567 "<input type=\"hidden\" name=\"sort_depth\" />") ^
568 "<h4>Only constraints</h4>" ^
569 "Enforce Only constraints for objects: " ^
570 "<input type='checkbox' name='only_obj'" ^
571 (if only_obj = None then "" else " checked='yes'") ^
573 "Enforce Rel constraints for objects: " ^
574 "<input type='checkbox' name='only_rel'" ^
575 (if only_rel = None then "" else " checked='yes'") ^
577 "Enforce Sort constraints for objects: " ^
578 "<input type='checkbox' name='only_sort'" ^
579 (if only_sort = None then "" else " checked='yes'") ^
582 Http_daemon.send_basic_headers ~code:(`Code 200) outchan ;
583 Http_daemon.send_CRLF outchan ;
589 variables_initialization_RE, variables;
590 advanced_tag_RE, req#param "advanced";
591 current_choices_tag_RE, req#param "choices";
592 interpretations_RE, req#param "interpretation_choices";
593 expression_tag_RE, req#param "expression";
594 action_tag_RE, string_tail req#path] line
596 output_string outchan (processed_line ^ "\n"))
597 constraints_choice_TPL;
598 raise Chat_unfinished)
601 G.query_of_constraints universe must'' only'
603 let results = MQueryInterpreter.execute mqi_handle query in
604 send_results (`Results (List.map fst results))
605 ~id_to_uris:id_to_uris' req outchan
607 (* HTTP DAEMON CALLBACK *)
609 let build_dynamic_uri url params =
611 String.concat "&" (List.map (fun (key,value) -> (key ^ "=" ^ (Netencoding.Url.encode value))) params) in
614 let build_uwobo_request (req: Http_types.request) outchan =
615 prerr_endline ("ECCOLO: " ^ req#param "param.SEARCH_ENGINE_URL");
616 let xmluri = build_dynamic_uri ((req#param "param.SEARCH_ENGINE_URL") ^ "/search") req#params in
617 prerr_endline ("xmluri: " ^ xmluri);
618 (*let xmluri = Netencoding.Url.encode xmluri in*)
619 let server_and_port = req#param "param.processorURL" in
622 (server_and_port ^ "apply")
623 (("xmluri",xmluri)::("keys",(req#param "param.thkeys"))::req#params) in
624 (* if List.mem server_and_port valid_servers then *)
625 prerr_endline newreq;
628 ~headers:["Content-Type", "text/html"]
629 ~body:(Http_client.http_get newreq)
633 ~body:(pp_error "Untrusted UWOBO server" server_and_port)
636 let proxy url outchan =
637 let server_and_port =
638 (Pcre.extract ~rex:server_and_port_url_RE url).(1)
640 if List.mem server_and_port valid_servers then
642 ~headers:["Content-Type", "text/html"]
643 ~body:(Http_client.http_get url)
647 ~body:(pp_error "Untrusted UWOBO server" server_and_port)
650 let callback mqi_handle (req: Http_types.request) outchan =
652 debug_print (sprintf "Received request: %s" req#path);
654 | "/help" -> Http_daemon.respond ~body:"HELM Search Engine" outchan
656 let initial_expression =
657 try req#param "expression" with Http_types.Param_not_found _ -> ""
660 Pcre.replace ~pat:"\\s*$"
661 (Pcre.replace ~pat:"^\\s*" initial_expression)
663 if expression = "" then
664 send_results (`Results []) req outchan
667 let query = G.locate expression in
668 MQueryInterpreter.execute mqi_handle query
670 send_results (`Results (List.map fst results)) req outchan
672 let query_string = req#param "query" in
673 let lexbuf = Lexing.from_string query_string in
674 let query = MQueryUtil.query_of_text lexbuf in
675 let result = MQueryInterpreter.execute mqi_handle query in
676 let result_string = pp_result req (List.map fst result) in
677 Http_daemon.respond ~body:result_string ~headers:[contype] outchan
678 (* Http_daemon.respond ~headers:[contype] ~body:(pp_result req result) outchan *)
680 let target = req#param "target" in
681 let source = req#param "source" in
682 let query = G.unreferred target source in
683 let result = MQueryInterpreter.execute mqi_handle query in
684 Http_daemon.respond ~headers:[contype]
685 ~body:(pp_result req (List.map fst result)) outchan
687 (* TODO implement "is_permitted" *)
688 let _ = prerr_endline
689 (Netencoding.Url.encode "http://mowgli.cs.unibo.it:38080/") in
690 (let is_permitted _ = true in
691 let remove_fragment uri = Pcre.replace ~pat:"#.*" uri in
692 let page = remove_fragment (req#param "url") in
695 bool_of_string (req#param "preprocess")
696 with Invalid_argument _ | Http_types.Param_not_found _ -> false)
699 | page when is_permitted page ->
700 (let fname = sprintf "%s/%s" pages_dir (remove_fragment page) in
701 Http_daemon.send_basic_headers ~code:(`Code 200) outchan;
702 Http_daemon.send_header "Content-Type" "text/html" outchan;
703 Http_daemon.send_CRLF outchan;
704 if preprocess then begin
707 output_string outchan
709 ((search_engine_url_RE, my_own_url) ::
710 (advanced_tag_RE, "no") ::
713 (function (key,value) ->
715 (Pcre.extract ~pat:"param\\.(.*)" key).(1)
717 Pcre.regexp ("@" ^ key' ^ "@"), value
720 (fun (key,_) as p-> Pcre.pmatch ~pat:"^param\\." key)
727 Http_daemon.send_file ~src:(FileSrc fname) outchan)
728 | page -> Http_daemon.respond_forbidden ~url:page outchan))
729 (* OLD | "/ask_uwobo" -> proxy (req#param "url") outchan *)
730 | "/ask_uwobo" -> build_uwobo_request req outchan
731 | "/hint" | "/match" | "/elim" -> exec_action mqi_handle req outchan
733 Http_daemon.respond_error ~code:(`Status (`Client_error `Bad_request))
735 debug_print (sprintf "%s done!" req#path)
737 | Chat_unfinished -> prerr_endline "Chat unfinished, Try again!"
738 | Http_types.Param_not_found attr_name ->
739 bad_request (sprintf "Parameter '%s' is missing" attr_name) outchan
740 | CicTextualParser2.Parse_error msg ->
741 send_results (`Error (pp_error "Parse_error" msg)) req outchan
742 | Unbound_identifier id ->
743 send_results (`Error (pp_error "Unbound identifier" id)) req outchan
745 let exn_string = Printexc.to_string exn in
746 debug_print exn_string;
747 let msg = pp_error "Uncaught exception" exn_string in
748 send_results (`Error msg) req outchan
751 printf "%s started and listening on port %d\n" daemon_name port;
752 printf "Current directory is %s\n" (Sys.getcwd ());
753 printf "HTML directory is %s\n" pages_dir;
755 Unix.putenv "http_proxy" "";
756 let mqi_handle = C.init ~log:debug_print () in
757 Http_daemon.start' ~port (callback mqi_handle);
759 printf "%s is terminating, bye!\n" daemon_name