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
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
CREATE TABLE server_settings (
"version" integer NOT NULL,
- stats_page text
+ stats_page text,
+ crash_email text
);
--
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
\.
# 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.
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.
# 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
contact.cmo \
contact_show.cmo \
contacts.cmo \
+ crash.cmo \
create_contact.cmo \
create_contact_form.cmo \
create_user.cmo \
(* 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
* 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
in
let server_settings_version dbh =
- let (version, _) =
+ let (version, _, _) =
match !settings with
None -> get_settings dbh
| Some settings -> settings in
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
--- /dev/null
+(* 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
--- /dev/null
+<!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="<< Go Back" onclick="history.go (-1)">
+</form>
+
+<ul id="topmenu" class="menu">
+<li class="first"> <a href="/">Home page</a> </li>
+<li> <a href="/_sitemap">Sitemap</a> </li>
+<li> <a href="/_recent">Recent changes</a> </li>
+</ul>
+
+<div id="menu_div">
+<ul id="bottommenu" class="menu">
+<li class="first"> <a href="/">Home 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 © ::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