Set h1 width to 95% to avoid horizontal scrollbar.
[cocanwiki.git] / scripts / lib / cocanwiki.ml
index c2aca12..b4f6c20 100644 (file)
@@ -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: cocanwiki.ml,v 1.6 2005/11/16 10:45:41 rich Exp $
+ * $Id: cocanwiki.ml,v 1.8 2005/11/24 14:54:15 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
@@ -106,7 +106,7 @@ let register_script ?(restrict = []) ?(anonymous = true) run =
         let hostname = try Request.hostname r
         with Not_found ->
           error ~back_button:true
-            ~title:"Browser problem" q
+            ~title:"Browser problem" dbh (-1) q
             ("Your browser didn't send a \"Host\" header as part of " ^
              "the HTTP request.  Unfortunately this web server cannot " ^
              "handle HTTP requests without a \"Host\" header.");
@@ -129,7 +129,7 @@ let register_script ?(restrict = []) ?(anonymous = true) run =
         with
             Not_found ->
               error ~back_button:true
-                ~title:"Unknown website" q
+                ~title:"Unknown website" dbh (-1) q
                 ("No website called \"" ^ hostname ^ "\" can be found.  " ^
                  "If you are the administrator of this site, check that " ^
                  "the hostname is listed in the \"hostnames\" table " ^
@@ -230,12 +230,38 @@ let register_script ?(restrict = []) ?(anonymous = true) run =
         (* Call the actual CGI script. *)
         run r q dbh hostid host user
        ) else (
-        if user = Anonymous then
-          q#redirect ("http://" ^ hostname ^ "/_login")
-        else
+        if user = Anonymous then (
+          (* Not logged in and no permission to do the requested action,
+           * so redirect to the login script.  If possible set the
+           * redirect parameter so that we return to the right URL.
+           *)
+          let redirect =
+            try
+              (* If we passed through mod_rewrite, then it saved the
+               * unmodified original URL in a subprocess environment
+               * variable called SCRIPT_URL:
+               *)
+              let tbl = Request.subprocess_env r in
+              Some (Table.get tbl "SCRIPT_URL")
+            with
+              Not_found ->
+                try
+                  (* Otherwise try the ordinary uri field in request_rec. *)
+                  Some (Request.uri r)
+                with Not_found ->
+                  None in
+
+          let url =
+            "http://" ^ hostname ^ "/_login" ^
+              match redirect with
+              | None -> ""
+              | Some url -> "?redirect=" ^ Cgi_escape.escape_url url in
+          q#redirect url
+        ) else
           error ~back_button:true
             ~title:"Access denied"
-            q "You do not have permission to access this part of the site."
+            dbh hostid q
+            "You do not have permission to access this part of the site."
        )
     )