X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=scripts%2Fimage.ml;h=90d0a5acb86926a1a8861f98703e75fd5e38fff9;hb=32f71ff9f960ecb191f256a6cfc11a3f2c0c0cf7;hp=87ed9de1f3bf0658c889bcef5669f1d9227e5b62;hpb=18b15913dddbf94105c7d4e90b7b0746d2e30e2b;p=cocanwiki.git diff --git a/scripts/image.ml b/scripts/image.ml index 87ed9de..90d0a5a 100644 --- a/scripts/image.ml +++ b/scripts/image.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: image.ml,v 1.8 2004/10/15 16:03:01 rich Exp $ + * $Id: image.ml,v 1.12 2004/10/28 14:51:03 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -50,10 +50,13 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = sth#execute args; let data, mime_type, deleted = - match sth#fetch1 () with - [ `Binary data; `String mime_type; `Bool deleted ] -> - data, mime_type, deleted - | _ -> assert false in + try + (match sth#fetch1 () with + [ `Binary data; `String mime_type; `Bool deleted ] -> + data, mime_type, deleted + | _ -> assert false) + with + Not_found -> raise (HttpError cHTTP_NOT_FOUND) in (* If deleted, refuse to serve this image except if called from the * deleted images page. @@ -65,20 +68,21 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = try String.find referer "/_images?deleted"; true with String.Invalid_string -> false in - if not ok then - failwith "image.ml: bandwidth theft avoided" + if not ok then ( + prerr_endline "image.ml: bandwidth theft avoided"; + raise (HttpError cHTTP_NOT_FOUND) + ) ); - if version <> None then - (* Set a medium-length expiry time on this resource. *) - Table.set (Request.headers_out r) "Expires" (Expires.medium ()); + (* Set a medium-length expiry time on this resource. *) + Table.set (Request.headers_out r) "Expires" (Expires.medium ()); (* Content-length header. *) Table.set (Request.headers_out r) "Content-Length" (string_of_int (String.length data)); q#header ~content_type:mime_type (); - print_string r data + ignore (print_string r data) let () = register_script ~restrict:[CanView] run