exception Invalid_action of string (* invalid action for "/search" method *)
let daemon_name = "Moogle"
-let configuration_file =
- "/projects/helm/daemons/searchEngine.debug/moogle.conf.xml"
+let configuration_file = "/projects/helm/etc/moogle.conf.xml"
let placeholders = [
"ACTION"; "ADVANCED"; "ADVANCED_CHECKED"; "CHOICES"; "CURRENT_CHOICES";
let port = Helm_registry.get_int "search_engine.port"
let pages_dir = Helm_registry.get "search_engine.html_dir"
-let interactive_interpretation_choice_TPL = pages_dir ^ "/moogle_chat2.html"
let moogle_TPL = pages_dir ^ "/moogle.html"
+let choices_TPL = pages_dir ^ "/moogle_chat.html"
let my_own_url =
let ic = Unix.open_process_in "hostname -f" in
| "/hint" -> "Hint"
| "/locate" -> "Locate"
| "/elim" -> "Elim"
- | _ -> assert false
+ | _ -> ""
+
+ (* given a uri with a query part in input try to find in it a string
+ * "¶m_name=..." (where param_name is given). If found its value will be
+ * set to param_value. If not, a trailing "¶m_name=param_value" (where
+ * both are given) is added to the input string *)
+let patch_param param_name param_value url =
+ let rex = Pcre.regexp (sprintf "&%s=[^&]*" (Pcre.quote param_name)) in
+ if Pcre.pmatch ~rex url then
+ Pcre.replace ~rex ~templ:(sprintf "%s=%s" param_name param_value) url
+ else
+ sprintf "%s&%s=%s" url param_name param_value
let send_results results
?(id_to_uris = CicTextualParser2.EnvironmentP3.of_string "")
(req: Http_types.request) outchan
=
let query_kind = query_kind_of_req req in
+ let interp = try req#param "interp" with Http_types.Param_not_found _ -> "" in
let page_link anchor page =
try
let this = req#param "this" in
let target =
- if Pcre.pmatch ~rex:page_RE this then
- Pcre.replace ~rex:page_RE ~templ:(sprintf "¶m.page=%d" page)
- this
- else
- sprintf "%s¶m.page=%d" this page
+ (patch_param "param.interp" interp
+ (patch_param "param.page" (string_of_int page)
+ this))
in
let target = Pcre.replace ~pat:"&" ~templ:"&" target in
sprintf "<a href=\"%s\">%s</a>" target anchor
req#param "advanced"
with Http_types.Param_not_found _ -> "no"
in
+ let query_kind = query_kind_of_req req in
iter_file
(fun line ->
let processed_line =
apply_substs
- [tag "ADVANCED", advanced;
- tag "INTERPRETATIONS", html_interpretations;
- tag "CURRENT_CHOICES", req#param "choices";
- tag "EXPRESSION", req#param "expression";
- tag "ACTION", string_tail req#path ]
- line
+ [ tag "SEARCH_ENGINE_URL", my_own_url;
+ tag "ADVANCED", advanced;
+ tag "INTERPRETATIONS", html_interpretations;
+ tag "CURRENT_CHOICES", req#param "choices";
+ tag "EXPRESSION", req#param "expression";
+ tag "QUERY_KIND", query_kind;
+ tag "QUERY_SUMMARY", "disambiguation";
+ tag "ACTION", string_tail req#path ]
+ line
in
output_string outchan (processed_line ^ "\n"))
- interactive_interpretation_choice_TPL;
+ choices_TPL;
raise Chat_unfinished
let input_or_locate_uri ~title ?id () =
(match req#path with
| "/getpage" ->
(* TODO implement "is_permitted" *)
- (let is_permitted _ = true in
+ (let is_permitted page = not (Pcre.pmatch ~pat:"/" page) in
let page = req#param "url" in
+ let fname = sprintf "%s/%s" pages_dir page in
let preprocess =
(try
bool_of_string (req#param "preprocess")
with Invalid_argument _ | Http_types.Param_not_found _ -> false)
in
(match page with
- | page when is_permitted page ->
- (let fname = sprintf "%s/%s" pages_dir page in
+ | page when is_permitted page && Sys.file_exists fname ->
Http_daemon.send_basic_headers ~code:(`Code 200) outchan;
Http_daemon.send_header "Content-Type" "text/html" outchan;
Http_daemon.send_CRLF outchan;
"\n"))
fname
end else
- Http_daemon.send_file ~src:(Http_types.FileSrc fname) outchan)
+ Http_daemon.send_file ~src:(Http_types.FileSrc fname) outchan
| page -> Http_daemon.respond_forbidden ~url:page outchan))
| "/help" -> Http_daemon.respond ~body:daemon_name outchan
| "/locate" ->