]> matita.cs.unibo.it Git - helm.git/commitdiff
ported to latest ocaml-http API
authorStefano Zacchiroli <zack@upsilon.cc>
Thu, 20 May 2004 16:20:21 +0000 (16:20 +0000)
committerStefano Zacchiroli <zack@upsilon.cc>
Thu, 20 May 2004 16:20:21 +0000 (16:20 +0000)
helm/DEVEL/rdfly/rdfly.ml
helm/searchEngine/searchEngine.ml

index d0bddd8ec21e51e7070ee9eaa27aa45d81523514..b9a79d1397da4941f444b678bc6d62d04322e995 100644 (file)
@@ -131,7 +131,8 @@ let mk_return_fun contype msg outchan =
                                                                                                                                                                                     
 let return_html = mk_return_fun "text/html"
 let return_xml = mk_return_fun "text/xml"
-let return_400 body ch = Http_daemon.respond_error ~code:400 ~body ch
+let return_400 body ch =
+  Http_daemon.respond_error ~code:(`Code 400) ~body ch
 let return_html_error s = return_html ("<html><body>" ^ s ^ "</body></html>")
 
 let get_option key =
@@ -170,7 +171,9 @@ let callback (req: Http_types.request) ch =
         | s -> return_html_error ("unsupported kind: " ^ s) ch
       end ;
       M.disconnect db
-    | invalid_request -> Http_daemon.respond_error ~status:(`Client_error `Bad_request) ch)
+    | invalid_request ->
+        Http_daemon.respond_error ~code:(`Status (`Client_error `Bad_request))
+          ch)
   with
   | Http_types.Param_not_found attr_name ->
       return_400 (Printf.sprintf "Parameter '%s' is missing" attr_name) ch
index fc0fb9cbee4ec2af67bb77d7f2b12ccfc1f269c2..87bcad36a42bc9b42d4985bdb7c4368410f7e0b3 100644 (file)
@@ -166,7 +166,8 @@ let port = Helm_registry.get_int "search_engine.port";;
 let pp_error = sprintf "<html><body><h1>Error: %s</h1></body></html>";;
 
 let bad_request body outchan =
-  Http_daemon.respond_error ~status:(`Client_error `Bad_request) ~body outchan
+  Http_daemon.respond_error ~code:(`Status (`Client_error `Bad_request)) ~body
+    outchan
 ;;
 
 let contype = "Content-Type", "text/html";;
@@ -305,7 +306,7 @@ let callback mqi_handle (req: Http_types.request) outchan =
         (match page with
         | page when is_permitted page ->
             (let fname = sprintf "%s/%s" pages_dir (remove_fragment page) in
-            Http_daemon.send_basic_headers ~code:200 outchan;
+            Http_daemon.send_basic_headers ~code:(`Code 200) outchan;
             Http_daemon.send_header "Content-Type" "text/html" outchan;
             Http_daemon.send_CRLF outchan;
             if preprocess then begin
@@ -397,13 +398,14 @@ let callback mqi_handle (req: Http_types.request) outchan =
                   (match selection_mode with
                   | `SINGLE -> assert false
                   | `MULTIPLE ->
-                      Http_daemon.send_basic_headers ~code:200 outchan ;
+                      Http_daemon.send_basic_headers ~code:(`Code 200) outchan;
                       Http_daemon.send_CRLF outchan ;
                       iter_file
                         (fun line ->
                           let formatted_choices =
                             String.concat ","
-                              (List.map (fun uri -> sprintf "\'%s\'" uri) choices)
+                              (List.map (fun uri -> sprintf "\'%s\'" uri)
+                                choices)
                           in
                           let processed_line =
                             apply_substs
@@ -445,7 +447,7 @@ let callback mqi_handle (req: Http_types.request) outchan =
                  in
                   String.concat ", " (aux 0 interpretations)
                 in
-                Http_daemon.send_basic_headers ~code:200 outchan ;
+                Http_daemon.send_basic_headers ~code:(`Code 200) outchan ;
                 Http_daemon.send_CRLF outchan ;
                 iter_file
                   (fun line ->
@@ -526,15 +528,18 @@ let callback mqi_handle (req: Http_types.request) outchan =
                   "<h4>Only constraints</h4>" ^
                   "Enforce Only constraints for objects: " ^
                     "<input type='checkbox' name='only_obj'" ^
-                    (if only_obj = None then "" else " checked='yes'") ^ " /><br />" ^
+                    (if only_obj = None then "" else " checked='yes'") ^
+                    " /><br />" ^
                   "Enforce Rel constraints for objects: " ^
                     "<input type='checkbox' name='only_rel'" ^
-                    (if only_rel = None then "" else " checked='yes'") ^ " /><br />" ^
+                    (if only_rel = None then "" else " checked='yes'") ^
+                    " /><br />" ^
                   "Enforce Sort constraints for objects: " ^
                     "<input type='checkbox' name='only_sort'" ^
-                    (if only_sort = None then "" else " checked='yes'") ^ " /><br />"
+                    (if only_sort = None then "" else " checked='yes'") ^
+                    " /><br />"
               in
-              Http_daemon.send_basic_headers ~code:200 outchan ;
+              Http_daemon.send_basic_headers ~code:(`Code 200) outchan ;
               Http_daemon.send_CRLF outchan ;
               iter_file
                 (fun line ->
@@ -551,7 +556,7 @@ let callback mqi_handle (req: Http_types.request) outchan =
            G.query_of_constraints universe must'' only'
           in
           let results = MQueryInterpreter.execute mqi_handle query in 
-           Http_daemon.send_basic_headers ~code:200 outchan ;
+           Http_daemon.send_basic_headers ~code:(`Code 200) outchan ;
            Http_daemon.send_CRLF outchan ;
            iter_file
              (fun line ->
@@ -567,7 +572,8 @@ let callback mqi_handle (req: Http_types.request) outchan =
                output_string outchan (processed_line ^ "\n"))
              final_results_TPL
     | invalid_request ->
-        Http_daemon.respond_error ~status:(`Client_error `Bad_request) outchan);
+        Http_daemon.respond_error ~code:(`Status (`Client_error `Bad_request))
+          outchan);
     debug_print (sprintf "%s done!" req#path)
   with
   | Chat_unfinished -> prerr_endline "Chat unfinished, Try again!"