From 6d64033b48791cf96d2d91b9fe24674c75fd0f67 Mon Sep 17 00:00:00 2001
From: rich <rich>
Date: Wed, 23 Nov 2005 11:05:54 +0000
Subject: [PATCH] UPPERCASE urls redirect to lowercase versions now.

---
 scripts/page.ml | 63 +++++++++++++++++++++++++++++++--------------------------
 1 file changed, 34 insertions(+), 29 deletions(-)

diff --git a/scripts/page.ml b/scripts/page.ml
index 325a8da..aa66aed 100644
--- a/scripts/page.ml
+++ b/scripts/page.ml
@@ -1,7 +1,7 @@
 (* COCANWIKI - a wiki written in Objective CAML.
  * Written by Richard W.M. Jones <rich@merjis.com>.
  * Copyright (C) 2004 Merjis Ltd.
- * $Id: page.ml,v 1.40 2004/11/22 11:07:32 rich Exp $
+ * $Id: page.ml,v 1.41 2005/11/23 11:05:54 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
@@ -35,7 +35,8 @@ open Cocanwiki_server_settings
 open Cocanwiki_links
 
 type fp_status = FPOK of int * string * string * Dbi.datetime * bool
-	       | FPRedirect of string
+	       | FPInternalRedirect of string
+	       | FPExternalRedirect of string
 	       | FPNotFound
 
 (* Referer strings which help us decide if the user came from
@@ -53,8 +54,7 @@ let split_qs_re = Pcre.regexp "\\?"
 let xhtml_re = Pcre.regexp "<.*?>|[^<>]+"
 
 let run r (q : cgi) (dbh : Dbi.connection) hostid
-    ({ edit_anon = edit_anon;
-       view_anon = view_anon } as host)
+    ({ edit_anon = edit_anon; view_anon = view_anon } as host)
     user =
   let page = q#param "page" in
   let page = if page = "" then "index" else page in
@@ -413,30 +413,29 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid
    * (2) Page is a redirect (fetches the name of the redirect page).
    * (3) Page not found in database, could be template or 404 error.
    *)
-  (* XXX Should do a case-insensitive matching of URLs, and if the URL differs
-   * in case only should redirect to the lowercase version.
-   *)
   let fetch_page page version allow_redirect =
     match version with
       | None ->
 	  if allow_redirect then (
 	    let sth =
 	      dbh#prepare_cached
-		"select redirect, id, title, description, last_modified_date,
-                        css is not null
-                   from pages where hostid = ? and url = ?" in
+		"select url, redirect, id, title, description,
+                        last_modified_date, css is not null
+                   from pages where hostid = ? and lower (url) = lower (?)" in
 	    sth#execute [`Int hostid; `String page];
 	    (try
 	       (match sth#fetch1 () with
-		  | [ `Null; `Int id; `String title; `String description;
-		      `Timestamp last_modified_date; `Bool has_page_css ] ->
-		      FPOK (id, title, description, last_modified_date,
-			    has_page_css)
-		  | `String redirect :: _ ->
-		      FPRedirect redirect
-		  | _ -> assert false)
+		| `String page' :: _ when page <> page' -> (* different case *)
+		    FPExternalRedirect page'
+		| [ _; `Null; `Int id; `String title; `String description;
+		    `Timestamp last_modified_date; `Bool has_page_css ] ->
+		    FPOK (id, title, description, last_modified_date,
+			  has_page_css)
+		| _ :: `String redirect :: _ ->
+		    FPInternalRedirect redirect
+		| xs -> failwith (Dbi.sdebug xs))
 	     with
-		 Not_found -> FPNotFound)
+	       Not_found -> FPNotFound)
 	  ) else (* redirects not allowed ... *) (
 	    let sth =
 	      dbh#prepare_cached
@@ -446,11 +445,11 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid
 	    sth#execute [`Int hostid; `String page];
 	    (try
 	       (match sth#fetch1 () with
-		  | [ `Int id; `String title; `String description;
-		      `Timestamp last_modified_date; `Bool has_page_css ] ->
-		      FPOK (id, title, description, last_modified_date,
-			    has_page_css)
-		  | _ -> assert false)
+		| [ `Int id; `String title; `String description;
+		    `Timestamp last_modified_date; `Bool has_page_css ] ->
+		    FPOK (id, title, description, last_modified_date,
+			  has_page_css)
+		| xs -> failwith (Dbi.sdebug xs))
 	     with
 		 Not_found -> FPNotFound)
 	  )
@@ -466,11 +465,11 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid
 			 `String page; `String page];
 	    (try
 	       (match sth#fetch1 () with
-		  | [ `Int id; `String title; `String description;
-		      `Timestamp last_modified_date; `Bool has_page_css ] ->
-		      FPOK (id, title, description, last_modified_date,
-			    has_page_css)
-		  | _ -> assert false)
+		| [ `Int id; `String title; `String description;
+		    `Timestamp last_modified_date; `Bool has_page_css ] ->
+		    FPOK (id, title, description, last_modified_date,
+			  has_page_css)
+		| xs -> failwith (Dbi.sdebug xs))
 	     with
 		 Not_found -> FPNotFound)
   in
@@ -498,8 +497,14 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid
 	    make_page title (Some description) (Some pageid)
 	      (printable_date last_modified_date) has_page_css
 	      version page page' extension
-	| FPRedirect page' ->
+	| FPInternalRedirect page' ->
 	    loop page' (i+1)
+	| FPExternalRedirect page' ->
+	    (* This normally happens when a user has request an uppercase
+	     * page name.  We redirect to the true (lowercase) version.
+	     *)
+	    q#redirect ("http://" ^ host.hostname ^ "/" ^ page');
+	    return ()
 	| FPNotFound ->
 	    (* Might be a templated page with no content in it. *)
 	    let extension = get_extension page' in
-- 
1.8.3.1