-
(* Copyright (C) 2002, HELM Team.
*
* This file is part of HELM, an Hypertextual, Electronic
let debug = true;;
let debug_print s = if debug then prerr_endline s;;
-Http_common.debug := true;;
+(* Http_common.debug := true;; *)
open Printf;;
+let postgresConnectionString =
+ try
+ Sys.getenv "POSTGRESQL_CONNECTION_STRING"
+ with
+ Not_found -> "host=mowgli.cs.unibo.it dbname=helm_mowgli_new_schema user=helm"
+;;
+
let daemon_name = "Search Engine";;
let default_port = 58085;;
let port_env_var = "SEARCH_ENGINE_PORT";;
-let pages_dir = "html";; (* relative to searchEngine's document root *)
+let pages_dir =
+ try
+ Sys.getenv "SEARCH_ENGINE_HTML_DIR"
+ with Not_found -> "html" (* relative to searchEngine's document root *)
+;;
let interactive_user_uri_choice_TPL = pages_dir ^ "/templateambigpdq1.html";;
let interactive_interpretation_choice_TPL = pages_dir ^ "/templateambigpdq2.html";;
let final_results_TPL = pages_dir ^ "/templateambigpdq3.html";;
exception Chat_unfinished
+ (** pretty print a MathQL query result to a string *)
+let text_of_result result sep =
+ let res_string = ref "" in
+ let app = function s -> res_string := !res_string ^ s in
+ MQueryUtil.text_of_result app result sep ;
+ !res_string
+;;
+
(** chain application of Pcre substitutions *)
let rec apply_substs substs line =
match substs with
default_port
in
let pp_result result =
- let result_string = MQueryUtil.text_of_result result "\n" in
+ let res_string = text_of_result result "\n" in
(sprintf "<html>\n<head>\n</head>\n<body>\n<pre>%s</pre>\n</body>\n</html>"
- result_string)
+ res_string)
in
let pp_error = sprintf "<html><body><h1>Error: %s</h1></body></html>" in
let bad_request body outchan =
let callback (req: Http_types.request) outchan =
try
debug_print (sprintf "Received request: %s" req#path);
+ if req#path <> "/getpage" then
+ Mqint.init postgresConnectionString;
(match req#path with
| "/execute" ->
let query_string = req#param "query" in
let lexbuf = Lexing.from_string query_string in
let query = MQueryUtil.query_of_text lexbuf in
let result = MQueryGenerator.execute_query query in
- let result_string = MQueryUtil.text_of_result result "\n" in
+ let result_string = text_of_result result "\n" in
Http_daemon.respond
~body:
(sprintf "<html><body><pre>%s</pre></body></html>" result_string)
let result = MQueryGenerator.locate id in
Http_daemon.respond ~headers:[contype] ~body:(pp_result result) outchan
| "/getpage" ->
+ (* TODO implement "is_permitted" *)
(let is_permitted _ = true in
let remove_fragment uri = Pcre.replace ~pat:"#.*" uri in
- match req#param "url" with
- | page when is_permitted (remove_fragment page) ->
- Http_daemon.respond_file
- ~fname:(sprintf "%s/%s" pages_dir (remove_fragment page)) outchan
+ let page = remove_fragment (req#param "url") in
+ match page with
+ | page when is_permitted page ->
+ let fname = sprintf "%s/%s" pages_dir (remove_fragment page) in
+ debug_print (sprintf "Returning file: %s" fname);
+ Http_daemon.send_basic_headers ~code:200 outchan;
+ Http_daemon.send_CRLF outchan;
+ Http_daemon.send_file ~name:fname outchan
| page -> Http_daemon.respond_forbidden ~url:page outchan)
| "/searchPattern" ->
let term_string = req#param "term" in
let rec parse_tokens keys lookup = function (* TODO spostarla fuori *)
| [] -> keys, lookup
| "alias" :: key :: value :: rest ->
- parse_tokens
- (key::keys)
- (fun id ->
- if id = key then
- Some (Disambiguate.cic_textual_parser_uri_of_string value)
- else lookup id)
- rest
+ let key' = CicTextualParser0.Id key in
+ parse_tokens
+ (key'::keys)
+ (fun id ->
+ if id = key' then
+ Some
+ (CicTextualParser0.Uri (MQueryMisc.cic_textual_parser_uri_of_string value))
+ else lookup id)
+ rest
| _ -> failwith "Can't parse aliases"
in
let parse_choices choices_raw =
(fun _ -> None)
choices
in
- let id_to_uris = parse_tokens [] (fun _ -> None) tokens in
+ let (id_to_uris : Disambiguate.domain_and_interpretation) =
+ parse_tokens [] (fun _ -> None) tokens in
let id_to_choices =
try
let choices_raw = req#param "choices" in
let module Chat: Disambiguate.Callbacks =
struct
+ let get_metasenv () =
+ !CicTextualParser0.metasenv
+
+ let set_metasenv metasenv =
+ CicTextualParser0.metasenv := metasenv
+
let output_html = prerr_endline
let interactive_user_uri_choice
(fun (id, value) ->
(sprintf "alias %s %s"
id
- (Disambiguate.wrong_xpointer_format_from_wrong_xpointer_format'
+ (MQueryMisc.wrong_xpointer_format_from_wrong_xpointer_format'
value)))
l)) ^
"\"")
let must = MQueryLevels2.get_constraints term' in
let must',only = refine_constraints must in
let results = MQueryGenerator.searchPattern must' only in
- debug_print "FASE 3";
iter_file
(fun line ->
let new_aliases =
(List.map
(fun name ->
sprintf "\"alias %s cic:%s\""
- name
+ (match name with
+ CicTextualParser0.Id name -> name
+ | _ -> assert false (*CSC: completare *))
(match f name with
| None -> assert false
- | Some t ->
- Disambiguate.string_of_cic_textual_parser_uri
- t))
+ | Some (CicTextualParser0.Uri t) ->
+ MQueryMisc.string_of_cic_textual_parser_uri
+ t
+ | _ -> assert false (*CSC: completare *)))
domain)
in
let processed_line =
apply_substs
- [results_RE, MQueryUtil.text_of_result results "\n";
+ [results_RE, text_of_result results "\n";
new_aliases_RE, new_aliases]
line
in
| invalid_request ->
Http_daemon.respond_error ~status:(`Client_error `Bad_request) outchan);
+ if req#path <> "/getpage" then
+ Mqint.close ();
debug_print (sprintf "%s done!" req#path)
with
| Chat_unfinished -> prerr_endline "Chat unfinished, Try again!"
| exc ->
Http_daemon.respond
~body:(pp_error ("Uncaught exception: " ^ (Printexc.to_string exc)))
- outchan
+ outchan
in
printf "%s started and listening on port %d\n" daemon_name port;
-printf "current directory is %s\n" (Sys.getcwd ());
+printf "Current directory is %s\n" (Sys.getcwd ());
+printf "HTML directory is %s\n" pages_dir;
flush stdout;
Unix.putenv "http_proxy" "";
Mqint.set_database Mqint.postgres_db;
-Mqint.init "host=mowgli.cs.unibo.it dbname=helm_mowgli_new_schema user=helm";
Http_daemon.start' ~port callback;
-Mqint.close ();
printf "%s is terminating, bye!\n" daemon_name
projects / helm.git / blobdiff