helm/searchEngine/searchEngine.ml

   1
   2 (* Copyright (C) 2002, HELM Team.
   3  *
   4  * This file is part of HELM, an Hypertextual, Electronic
   5  * Library of Mathematics, developed at the Computer Science
   6  * Department, University of Bologna, Italy.
   7  *
   8  * HELM is free software; you can redistribute it and/or
   9  * modify it under the terms of the GNU General Public License
  10  * as published by the Free Software Foundation; either version 2
  11  * of the License, or (at your option) any later version.
  12  *
  13  * HELM is distributed in the hope that it will be useful,
  14  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  15  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16  * GNU General Public License for more details.
  17  *
  18  * You should have received a copy of the GNU General Public License
  19  * along with HELM; if not, write to the Free Software
  20  * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
  21  * MA  02111-1307, USA.
  22  *
  23  * For details, see the HELM World-Wide-Web page,
  24  * http://cs.unibo.it/helm/.
  25  *)
  26
  27 let debug = false;;
  28 let debug_print s = if debug then prerr_endline s;;
  29 Http_common.debug := debug;;
  30
  31 open Printf;;
  32
  33 let daemon_name = "Search Engine";;
  34 let default_port = 58085;;
  35 let port_env_var = "SEARCH_ENGINE_PORT";;
  36
  37 let port =
  38   try
  39     int_of_string (Sys.getenv port_env_var)
  40   with
  41   | Not_found -> default_port
  42   | Failure "int_of_string" ->
  43       prerr_endline "Warning: invalid port, reverting to default";
  44       default_port
  45 in
  46 let pp_result result =
  47   let result_string = MQueryUtil.text_of_result result "\n" in
  48   (sprintf "<html><body><pre>%s</pre></body></html>" result_string)
  49 in
  50 let pp_error = sprintf "<html><body><h1>Error: %s</h1></body></html>" in
  51 let bad_request body outchan =
  52   Http_daemon.respond_error ~status:(`Client_error `Bad_request) ~body outchan
  53 in
  54 let callback req outchan =
  55   try
  56     (match req#path with
  57     | "/execute" ->
  58         let query_string = req#param "query" in
  59         let lexbuf = Lexing.from_string query_string in
  60         let query = MQueryUtil.query_of_text lexbuf in
  61         let result = MQueryGenerator.execute_query query in
  62         let result_string = MQueryUtil.text_of_result result "\n" in
  63         Http_daemon.respond
  64           ~body:
  65             (sprintf "<html><body><pre>%s</pre></body></html>" result_string)
  66           outchan
  67     | "/locate" ->
  68         let id = req#param "id" in
  69         let result = MQueryGenerator.locate id in
  70         Http_daemon.respond ~body:(pp_result result) outchan
  71     | "/searchPattern" ->
  72         let term_string = req#param "term" in
  73         let precision = int_of_string (req#param "precision") in
  74         let lexbuf = Lexing.from_string term_string in
  75         let (dom, mkterm) =
  76           CicTextualParser.main CicTextualLexer.token lexbuf
  77         in
  78         (match dom with
  79         | [] -> (* no free variables *)
  80             let term = mkterm (fun _ -> None) in
  81             prerr_endline (CicPp.ppterm term);
  82             let result = MQueryGenerator.searchPattern [] [] term precision in
  83             Http_daemon.respond ~body:(pp_result result) outchan
  84         | _ ->
  85             Http_daemon.respond
  86               ~body:(pp_error
  87                 "identifiers resolution in the environment not yet implemented")
  88               outchan)
  89     | invalid_request ->
  90         Http_daemon.respond_error ~status:(`Client_error `Bad_request) outchan)
  91   with
  92   | Http_request.Param_not_found attr_name ->
  93       bad_request (sprintf "Parameter '%s' is missing" attr_name) outchan
  94   | Failure "int_of_string" ->
  95       bad_request "Invalid 'precision' value, must be an integer" outchan
  96   | exc ->
  97       Http_daemon.respond
  98         ~body:(pp_error ("Uncaught exception: " ^ (Printexc.to_string exc)))
  99         outchan
 100 in
 101 printf "%s started and listening on port %d\n" daemon_name port;
 102 printf "current directory is %s\n" (Sys.getcwd ());
 103 flush stdout;
 104 Mqint.set_database Mqint.postgres_db;
 105 Mqint.init "host=mowgli.cs.unibo.it dbname=helm_mowgli_new_schema user=helm";
 106 Http_daemon.start' ~port callback;
 107 Mqint.close ();
 108 printf "%s is terminating, bye!\n" daemon_name
 109