From: rich <rich>
Date: Sat, 9 Oct 2004 15:01:57 +0000 (+0000)
Subject: ErrorDocument handling.
X-Git-Url: http://git.annexia.org/?a=commitdiff_plain;ds=sidebyside;h=6821a97698542a639fbbfc5943ea0916de3a72b4;p=cocanwiki.git

ErrorDocument handling.
---

diff --git a/MANIFEST b/MANIFEST
index c062a57..6fc02ee 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -75,6 +75,7 @@ scripts/cocanwiki_version.ml.in
 scripts/contact.ml
 scripts/contact_show.ml
 scripts/contacts.ml
+scripts/crash.ml
 scripts/create_contact.ml
 scripts/create_contact_form.ml
 scripts/create_user.ml
@@ -170,6 +171,7 @@ templates/change_password_form.html
 templates/contact.txt
 templates/contact_show.html
 templates/contacts.html
+templates/crash.html
 templates/create_contact_form.html
 templates/create_user_form.html
 templates/dead_ends.html
diff --git a/cocanwiki.sql b/cocanwiki.sql
index c809326..61f301d 100644
--- a/cocanwiki.sql
+++ b/cocanwiki.sql
@@ -407,7 +407,8 @@ GRANT SELECT ON TABLE themes TO "www-data";
 
 CREATE TABLE server_settings (
     "version" integer NOT NULL,
-    stats_page text
+    stats_page text,
+    crash_email text
 );
 
 
@@ -975,9 +976,9 @@ SET search_path = public, pg_catalog;
 --
 
 COPY templates (id, title_regexp, url_regexp, extension, ordering) FROM stdin;
-1	(199[0-9]|20[0-9][0-9])/(0[1-9]|1[0-2])/(0[1-9]|1[0-9]|2[0-9]|3[01])	(199[0-9]|20[0-9][0-9])/(0[1-9]|1[0-2])/(0[1-9]|1[0-9]|2[0-9]|3[01])	calendar	10
-3	(199[0-9]|20[0-9][0-9])/(0[1-9]|1[0-2])	(199[0-9]|20[0-9][0-9])/(0[1-9]|1[0-2])	calendar	20
-4	(199[0-9]|20[0-9][0-9])	(199[0-9]|20[0-9][0-9])	calendar	30
+1	^(199[0-9]|20[0-9][0-9])/(0[1-9]|1[0-2])/(0[1-9]|1[0-9]|2[0-9]|3[01])$	^(199[0-9]|20[0-9][0-9])/(0[1-9]|1[0-2])/(0[1-9]|1[0-9]|2[0-9]|3[01])$	calendar	10
+3	^(199[0-9]|20[0-9][0-9])/(0[1-9]|1[0-2])$	^(199[0-9]|20[0-9][0-9])/(0[1-9]|1[0-2])$	calendar	20
+4	^(199[0-9]|20[0-9][0-9])$	^(199[0-9]|20[0-9][0-9])$	calendar	30
 \.
 
 
diff --git a/conf/cocanwiki.conf b/conf/cocanwiki.conf
index 1dd6854..5386ca4 100644
--- a/conf/cocanwiki.conf
+++ b/conf/cocanwiki.conf
@@ -1,5 +1,5 @@
 # Apache configuration for COCANWIKI.
-# $Id: cocanwiki.conf,v 1.11 2004/09/25 16:05:03 rich Exp $
+# $Id: cocanwiki.conf,v 1.12 2004/10/09 15:01:57 rich Exp $
 
 # Uncomment the following lines if necessary.  You will probably need
 # to adjust the paths to reflect where cocanwiki is really installed.
@@ -41,6 +41,11 @@
   ExpiresDefault "now plus 1 hour"
 </Location>
 
+# Error documents.
+ErrorDocument 500 /_bin/crash.cmo
+
+# Start of the rewrite rules.
+
 RewriteEngine on
 
 # The robots.txt file needs special treatment.
diff --git a/scripts/Makefile b/scripts/Makefile
index 2a4c710..be7ad24 100644
--- a/scripts/Makefile
+++ b/scripts/Makefile
@@ -1,5 +1,5 @@
 # Makefile for COCANWIKI.
-# $Id: Makefile,v 1.34 2004/10/09 09:41:38 rich Exp $
+# $Id: Makefile,v 1.35 2004/10/09 15:01:58 rich Exp $
 
 include ../Makefile.config
 
@@ -30,6 +30,7 @@ OBJS := change_password.cmo \
 	contact.cmo \
 	contact_show.cmo \
 	contacts.cmo \
+	crash.cmo \
 	create_contact.cmo \
 	create_contact_form.cmo \
 	create_user.cmo \
diff --git a/scripts/cocanwiki_server_settings.ml b/scripts/cocanwiki_server_settings.ml
index e8c7813..f8a7898 100644
--- a/scripts/cocanwiki_server_settings.ml
+++ b/scripts/cocanwiki_server_settings.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: cocanwiki_server_settings.ml,v 1.2 2004/09/27 09:46:00 rich Exp $
+ * $Id: cocanwiki_server_settings.ml,v 1.3 2004/10/09 15:01:58 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,19 +35,24 @@ open Printf
  * allowed to access the database.  We thus read them at the earliest
  * opportunity, in a request context, and cache the results.
  *)
-let server_settings_version, server_settings_stats_page =
-  let default = 1, None in
+let server_settings_version, server_settings_stats_page,
+    server_settings_crash_email =
+  let default = 1, None, None in
   let settings = ref None in
   let get_settings (dbh : Dbi.connection) =
