From c19ffb699f8f4681f0c7d9f59fae96f2023cd058 Mon Sep 17 00:00:00 2001 From: Stefano Zacchiroli Date: Thu, 26 Feb 2004 16:14:58 +0000 Subject: [PATCH] - better handling of temp files wrt to failures. When a temp file has been created and an exception is raised, the exception will be catched, the tempfile deleted and the exception raised again --- helm/ocaml/getter/http_getter_cache.ml | 108 ++++++++++++++---------- helm/ocaml/getter/http_getter_cache.mli | 2 + helm/ocaml/getter/http_getter_common.ml | 26 +++--- helm/ocaml/getter/http_getter_types.ml | 1 + 4 files changed, 81 insertions(+), 56 deletions(-) diff --git a/helm/ocaml/getter/http_getter_cache.ml b/helm/ocaml/getter/http_getter_cache.ml index a3f91220e..240564413 100644 --- a/helm/ocaml/getter/http_getter_cache.ml +++ b/helm/ocaml/getter/http_getter_cache.ml @@ -46,13 +46,23 @@ class threadSafe = method virtual doReader : 'a. 'a lazy_t -> 'a method virtual doWriter : 'a. 'a lazy_t -> 'a end -;; -let threadSafe = new threadSafe ;; + +let threadSafe = new threadSafe + +let finally cleanup f = + try + let res = Lazy.force f in + cleanup (); + res + with e -> + cleanup (); + raise (Http_getter_types.Cache_failure (Printexc.to_string e)) let resource_type_of_url = function | url when Pcre.pmatch ~pat:"\\.xml\\.gz$" url -> Enc_gzipped | url when Pcre.pmatch ~pat:"\\.xml$" url -> Enc_normal | url -> raise (Invalid_URL url) + let extension_of_resource_type = function | Enc_normal -> "xml" | Enc_gzipped -> "xml.gz" @@ -74,7 +84,8 @@ let respond_xml ?(enc = Enc_normal) ?(patch = true) ~url ~uri outchan = sprintf "%s%s.%s" (Lazy.force Http_getter_env.cic_dir) baseuri extension | Nuprl_uri baseuri -> (* assumption: baseuri starts with "/" *) - sprintf "%s%s.%s" (Lazy.force Http_getter_env.nuprl_dir) baseuri extension + sprintf "%s%s.%s" (Lazy.force Http_getter_env.nuprl_dir) baseuri + extension | Rdf_uri (prefix, ((Cic baseuri) as qbaseuri)) | Rdf_uri (prefix, ((Theory baseuri) as qbaseuri)) -> let escaped_prefix = @@ -110,24 +121,30 @@ let respond_xml ?(enc = Enc_normal) ?(patch = true) ~url ~uri outchan = None | Enc_normal, Enc_gzipped -> (* resource normal, cache gzipped *) let tmp = tempfile () in - wget ~output:tmp url; - gzip ~output:(basename ^ ".gz") ~keep:true tmp; (* fill cache *) - if enc = Enc_normal then (* user wants normal: don't delete it! *) - Some (tmp, enc) - else begin - Sys.remove tmp; - None - end + let (res, cleanup) = + if enc = Enc_normal then (* user wants normal: don't delete it! *) + (Some (tmp, enc), (fun () -> ())) + else + (None, (fun () -> Sys.remove tmp)) + in + finally cleanup (lazy ( + wget ~output:tmp url; + gzip ~output:(basename ^ ".gz") ~keep:true tmp; (* fill cache *) + res + )); | Enc_gzipped, Enc_normal -> (* resource gzipped, cache normal *) let tmp = tempfile () in - wget ~output:tmp url; - gunzip ~output:basename ~keep:true tmp; (* fill cache *) - if enc = Enc_gzipped then (* user wants gzipped: don't delete it! *) - Some (tmp, enc) - else begin - Sys.remove tmp; - None - end + let (res, cleanup) = + if enc = Enc_gzipped then (* user wants .gz: don't delete it! *) + (Some (tmp, enc), (fun () -> ())) + else + (None, (fun () -> Sys.remove tmp)) + in + finally cleanup (lazy ( + wget ~output:tmp url; + gunzip ~output:basename ~keep:true tmp; (* fill cache *) + res + )); end else begin debug_print "Cache HIT :-)"; None @@ -154,31 +171,33 @@ let respond_xml ?(enc = Enc_normal) ?(patch = true) ~url ~uri outchan = | None -> (* no short circuit possible, use cache *) debug_print "No short circuit available, use cache"; let tmp = tempfile () in - (match enc with - | Enc_normal -> - (* required format is normal, cached version is gzipped *) - gunzip (* gunzip to tmp *) - ~output:tmp ~keep:true (basename ^ ".gz"); - return_file ~fname:tmp ~contype ~patch_fun outchan; - | Enc_gzipped -> - (* required format is gzipped, cached version is normal *) - gzip ~output:tmp ~keep:true basename; (* gzip to tmp *) - return_file - ~fname:tmp ~contype ~contenc:"x-gzip" - ~patch_fun ~gunzip:true - outchan); - Sys.remove tmp + finally (fun () -> Sys.remove tmp) (lazy ( + (match enc with + | Enc_normal -> + (* required format is normal, cached version is gzipped *) + gunzip (* gunzip to tmp *) + ~output:tmp ~keep:true (basename ^ ".gz"); + return_file ~fname:tmp ~contype ~patch_fun outchan; + | Enc_gzipped -> + (* required format is gzipped, cached version is normal *) + gzip ~output:tmp ~keep:true basename; (* gzip to tmp *) + return_file + ~fname:tmp ~contype ~contenc:"x-gzip" + ~patch_fun ~gunzip:true + outchan) + )) | Some (fname, Enc_normal) -> (* short circuit available, use it! *) debug_print "Using short circuit (encoding = normal)"; - return_file ~fname ~contype ~patch_fun outchan; - Sys.remove fname + finally (fun () -> Sys.remove fname) (lazy ( + return_file ~fname ~contype ~patch_fun outchan + )) | Some (fname, Enc_gzipped) -> (* short circuit available, use it! *) debug_print "Using short circuit (encoding = gzipped)"; - return_file - ~fname ~contype ~contenc:"x-gzip" ~patch_fun ~gunzip:true outchan; - Sys.remove fname) + finally (fun () -> Sys.remove fname) (lazy ( + return_file ~fname ~contype ~contenc:"x-gzip" ~patch_fun + ~gunzip:true outchan + ))) )) -;; (* TODO enc is not yet supported *) let respond_xsl ?(enc = Enc_normal) ?(patch = true) ~url outchan = @@ -186,10 +205,10 @@ let respond_xsl ?(enc = Enc_normal) ?(patch = true) ~url outchan = if patch then Http_getter_common.patch_xsl else (fun x -> x) in let fname = tempfile () in - wget ~output:fname url; - return_file ~fname ~contype:"text/xml" ~patch_fun outchan; - Sys.remove fname -;; + finally (fun () -> Sys.remove fname) (lazy ( + wget ~output:fname url; + return_file ~fname ~contype:"text/xml" ~patch_fun outchan + )) (* TODO enc is not yet supported *) let respond_dtd ?(enc = Enc_normal) ?(patch = true) ~url outchan = @@ -201,11 +220,10 @@ let respond_dtd ?(enc = Enc_normal) ?(patch = true) ~url outchan = return_file ~fname:url ~contype:"text/plain" ~patch_fun outchan else return_html_error ("Can't find DTD: " ^ url) outchan -;; let clean () = let module E = Http_getter_env in List.iter (function dir -> ignore (Unix.system ("rm -rf " ^ dir ^ "/*"))) [ Lazy.force E.cic_dir; Lazy.force E.nuprl_dir; Lazy.force E.rdf_dir ] -;; + diff --git a/helm/ocaml/getter/http_getter_cache.mli b/helm/ocaml/getter/http_getter_cache.mli index 11211288a..a026e72c0 100644 --- a/helm/ocaml/getter/http_getter_cache.mli +++ b/helm/ocaml/getter/http_getter_cache.mli @@ -28,6 +28,8 @@ open Http_getter_types;; +(** all these methods could raise Http_getter_types.Cache_failure *) + val respond_xml: ?enc:encoding -> ?patch:bool -> url:string -> uri:string -> out_channel -> unit diff --git a/helm/ocaml/getter/http_getter_common.ml b/helm/ocaml/getter/http_getter_common.ml index 6ecc75f81..1ee74c103 100644 --- a/helm/ocaml/getter/http_getter_common.ml +++ b/helm/ocaml/getter/http_getter_common.ml @@ -118,17 +118,21 @@ let return_file let (tmp1, tmp2) = (Http_getter_misc.tempfile (), Http_getter_misc.tempfile ()) in - Http_getter_misc.gunzip ~keep:true ~output:tmp1 fname; (* gunzip to tmp1 *) - let new_file = open_out tmp2 in - Http_getter_misc.iter_file (* tmp2 = patch(tmp1) *) - (fun line -> output_string new_file (patch_fun line ^ "\n")) - tmp1; - close_out new_file; - Http_getter_misc.gzip ~output:tmp1 tmp2; (* tmp1 = gzip(tmp2); rm tmp2 *) - Http_getter_misc.iter_file (* send tmp1 to client as is*) - (fun line -> output_string outchan (line ^ "\n")) - tmp1; - Sys.remove tmp1 (* rm tmp1 *) + try + Http_getter_misc.gunzip ~keep:true ~output:tmp1 fname;(* gunzip to tmp1 *) + let new_file = open_out tmp2 in + Http_getter_misc.iter_file (* tmp2 = patch(tmp1) *) + (fun line -> output_string new_file (patch_fun line ^ "\n")) + tmp1; + close_out new_file; + Http_getter_misc.gzip ~output:tmp1 tmp2; (* tmp1 = gzip(tmp2); rm tmp2 *) + Http_getter_misc.iter_file (* send tmp1 to client as is*) + (fun line -> output_string outchan (line ^ "\n")) + tmp1; + Sys.remove tmp1 (* rm tmp1 *) + with e -> + Sys.remove tmp1; + raise e end else (* no need to gunzip, apply patch_fun directly to file *) Http_getter_misc.iter_file (fun line -> output_string outchan (patch_fun line ^ "\n")) diff --git a/helm/ocaml/getter/http_getter_types.ml b/helm/ocaml/getter/http_getter_types.ml index ee13c6ec6..1d8f7fcb7 100644 --- a/helm/ocaml/getter/http_getter_types.ml +++ b/helm/ocaml/getter/http_getter_types.ml @@ -32,6 +32,7 @@ exception Invalid_URI of string exception Invalid_URL of string exception Invalid_RDF_class of string exception Internal_error of string +exception Cache_failure of string type encoding = Enc_normal | Enc_gzipped type answer_format = Fmt_text | Fmt_xml -- 2.39.2