X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=scripts%2Fimage.ml;h=87ed9de1f3bf0658c889bcef5669f1d9227e5b62;hb=844dcb8bb66df887e0d677359f0278f17934efad;hp=5907329e7cfbecadfdfbe1373d5b450e56fbbabe;hpb=1f125fd7a6794f352f30de71a3905d5356a07008;p=cocanwiki.git diff --git a/scripts/image.ml b/scripts/image.ml index 5907329..87ed9de 100644 --- a/scripts/image.ml +++ b/scripts/image.ml @@ -1,7 +1,22 @@ -(* COCANWIKI scripts. +(* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: image.ml,v 1.4 2004/09/09 09:35:33 rich Exp $ + * $Id: image.ml,v 1.8 2004/10/15 16:03:01 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 + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place - Suite 330, + * Boston, MA 02111-1307, USA. *) open Apache @@ -9,6 +24,8 @@ open Registry open Cgi open Printf +open ExtString + open Cocanwiki let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = @@ -19,8 +36,8 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = (* Get the image and its MIME type. *) let what = - if not is_thumbnail then "image, mime_type" - else "thumbnail, tn_mime_type" in + if not is_thumbnail then "image, mime_type, name is null as deleted" + else "thumbnail, tn_mime_type, name is null as deleted" in let where, args = match version with None -> "hostid = ? and name = ?", [`Int hostid; `String image] @@ -32,18 +49,36 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = ("select " ^ what ^ " from images where " ^ where) in sth#execute args; - let data, mime_type = + let data, mime_type, deleted = match sth#fetch1 () with - [ `Binary data; `String mime_type ] -> - data, mime_type + [ `Binary data; `String mime_type; `Bool deleted ] -> + data, mime_type, deleted | _ -> assert false in + (* If deleted, refuse to serve this image except if called from the + * deleted images page. + *) + if deleted then ( + let referer = + try Table.get (Request.headers_in r) "Referer" with Not_found -> "" in + let ok = + try String.find referer "/_images?deleted"; true + with String.Invalid_string -> false in + + if not ok then + failwith "image.ml: bandwidth theft avoided" + ); + if version <> None then (* Set a medium-length expiry time on this resource. *) - Table.set (Request.headers_out r) "Expires" (Cgi_expires.expires_medium()); + 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 let () = - register_script run + register_script ~restrict:[CanView] run