From af6c0cdc6313be8c1fbdebee9e61ce700951f101 Mon Sep 17 00:00:00 2001 From: Stefano Zacchiroli Date: Wed, 12 Mar 2003 17:05:22 +0000 Subject: [PATCH] changed interface of send_file function to enforce static type checking of its arguments --- helm/DEVEL/ocaml-http/http_daemon.ml | 18 ++++++++++++++++-- helm/DEVEL/ocaml-http/http_daemon.mli | 4 ++++ helm/DEVEL/ocaml-http/http_types.ml | 5 +++++ 3 files changed, 25 insertions(+), 2 deletions(-) diff --git a/helm/DEVEL/ocaml-http/http_daemon.ml b/helm/DEVEL/ocaml-http/http_daemon.ml index 6b2818ec1..8b71acbc8 100644 --- a/helm/DEVEL/ocaml-http/http_daemon.ml +++ b/helm/DEVEL/ocaml-http/http_daemon.ml @@ -184,9 +184,11 @@ let respond_forbidden ~url ?(version = http_version) outchan = send_empty_response "Daemon.respond_permission_denied" ~body:"" () ~version ~code:403 outchan -let send_file ?name ?file outchan = +(* let send_file ?name ?file outchan = *) +let send_file ~src outchan = let buflen = 1024 in let buf = String.make buflen ' ' in +(* let (file, cleanup) = (match (name, file) with | Some n, None -> (* if we open the file, we close it before returning *) @@ -196,6 +198,14 @@ let send_file ?name ?file outchan = | _ -> (* TODO use some static type checking *) failwith "Daemon.send_file: either name or file must be given") in +*) + let (file, cleanup) = + match src with + | FileSrc fname -> (* if we open the file, we close it before returning *) + let f = open_in fname in + f, (fun () -> close_in f) + | InChanSrc inchan -> inchan, ignore + in try while true do let bytes = input file buf 0 buflen in @@ -254,7 +264,7 @@ let respond_file ~fname ?(version = http_version) outchan = ~value:(string_of_int (Http_misc.filesize fname)) outchan; send_CRLF outchan; - send_file ~file outchan; + send_file ~src:(InChanSrc file) outchan; close_in file end with @@ -356,6 +366,10 @@ let server_of_mode = function | `Fork -> Http_tcp_server.fork | `Thread -> Http_tcp_server.thread + (* TODO what happens when a Quit exception is raised by a callback? Do other + callbacks keep on living until the end or are them all killed immediatly? + The right semantics should obviously be the first one *) + (* TODO support also chroot to 'root', not only chdir *) (* curried request *) let start diff --git a/helm/DEVEL/ocaml-http/http_daemon.mli b/helm/DEVEL/ocaml-http/http_daemon.mli index 784cc8eb9..3cc176854 100644 --- a/helm/DEVEL/ocaml-http/http_daemon.mli +++ b/helm/DEVEL/ocaml-http/http_daemon.mli @@ -49,9 +49,13 @@ val send_header: header: string -> value: string -> out_channel -> unit (** as send_header, but for a list of pairs *) val send_headers: headers:(string * string) list -> out_channel -> unit +(* (** send a file through an out_channel, file can be passed as an in_channel (if 'file' is given) or as a file name (if 'name' is given) *) val send_file: ?name:string -> ?file:in_channel -> out_channel -> unit +*) + (** send a file through an out_channel *) +val send_file: src:Http_types.file_source -> out_channel -> unit (** high level response function, respond on outchan sending: basic headers (including Content-Length computed using 'body' argument), headers probided diff --git a/helm/DEVEL/ocaml-http/http_types.ml b/helm/DEVEL/ocaml-http/http_types.ml index cae9998b3..40015e683 100644 --- a/helm/DEVEL/ocaml-http/http_types.ml +++ b/helm/DEVEL/ocaml-http/http_types.ml @@ -134,6 +134,11 @@ type status = | server_error_status ] + (** File sources *) +type file_source = + | FileSrc of string (** filename *) + | InChanSrc of in_channel (** input channel *) + (** {2 Exceptions} *) (** invalid header encountered *) -- 2.39.2