-    let sth = dbh#prepare "select version, stats_page from server_settings" in
+    let sth = dbh#prepare "select version, stats_page, crash_email
+                             from server_settings" in
     sth#execute [];
     let s =
       try
 	(match sth#fetch1 () with
-	   | [ `Int version; (`String _ | `Null) as stats_page ] ->
+	   | [ `Int version; (`String _ | `Null) as stats_page;
+	       (`String _ | `Null) as crash_email ] ->
 	       let stats_page =
 		 match stats_page with `String s -> Some s | `Null -> None in
-	       version, stats_page
+	       let crash_email =
+		 match crash_email with `String s -> Some s | `Null -> None in
+	       version, stats_page, crash_email
 	   | _ -> assert false)
       with
 	  Not_found -> default in
@@ -57,7 +62,7 @@ let server_settings_version, server_settings_stats_page =
   in
 
   let server_settings_version dbh =
-    let (version, _) =
+    let (version, _, _) =
       match !settings with
 	  None -> get_settings dbh
 	| Some settings -> settings in
@@ -65,11 +70,20 @@ let server_settings_version, server_settings_stats_page =
   in
 
   let server_settings_stats_page dbh =
-    let (_, stats_page) =
+    let (_, stats_page, _) =
       match !settings with
 	  None -> get_settings dbh
 	| Some settings -> settings in
     stats_page
   in
 
-  server_settings_version, server_settings_stats_page
+  let server_settings_crash_email dbh =
+    let (_, _, crash_email) =
+      match !settings with
+	  None -> get_settings dbh
+	| Some settings -> settings in
+    crash_email
+  in
+
+  server_settings_version, server_settings_stats_page,
+  server_settings_crash_email
diff --git a/scripts/crash.ml b/scripts/crash.ml
new file mode 100644
index 0000000..2795efd
--- /dev/null
+++ b/scripts/crash.ml
@@ -0,0 +1,66 @@
+(* COCANWIKI - a wiki written in Objective CAML.
+ * Written by Richard W.M. Jones <rich@merjis.com>.
+ * Copyright (C) 2004 Merjis Ltd.
+ * $Id: crash.ml,v 1.1 2004/10/09 15:01:58 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.
+ *
+ * This script handles 500 errors through the ErrorDocument mechanism.
+ *)
+
+open Apache
+open Registry
+open Cgi
+open Printf
+
+open Cocanwiki
+open Cocanwiki_template
+open Cocanwiki_server_settings
+
+let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+  let template = get_template dbh hostid "crash.html" in
+  let crash_email = server_settings_crash_email dbh in
+
+  (* Send a feedback email to the designated address if
+   * server_settings.crash_email is set.
+   *)
+  let mail_sent =
+    match crash_email with
+	None -> false
+      | Some email ->
+	  (* Get the current time and write it into the logs. *)
+	  let time = Unix.gmtime (Unix.time ()) in
+	  let time =
+	    sprintf "%04d/%02d/%02d %02d:%02d:%02d"
+	    (time.Unix.tm_year + 1900) (time.Unix.tm_mon + 1) time.Unix.tm_mday
+	    time.Unix.tm_hour time.Unix.tm_min time.Unix.tm_sec in
+
+	  prerr_endline ("crash: " ^ time);
+
+	  let subject =
+	    "Crash notify: There was a 500 internal server error" in
+	  let body = "Crash at " ^ time ^ "\n" ^
+		     "Please see the error log for details." in
+	  Sendmail.send_mail ~subject ~body ~to_addr:[email] ();
+
+	  true in
+
+  template#conditional "mail_sent" mail_sent;
+
+  q#template template
+
+let () =
+  register_script run
diff --git a/templates/crash.html b/templates/crash.html
new file mode 100644
index 0000000..044a178
--- /dev/null
+++ b/templates/crash.html
@@ -0,0 +1,56 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+<head>
+<title>Bug!</title>
+<meta name="author" content="http://www.merjis.com/" />
+<link rel="stylesheet" href="::theme_css_html_tag::" type="text/css" title="Standard"/>
+</head><body>
+
+<h1>Bug!</h1>
+
+<p>
+We're sorry.  It looks like there's a bug in our system.
+</p>
+
+::if(mail_sent)::
+<p>
+An email has been automatically sent to the server administrator who
+will look into this.
+</p>
+::else::
+<p>
+Please help us to fix and improve the system by contacting us and
+telling us what you were doing when this bug message happened.
+</p>
+::end::
+
+<form>
+<input type="button" value="&lt;&lt; Go Back" onclick="history.go (-1)">
+</form>
+
+<ul id="topmenu" class="menu">
+<li class="first"> <a href="/">Home&nbsp;page</a> </li>
+<li> <a href="/_sitemap">Sitemap</a> </li>
+<li> <a href="/_recent">Recent&nbsp;changes</a> </li>
+</ul>
+
+<div id="menu_div">
+<ul id="bottommenu" class="menu">
+<li class="first"> <a href="/">Home&nbsp;page</a> </li>
+::table(sitemenu)::<li> <a href="/::url_html_tag::">::label_html::</a> </li>
+::end::
+<li> <a href="/_sitemap">Sitemap</a> </li>
+</ul>
+</div>
+
+<div id="footer_div">
+<hr/>
+
+<ul id="footer" class="menu">
+<li class="first"> <a href="/copyright">Copyright &copy; ::year::</a> </li>
+<li> Powered by <a href="http://sandbox.merjis.com/">::cocanwiki_package_html:: ::cocanwiki_version_html::</a> </li>
+</ul>
+</div>
+
+</body>
+</html>
\ No newline at end of file