]> matita.cs.unibo.it Git - helm.git/commitdiff
projects / helm.git / commitdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: 829bcae)
exception carried in response xml documents are now split in two attributes:
authorStefano Zacchiroli <zack@upsilon.cc>
Mon, 24 Jan 2005 16:13:00 +0000 (16:13 +0000)
committerStefano Zacchiroli <zack@upsilon.cc>
Mon, 24 Jan 2005 16:13:00 +0000 (16:13 +0000)
"helm:exception" (exception name) and "helm:exception_arg" (exception
argument)

helm/http_getter/main.ml patch | blob | history

diff --git a/helm/http_getter/main.ml b/helm/http_getter/main.ml
index b2a75488a3c8586a73d9ebbd040b7c8e950ec34a..ed831c054b22c3db90c3f0e889f1159ca19648dd 100644 (file)
--- a/helm/http_getter/main.ml
+++ b/helm/http_getter/main.ml
@@ -93,10 +93,10 @@ let parse_rdf_class (req: Http_types.request) =
 let html_tag ?exn () =
   let xml_decl = "<?xml version=\"1.0\"?>\n" in
   match exn with
-  | Some exn ->
+  | Some (exn, value) ->
       sprintf
-        "%s<html xmlns=\"%s\"\nxmlns:helm=\"%s\"\nhelm:exception=\"%s\">\n"
-        xml_decl xhtml_ns helm_ns exn
+        "%s<html xmlns=\"%s\"\nxmlns:helm=\"%s\"\nhelm:exception=\"%s\"\nhelm:exception_arg=\"%s\">\n"
+        xml_decl xhtml_ns helm_ns exn value
   | None ->
       sprintf "%s<html xmlns=\"%s\"\nxmlns:helm=\"%s\">\n"
         xml_decl xhtml_ns helm_ns
@@ -317,13 +317,13 @@ let callback (req: Http_types.request) outchan =
   | Http_types.Param_not_found attr_name ->
       let msg = sprintf "Parameter '%s' is missing" attr_name in
       log_failure msg;
-      return_400 "Bad_request" msg outchan
+      return_400 ("bad_request", msg) msg outchan
   | Bad_request msg ->
       log_failure msg;
-      return_html_error "Bad_request" msg outchan
+      return_html_error ("bad_request", msg) msg outchan
   | Internal_error msg ->
       log_failure msg;
-      return_html_internal_error "Internal_error" msg outchan
+      return_html_internal_error ("internal_error", msg) msg outchan
   | Shell.Subprocess_error l ->
       let msgs =
         List.map
@@ -331,17 +331,18 @@ let callback (req: Http_types.request) outchan =
             sprintf "Command '%s' returned %s" cmd (string_of_proc_status code))
           l
       in
-      log_failure (String.concat ", " msgs);
-      return_html_internal_error "Subprocess_error"
+      let msg = String.concat ", " msgs in
+      log_failure msg;
+      return_html_internal_error ("subprocess_error", msg)
         (String.concat "<br />\n" msgs) outchan
   | exc ->
-      let msg = "Uncaught exception: " ^ (Printexc.to_string exc) in
+      let msg = "uncaught exception: " ^ (Printexc.to_string exc) in
       (match exc with
       | Http_getter_types.Key_not_found uri ->
-          return_html_error "Key_not_found" msg outchan
+          return_html_error ("key_not_found", uri) msg outchan
       | _ ->
           log_failure msg;
-          return_html_error "Uncaught_exception" msg outchan)
+          return_html_error ("uncaught_exception", msg) msg outchan)
 
     (* Main *)
 
Unnamed repository; edit this file 'description' to name the repository.