From e828b148d6338765d7f5ca8f10567d5d9ef00548 Mon Sep 17 00:00:00 2001 From: rich Date: Thu, 24 Nov 2005 14:54:11 +0000 Subject: [PATCH] More thorough inclusion of the page bug. This should mean the page bug appears just about everywhere, including on the admin pages. --- scripts/admin/create_host.ml | 6 +- scripts/admin/edit_host_css.ml | 7 +- scripts/admin/edit_hostnames.ml | 4 +- scripts/change_password.ml | 10 +-- scripts/contact.ml | 6 +- scripts/create_contact.ml | 14 ++-- scripts/create_user.ml | 10 +-- scripts/delete_contact.ml | 4 +- scripts/delete_file.ml | 4 +- scripts/delete_image.ml | 4 +- scripts/delete_user.ml | 6 +- scripts/delete_user_form.ml | 4 +- scripts/edit.ml | 11 +-- scripts/edit_contact.ml | 14 ++-- scripts/edit_file.ml | 4 +- scripts/edit_host_css.ml | 7 +- scripts/edit_host_settings.ml | 4 +- scripts/edit_image.ml | 11 +-- scripts/edit_page_css.ml | 7 +- scripts/edit_sitemenu.ml | 4 +- scripts/edit_user.ml | 16 ++-- scripts/email_change.ml | 7 +- scripts/forgot_password.ml | 9 ++- scripts/invite_user.ml | 4 +- scripts/invite_user_confirm.ml | 8 +- scripts/invite_user_confirm_form.ml | 9 ++- scripts/lib/cocanwiki.ml | 9 ++- scripts/lib/cocanwiki_ok.ml | 14 ++-- scripts/lib/cocanwiki_template.ml | 148 ++++++++++++++++++++---------------- scripts/login.ml | 7 +- scripts/logout.ml | 6 +- scripts/mail_import.ml | 11 +-- scripts/mail_rebuild.ml | 4 +- scripts/mailing_list_confirm.ml | 9 ++- scripts/mailing_list_send.ml | 13 ++-- scripts/mailing_list_unsubscribe.ml | 4 +- scripts/page.ml | 7 +- scripts/page_email_confirm.ml | 10 ++- scripts/page_email_send.ml | 13 ++-- scripts/page_email_unsubscribe.ml | 4 +- scripts/rename_page.ml | 22 +++--- scripts/restore.ml | 4 +- scripts/restore_form.ml | 4 +- scripts/send_feedback.ml | 4 +- scripts/set_password.ml | 6 +- scripts/signup.ml | 18 +++-- scripts/source.ml | 4 +- scripts/undelete_file.ml | 4 +- scripts/undelete_image.ml | 4 +- scripts/upload_file.ml | 13 ++-- scripts/upload_image.ml | 38 ++++----- scripts/user_prefs.ml | 5 +- templates/footer.html | 2 + templates/ok_error.html | 2 + 54 files changed, 319 insertions(+), 264 deletions(-) diff --git a/scripts/admin/create_host.ml b/scripts/admin/create_host.ml index 5ba2ea0..3d0a03a 100644 --- a/scripts/admin/create_host.ml +++ b/scripts/admin/create_host.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: create_host.ml,v 1.9 2005/03/31 14:24:04 rich Exp $ + * $Id: create_host.ml,v 1.10 2005/11/24 14:54:14 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 @@ -45,7 +45,7 @@ let run r = let title = trim title in if title = "" then ( Cocanwiki_ok.error ~back_button:true ~title:"Bad title" - q "You must give a title for this Wiki."; + dbh (-1) q "You must give a title for this Wiki."; ) else ( (* In theory we could verify characters in hostnames. However * it's probably best to assume the sysadmin knows what they're up to @@ -82,7 +82,7 @@ let run r = ] in Cocanwiki_ok.ok ~title:"Wiki created" ~buttons - q "A new Wiki was created." + dbh (-1) q "A new Wiki was created." ) let () = diff --git a/scripts/admin/edit_host_css.ml b/scripts/admin/edit_host_css.ml index d3257fb..abf26c1 100644 --- a/scripts/admin/edit_host_css.ml +++ b/scripts/admin/edit_host_css.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: edit_host_css.ml,v 1.6 2005/03/31 14:24:04 rich Exp $ + * $Id: edit_host_css.ml,v 1.7 2005/11/24 14:54:14 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 @@ -55,8 +55,9 @@ let run r (q : cgi) (dbh : Dbi.connection) _ _ _ = ] in ok ~title:"Stylesheet changed" ~buttons - q ("The stylesheet was changed successfully. " ^ - "Note: You must RELOAD the page to see changes to stylesheets.") + dbh (-1) q + ("The stylesheet was changed successfully. " ^ + "Note: You must RELOAD the page to see changes to stylesheets.") let () = register_script run diff --git a/scripts/admin/edit_hostnames.ml b/scripts/admin/edit_hostnames.ml index ece222a..9d8bbfb 100644 --- a/scripts/admin/edit_hostnames.ml +++ b/scripts/admin/edit_hostnames.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: edit_hostnames.ml,v 1.7 2005/03/31 14:24:04 rich Exp $ + * $Id: edit_hostnames.ml,v 1.8 2005/11/24 14:54:14 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 @@ -87,7 +87,7 @@ let run r (q : cgi) (dbh : Dbi.connection) _ host' _ = ] in ok ~title:"Saved" ~buttons - q "Hostnames updated." + dbh (-1) q "Hostnames updated." let () = register_script run diff --git a/scripts/change_password.ml b/scripts/change_password.ml index fcb561f..37d92aa 100644 --- a/scripts/change_password.ml +++ b/scripts/change_password.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: change_password.ml,v 1.3 2004/10/30 10:16:09 rich Exp $ + * $Id: change_password.ml,v 1.4 2005/11/24 14:54:11 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 @@ -49,7 +49,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ user = if not old_password_ok then ( error ~title:"Bad password" ~back_button:true - q "The password you gave is wrong."; + dbh hostid q "The password you gave is wrong."; return () ); @@ -58,13 +58,13 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ user = if password1 = "" || password2 = "" then ( error ~back_button:true ~title:"Bad password" - q "The password you gave is empty."; + dbh hostid q "The password you gave is empty."; return () ); if password1 <> password2 then ( error ~back_button:true ~title:"Passwords don't match" - q "The two passwords you gave aren't identical."; + dbh hostid q "The two passwords you gave aren't identical."; return () ); @@ -81,7 +81,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ user = let buttons = [ ok_button "/" ] in ok ~buttons ~title:"Password changed" - q "The password was changed." + dbh hostid q "The password was changed." let () = register_script ~anonymous:false run diff --git a/scripts/contact.ml b/scripts/contact.ml index 3dd454b..4ec8e5e 100644 --- a/scripts/contact.ml +++ b/scripts/contact.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: contact.ml,v 1.8 2005/03/31 14:24:04 rich Exp $ + * $Id: contact.ml,v 1.9 2005/11/24 14:54:11 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,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = let fail msg = error ~back_button:true ~title:"Bad form" - q (msg ^ " Please contact the owner of the site by email."); + dbh hostid q (msg ^ " Please contact the owner of the site by email."); return () in @@ -153,7 +153,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = (* Confirm. *) ok ~title:"Thank you for your contact" ~buttons:[ok_button "/"] - q "An email was sent and you should receive a reply shortly." + dbh hostid q "An email was sent and you should receive a reply shortly." let () = register_script ~restrict:[CanView] run diff --git a/scripts/create_contact.ml b/scripts/create_contact.ml index d31be0d..17e70f8 100644 --- a/scripts/create_contact.ml +++ b/scripts/create_contact.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: create_contact.ml,v 1.4 2005/11/17 10:14:42 rich Exp $ + * $Id: create_contact.ml,v 1.5 2005/11/24 14:54:11 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 @@ -41,20 +41,22 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = if name = "" then ( error ~back_button:true ~title:"Name field missing" - q "You must name your contact form."; + dbh hostid q "You must name your contact form."; return () ); if subject = "" then ( error ~back_button:true ~title:"Subject line missing" - q "You must give a subject line, which appears on contact emails."; + dbh hostid q + "You must give a subject line, which appears on contact emails."; return () ); if emails = [] then ( error ~back_button:true ~title:"No email addresses" - q ("There are no email addresses listed for this contact form. You " ^ - "must list at least one valid email address."); + dbh hostid q + ("There are no email addresses listed for this contact form. You " ^ + "must list at least one valid email address."); return () ); @@ -80,7 +82,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = Template.StdPages.method_ = None; Template.StdPages.params = [ "id", string_of_int contactid ] } ] in - ok ~title:"Contact form created" ~buttons q msg + ok ~title:"Contact form created" ~buttons dbh hostid q msg let () = register_script ~restrict:[CanManageContacts] run diff --git a/scripts/create_user.ml b/scripts/create_user.ml index b8b8e6c..1f5bc5a 100644 --- a/scripts/create_user.ml +++ b/scripts/create_user.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: create_user.ml,v 1.5 2004/10/23 09:36:11 rich Exp $ + * $Id: create_user.ml,v 1.6 2005/11/24 14:54:11 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,13 +35,13 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = if username = "" || password1 = "" || password2 = "" then ( error ~back_button:true ~title:"Bad username or password" - q "The username or password you gave is empty."; + dbh hostid q "The username or password you gave is empty."; return () ); if password1 <> password2 then ( error ~back_button:true ~title:"Passwords don't match" - q "The two passwords you gave aren't identical."; + dbh hostid q "The two passwords you gave aren't identical."; return () ); @@ -60,7 +60,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = (try sth#fetch1 (); error ~back_button:true ~title:"Username already taken" - q "Someone has already taken that username."; + dbh hostid q "Someone has already taken that username."; return () with Not_found -> ()); @@ -91,7 +91,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = let buttons = [ ok_button "/_users" ] in ok ~title:"Account created" ~buttons - q ("An account was created for " ^ username ^ ".") + dbh hostid q ("An account was created for " ^ username ^ ".") let () = register_script ~restrict:[CanManageUsers] run diff --git a/scripts/delete_contact.ml b/scripts/delete_contact.ml index 563bc02..54c4538 100644 --- a/scripts/delete_contact.ml +++ b/scripts/delete_contact.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: delete_contact.ml,v 1.3 2005/11/23 11:32:13 rich Exp $ + * $Id: delete_contact.ml,v 1.4 2005/11/24 14:54:11 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 @@ -64,7 +64,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } _ = dbh#commit (); ok ~title:"Contact form(s) deleted" ~buttons:[ok_button "/_bin/contacts.cmo"] - q "Those contact form(s) were deleted." + dbh hostid q "Those contact form(s) were deleted." let () = register_script ~restrict:[CanManageContacts] run diff --git a/scripts/delete_file.ml b/scripts/delete_file.ml index 209afc6..77401e0 100644 --- a/scripts/delete_file.ml +++ b/scripts/delete_file.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: delete_file.ml,v 1.8 2004/11/01 17:05:14 rich Exp $ + * $Id: delete_file.ml,v 1.9 2005/11/24 14:54:11 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 @@ -59,7 +59,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } user= (* Done. *) let buttons = [ ok_button "/_files" ] in ok ~title:"File deleted" ~buttons - q "File was deleted successfully." + dbh hostid q "File was deleted successfully." ) else q#redirect ("http://" ^ hostname ^ "/_files") diff --git a/scripts/delete_image.ml b/scripts/delete_image.ml index ee62ea2..93ae79e 100644 --- a/scripts/delete_image.ml +++ b/scripts/delete_image.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: delete_image.ml,v 1.8 2004/11/01 17:05:14 rich Exp $ + * $Id: delete_image.ml,v 1.9 2005/11/24 14:54:11 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 @@ -59,7 +59,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } user= (* Done. *) let buttons = [ ok_button "/_images" ] in ok ~title:"Image deleted" ~buttons - q "Image was deleted successfully." + dbh hostid q "Image was deleted successfully." ) else q#redirect ("http://" ^ hostname ^ "/_images") diff --git a/scripts/delete_user.ml b/scripts/delete_user.ml index bcb52c6..da705f5 100644 --- a/scripts/delete_user.ml +++ b/scripts/delete_user.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: delete_user.ml,v 1.4 2004/10/30 10:16:10 rich Exp $ + * $Id: delete_user.ml,v 1.5 2005/11/24 14:54:11 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 @@ -50,7 +50,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} self = match self with | User (id, _, _, _) when id = userid -> error ~back_button:true ~title:"Delete own account" - q "You cannot delete your own user account."; + dbh hostid q "You cannot delete your own user account."; return () | _ -> () in @@ -80,7 +80,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} self = dbh#commit (); ok ~title:"Account deleted" ~buttons:[ok_button "/_users"] - q "That user account was deleted." + dbh hostid q "That user account was deleted." let () = register_script ~restrict:[CanManageUsers] run diff --git a/scripts/delete_user_form.ml b/scripts/delete_user_form.ml index 7924d01..0c7a9a1 100644 --- a/scripts/delete_user_form.ml +++ b/scripts/delete_user_form.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: delete_user_form.ml,v 1.3 2004/10/30 10:16:10 rich Exp $ + * $Id: delete_user_form.ml,v 1.4 2005/11/24 14:54:11 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 @@ -39,7 +39,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ self = match self with | User (id, _, _, _) when id = userid -> error ~back_button:true ~title:"Delete own account" - q "You cannot delete your own user account."; + dbh hostid q "You cannot delete your own user account."; return () | _ -> () in diff --git a/scripts/edit.ml b/scripts/edit.ml index 8b44823..4e9996f 100644 --- a/scripts/edit.ml +++ b/scripts/edit.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: edit.ml,v 1.26 2005/03/31 14:24:04 rich Exp $ + * $Id: edit.ml,v 1.27 2005/11/24 14:54:11 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 @@ -272,7 +272,8 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = return () | Wikilib.GenURL_TooShort | Wikilib.GenURL_BadURL -> error ~back_button:true ~title:"Bad page name" - q "The page name supplied is too short or invalid."; + dbh hostid q + "The page name supplied is too short or invalid."; return () in let model = match pt with @@ -352,8 +353,8 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = with SaveURLError -> error ~back_button:true ~title:"Page exists" - q ("While you were editing that page, it looks " ^ - "like another user created the same page."); + dbh hostid q ("While you were editing that page, it looks " ^ + "like another user created the same page."); return () | SaveConflict (new_version, old_version, url, css) -> @@ -459,7 +460,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = return () in - (* This codes decides where we are in the current editing cycle. + (* This code decides where we are in the current editing cycle. * * Inputs: * id - if set, then we are in the midst of editing a page. diff --git a/scripts/edit_contact.ml b/scripts/edit_contact.ml index 8fe5551..46002f9 100644 --- a/scripts/edit_contact.ml +++ b/scripts/edit_contact.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: edit_contact.ml,v 1.3 2005/03/31 14:24:04 rich Exp $ + * $Id: edit_contact.ml,v 1.4 2005/11/24 14:54:11 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 @@ -44,20 +44,22 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = if name = "" then ( error ~back_button:true ~title:"Name field missing" - q "You must name your contact form."; + dbh hostid q "You must name your contact form."; return () ); if subject = "" then ( error ~back_button:true ~title:"Subject line missing" - q "You must give a subject line, which appears on contact emails."; + dbh hostid q + "You must give a subject line, which appears on contact emails."; return () ); if emails = [] then ( error ~back_button:true ~title:"No email addresses" - q ("There are no email addresses listed for this contact form. You " ^ - "must list at least one valid email address."); + dbh hostid q + ("There are no email addresses listed for this contact form. You " ^ + "must list at least one valid email address."); return () ); @@ -92,7 +94,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = Template.StdPages.method_ = None; Template.StdPages.params = [ "id", string_of_int id ] } ] in ok ~title:"Contact form edited" ~buttons - q "The contact form was edited." + dbh hostid q "The contact form was edited." let () = register_script ~restrict:[CanManageContacts] run diff --git a/scripts/edit_file.ml b/scripts/edit_file.ml index 664a7ab..230e1ed 100644 --- a/scripts/edit_file.ml +++ b/scripts/edit_file.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: edit_file.ml,v 1.2 2005/07/19 08:58:39 rich Exp $ + * $Id: edit_file.ml,v 1.3 2005/11/24 14:54:11 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 @@ -55,7 +55,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = let buttons = [ ok_button "/_files" ] in ok ~title:"Description fields updated" ~buttons - q "The description fields were updated." + dbh hostid q "The description fields were updated." let () = register_script ~restrict:[CanEdit] run diff --git a/scripts/edit_host_css.ml b/scripts/edit_host_css.ml index 8f7afc4..790486b 100644 --- a/scripts/edit_host_css.ml +++ b/scripts/edit_host_css.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: edit_host_css.ml,v 1.4 2005/03/31 14:24:04 rich Exp $ + * $Id: edit_host_css.ml,v 1.5 2005/11/24 14:54:11 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 @@ -50,8 +50,9 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = ] in ok ~title:"Global stylesheet changed" ~buttons - q ("The stylesheet was changed successfully. " ^ - "Note: You must RELOAD the page to see changes to stylesheets.") + dbh hostid q + ("The stylesheet was changed successfully. " ^ + "Note: You must RELOAD the page to see changes to stylesheets.") let () = register_script ~restrict:[CanEditGlobalCSS] run diff --git a/scripts/edit_host_settings.ml b/scripts/edit_host_settings.ml index 2bb8a01..e8bbebf 100644 --- a/scripts/edit_host_settings.ml +++ b/scripts/edit_host_settings.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: edit_host_settings.ml,v 1.8 2005/11/16 17:30:33 rich Exp $ + * $Id: edit_host_settings.ml,v 1.9 2005/11/24 14:54:11 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 @@ -83,7 +83,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } _ = (* Finish off. *) ok ~title:"Global settings updated" ~buttons:[ok_button "/_bin/host_menu.cmo"] - q "The global settings were updated." + dbh hostid q "The global settings were updated." let () = register_script ~restrict:[CanManageSite] run diff --git a/scripts/edit_image.ml b/scripts/edit_image.ml index 0d2e6c0..9760a3d 100644 --- a/scripts/edit_image.ml +++ b/scripts/edit_image.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: edit_image.ml,v 1.2 2005/07/19 08:58:39 rich Exp $ + * $Id: edit_image.ml,v 1.3 2005/11/24 14:54:11 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 @@ -41,9 +41,10 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = (* Check some ALT text was supplied. *) if string_is_whitespace alt then ( error ~title:"Missing Alt text" ~back_button:true - q ("You must supply Alt text describing the image. This is required " ^ - "by accessibility laws and to allow search engines to discover the " ^ - "content of images."); + dbh hostid q + ("You must supply Alt text describing the image. This is required " ^ + "by accessibility laws and to allow search engines to discover the " ^ + "content of images."); return () ); @@ -72,7 +73,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = let buttons = [ ok_button "/_images" ] in ok ~title:"Description fields updated" ~buttons - q "The description fields were updated." + dbh hostid q "The description fields were updated." let () = register_script ~restrict:[CanEdit] run diff --git a/scripts/edit_page_css.ml b/scripts/edit_page_css.ml index 4338bc4..6937665 100644 --- a/scripts/edit_page_css.ml +++ b/scripts/edit_page_css.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: edit_page_css.ml,v 1.17 2005/11/17 10:14:42 rich Exp $ + * $Id: edit_page_css.ml,v 1.18 2005/11/24 14:54:11 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 @@ -107,8 +107,9 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = Template.StdPages.method_ = None; Template.StdPages.params = [ "page", page ] } ] in ok ~title:"Stylesheet changed" ~buttons - q ("The stylesheet was changed successfully. " ^ - "Note: You must RELOAD the page to see changes to stylesheets.") + dbh hostid q + ("The stylesheet was changed successfully. " ^ + "Note: You must RELOAD the page to see changes to stylesheets.") let () = register_script ~restrict:[CanEdit] run diff --git a/scripts/edit_sitemenu.ml b/scripts/edit_sitemenu.ml index f4986ca..676b0b3 100644 --- a/scripts/edit_sitemenu.ml +++ b/scripts/edit_sitemenu.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: edit_sitemenu.ml,v 1.8 2004/12/01 13:55:55 rich Exp $ + * $Id: edit_sitemenu.ml,v 1.9 2005/11/24 14:54:11 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 @@ -277,7 +277,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } user= let buttons = [ ok_button "/_bin/host_menu.cmo" ] in ok ~title:"Saved" ~buttons - q "The site menu was saved." + dbh hostid q "The site menu was saved." ); no_errors diff --git a/scripts/edit_user.ml b/scripts/edit_user.ml index b46b905..d9cb59c 100644 --- a/scripts/edit_user.ml +++ b/scripts/edit_user.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: edit_user.ml,v 1.9 2004/10/30 10:16:10 rich Exp $ + * $Id: edit_user.ml,v 1.10 2005/11/24 14:54:12 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 @@ -44,7 +44,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ self = if original_name <> name then ( if name = "" then ( error ~back_button:true ~title:"Bad username" - q "The username you gave is empty."; + dbh hostid q "The username you gave is empty."; return () ); @@ -56,7 +56,8 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ self = (try sth#fetch1 (); error ~back_button:true ~title:"Username already taken" - q ("That username has already been taken by another user."); + dbh hostid q + ("That username has already been taken by another user."); return () with Not_found -> ()); @@ -78,9 +79,10 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ self = (match can_manage_users, self with | false, User (id, _, _, _) when id = userid -> error ~back_button:true ~title:"Remove manage users from self" - q ("You tried to remove 'Manage users' permission from yourself. "^ - "You can't do this. You'll have to do it from another "^ - "user account."); + dbh hostid q + ("You tried to remove 'Manage users' permission from yourself. " ^ + "You can't do this. You'll have to do it from another " ^ + "user account."); return () | _ -> ()); @@ -101,7 +103,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ self = let buttons = [ ok_button "/_users" ] in ok ~buttons ~title:"Saved" - q "Changes were saved." + dbh hostid q "Changes were saved." let () = register_script ~restrict:[CanManageUsers] run diff --git a/scripts/email_change.ml b/scripts/email_change.ml index 702bee8..fe7e798 100644 --- a/scripts/email_change.ml +++ b/scripts/email_change.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: email_change.ml,v 1.1 2004/10/23 15:00:14 rich Exp $ + * $Id: email_change.ml,v 1.2 2005/11/24 14:54:12 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 @@ -43,7 +43,8 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = with Not_found -> error ~title:"Already verified" - q ("It looks like you have already verified this email address."); + dbh hostid q + ("It looks like you have already verified this email address."); return () in (* Update the database. *) @@ -57,7 +58,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = dbh#commit (); ok ~title:"Email address verified" - q "Thank you for verifying your new email address." + dbh hostid q "Thank you for verifying your new email address." let () = register_script run diff --git a/scripts/forgot_password.ml b/scripts/forgot_password.ml index 88a4833..f496944 100644 --- a/scripts/forgot_password.ml +++ b/scripts/forgot_password.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: forgot_password.ml,v 1.7 2005/03/31 14:24:04 rich Exp $ + * $Id: forgot_password.ml,v 1.8 2005/11/24 14:54:12 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 @@ -33,7 +33,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } _ = if name = "" then ( error ~back_button:true ~title:"No username or email address" - q "You didn't give a username or email address"; + dbh hostid q "You didn't give a username or email address"; return () ); @@ -69,7 +69,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } _ = let buttons = [ ok_button "/_login" ] in ok ~buttons ~title:"Password sent by email" - q + dbh hostid q ("Your password was sent by email. If you don't receive the password " ^ "within an hour, please notify the site's administrator.") with @@ -80,7 +80,8 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } _ = Unix.sleep 10; error ~back_button:true ~title:"Nothing known" - q "Sorry, don't know anyone with that name or email address." + dbh hostid q + "Sorry, don't know anyone with that name or email address." let () = register_script run diff --git a/scripts/invite_user.ml b/scripts/invite_user.ml index 8ca0d8f..add0bdb 100644 --- a/scripts/invite_user.ml +++ b/scripts/invite_user.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: invite_user.ml,v 1.4 2005/03/31 14:24:04 rich Exp $ + * $Id: invite_user.ml,v 1.5 2005/11/24 14:54:12 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 run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = let buttons = [ ok_button "/_users" ] in ok ~buttons ~title:"Invitation emails sent" - q "We sent invitations emails to those address(es)." + dbh hostid q "We sent invitations emails to those address(es)." let () = register_script ~restrict:[CanManageUsers] ~anonymous:false run diff --git a/scripts/invite_user_confirm.ml b/scripts/invite_user_confirm.ml index ad51a49..691aaed 100644 --- a/scripts/invite_user_confirm.ml +++ b/scripts/invite_user_confirm.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: invite_user_confirm.ml,v 1.3 2005/03/31 14:24:04 rich Exp $ + * $Id: invite_user_confirm.ml,v 1.4 2005/11/24 14:54:12 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 @@ -49,7 +49,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } _ = | _ -> assert false with Not_found -> error ~title:"Already signed up" - q "It looks like you have already used your invitation."; + dbh hostid q "It looks like you have already used your invitation."; return () in let password1 = q#param "password1" in @@ -57,13 +57,13 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } _ = if password1 = "" || password2 = "" then ( error ~back_button:true ~title:"Bad password" - q "The password you gave is empty."; + dbh hostid q "The password you gave is empty."; return () ); if password1 <> password2 then ( error ~back_button:true ~title:"Passwords don't match" - q "The two passwords you gave aren't identical."; + dbh hostid q "The two passwords you gave aren't identical."; return () ); diff --git a/scripts/invite_user_confirm_form.ml b/scripts/invite_user_confirm_form.ml index a61726d..456e720 100644 --- a/scripts/invite_user_confirm_form.ml +++ b/scripts/invite_user_confirm_form.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: invite_user_confirm_form.ml,v 1.2 2004/10/23 15:00:15 rich Exp $ + * $Id: invite_user_confirm_form.ml,v 1.3 2005/11/24 14:54:12 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 @@ -43,9 +43,10 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = with Not_found -> error ~title:"Already signed up" - q ("It looks like you have already used your invitation. If " ^ - "you cannot get to your account, please contact the " ^ - "administrator."); + dbh hostid q + ("It looks like you have already used your invitation. If " ^ + "you cannot get to your account, please contact the " ^ + "administrator."); return () in (* Update the template so that the user can set their preferred password. *) diff --git a/scripts/lib/cocanwiki.ml b/scripts/lib/cocanwiki.ml index 88a7e44..b4f6c20 100644 --- a/scripts/lib/cocanwiki.ml +++ b/scripts/lib/cocanwiki.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: cocanwiki.ml,v 1.7 2005/11/21 15:28:36 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 " ^ @@ -260,7 +260,8 @@ let register_script ?(restrict = []) ?(anonymous = true) run = ) 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." ) ) diff --git a/scripts/lib/cocanwiki_ok.ml b/scripts/lib/cocanwiki_ok.ml index 4a1ca08..7415688 100644 --- a/scripts/lib/cocanwiki_ok.ml +++ b/scripts/lib/cocanwiki_ok.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: cocanwiki_ok.ml,v 1.2 2005/03/31 14:24:05 rich Exp $ + * $Id: cocanwiki_ok.ml,v 1.3 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 @@ -29,18 +29,18 @@ open Cocanwiki_template (* Override Template.StdPages.ok and Template.StdPages.error with our versions. * Also have some standard buttons around. *) -let ok_error_template = _get_template "ok_error.html" - let error ?cookie ?cookies ?title ?(icon = "/_graphics/error.png") - ?icon_alt ?back_button ?close_button q message = + ?icon_alt ?back_button ?close_button dbh hostid q message = + let template = get_template dbh hostid "ok_error.html" in (* Set the status so scripts can determine if the request failed. *) Request.set_status q#request cHTTP_BAD_REQUEST; - Template.StdPages.error ?cookie ?cookies ~template:ok_error_template + Template.StdPages.error ?cookie ?cookies ~template ?title ~icon ?icon_alt ?back_button ?close_button q message let ok ?cookie ?cookies ?title ?(icon = "/_graphics/ok.png") - ?icon_alt ?back_button ?close_button ?buttons q message = - Template.StdPages.ok ?cookie ?cookies ~template:ok_error_template + ?icon_alt ?back_button ?close_button ?buttons dbh hostid q message = + let template = get_template dbh hostid "ok_error.html" in + Template.StdPages.ok ?cookie ?cookies ~template ?title ~icon ?icon_alt ?back_button ?close_button ?buttons q message let ok_button url = { Template.StdPages.label = " OK "; diff --git a/scripts/lib/cocanwiki_template.ml b/scripts/lib/cocanwiki_template.ml index 9b562a8..e7189c7 100644 --- a/scripts/lib/cocanwiki_template.ml +++ b/scripts/lib/cocanwiki_template.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: cocanwiki_template.ml,v 1.4 2005/11/16 17:30:34 rich Exp $ + * $Id: cocanwiki_template.ml,v 1.5 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 @@ -80,30 +80,31 @@ let _get_template filename = let get_template ?page (dbh : Dbi.connection) hostid filename = let template = _get_template filename in - (* Get standard fields concerning this host from the database. *) - let sth = - dbh#prepare_cached - "select h.theme_css, p.name, p.url, h.search_box, - h.brand, h.brand_tagline, h.brand_description, - h.pagebug - from hosts h left outer join powered_by p on h.powered_by = p.id - where h.id = ?" in - sth#execute [`Int hostid]; - - let theme_css, powered_by_name, powered_by_url, search_box, + if hostid > 0 then ( + (* Get standard fields concerning this host from the database. *) + let sth = + dbh#prepare_cached + "select h.theme_css, p.name, p.url, h.search_box, + h.brand, h.brand_tagline, h.brand_description, + h.pagebug + from hosts h left outer join powered_by p on h.powered_by = p.id + where h.id = ?" in + sth#execute [`Int hostid]; + + let theme_css, powered_by_name, powered_by_url, search_box, brand, brand_tagline, brand_description, pagebug = - match sth#fetch1 () with + match sth#fetch1 () with | [ a; b; c; d; e; f; g; h] -> a, b, c, d, e, f, g, h | _ -> assert false in - let theme_css = - match theme_css with + let theme_css = + match theme_css with | `Null -> "/_css/standard.css" | `String file -> file | _ -> assert false in - let powered_by_name, powered_by_url = - match powered_by_name, powered_by_url with + let powered_by_name, powered_by_url = + match powered_by_name, powered_by_url with | `Null, `Null -> let url = "http://sandbox.merjis.com/" in let name = Cocanwiki_version.package ^ " " ^ @@ -112,75 +113,92 @@ let get_template ?page (dbh : Dbi.connection) hostid filename = | `String name, `String url -> name, url | _ -> assert false in - let search_box = match search_box with `Bool b -> b | _ -> assert false in + let search_box = match search_box with `Bool b -> b | _ -> assert false in - let branding, brand, + let branding, brand, has_brand_tagline, brand_tagline, has_brand_description, brand_description = - match brand with + match brand with | `Null -> false, "", false, "", false, "" | `String brand -> let has_brand_tagline, brand_tagline = match brand_tagline with - | `Null -> false, "" - | `String s -> true, s - | _ -> assert false in + | `Null -> false, "" + | `String s -> true, s + | _ -> assert false in let has_brand_description, brand_description = match brand_description with - | `Null -> false, "" - | `String s -> true, s - | _ -> assert false in + | `Null -> false, "" + | `String s -> true, s + | _ -> assert false in true, brand, - has_brand_tagline, brand_tagline, - has_brand_description, brand_description + has_brand_tagline, brand_tagline, + has_brand_description, brand_description | _ -> assert false in - let has_pagebug, pagebug = - match pagebug with - | `Null -> false, "" - | `String pagebug -> true, pagebug - | _ -> assert false in - - template#set "theme_css" theme_css; - template#set "powered_by_name" powered_by_name; - template#set "powered_by_url" powered_by_url; - template#conditional "search_box" search_box; - template#conditional "branding" branding; - template#set "brand" brand; - template#conditional "has_brand_tagline" has_brand_tagline; - template#set "brand_tagline" brand_tagline; - template#conditional "has_brand_description" has_brand_description; - template#set "brand_description" brand_description; - template#conditional "has_pagebug" has_pagebug; - template#set "pagebug" pagebug; - - (* Site menu. *) - let sth = dbh#prepare_cached "select url, label, ordering from sitemenu - where hostid = ? order by ordering" in - sth#execute [`Int hostid]; - - let is_homepage = - match page with + let has_pagebug, pagebug = + match pagebug with + | `Null -> false, "" + | `String pagebug -> true, pagebug + | _ -> assert false in + + template#set "theme_css" theme_css; + template#set "powered_by_name" powered_by_name; + template#set "powered_by_url" powered_by_url; + template#conditional "search_box" search_box; + template#conditional "branding" branding; + template#set "brand" brand; + template#conditional "has_brand_tagline" has_brand_tagline; + template#set "brand_tagline" brand_tagline; + template#conditional "has_brand_description" has_brand_description; + template#set "brand_description" brand_description; + template#conditional "has_pagebug" has_pagebug; + template#set "pagebug" pagebug; + + (* Site menu. *) + let sth = dbh#prepare_cached "select url, label, ordering from sitemenu + where hostid = ? order by ordering" in + sth#execute [`Int hostid]; + + let is_homepage = + match page with | None -> false | Some "index" -> true | _ -> false in - template#conditional "is_homepage" is_homepage; + template#conditional "is_homepage" is_homepage; - let table = sth#map (function [`String url; `String label; _] -> - let is_linked = - match page with + let table = sth#map (function [`String url; `String label; _] -> + let is_linked = + match page with | None -> true | Some page when page = url -> false | _ -> true in - let id = id_of_url url in - [ "url", Template.VarString url; - "label", Template.VarString label; - "is_linked", Template.VarConditional is_linked; - "id", Template.VarString id ] + let id = id_of_url url in + [ "url", Template.VarString url; + "label", Template.VarString label; + "is_linked", Template.VarConditional is_linked; + "id", Template.VarString id ] | _ -> assert false) in - template#table "sitemenu" table; - + template#table "sitemenu" table; + ) + else (* if we have no hostid *) ( + template#set "theme_css" "/_css/standard.css"; + template#set "powered_by_name" (Cocanwiki_version.package ^ " " ^ + Cocanwiki_version.version); + template#set "powered_by_url" "http://sandbox.merjis.com/"; + template#conditional "search_box" false; + template#conditional "branding" false; + template#set "brand" ""; + template#conditional "has_brand_tagline" false; + template#set "brand_tagline" ""; + template#conditional "has_brand_description" false; + template#set "brand_description" ""; + template#conditional "has_pagebug" false; + template#set "pagebug" ""; + template#conditional "is_homepage" false; + template#table "sitemenu" []; + ); (* Copyright year. *) template#set "year" (string_of_int year); diff --git a/scripts/login.ml b/scripts/login.ml index 4594e6b..95d615c 100644 --- a/scripts/login.ml +++ b/scripts/login.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: login.ml,v 1.7 2005/11/21 15:28:35 rich Exp $ + * $Id: login.ml,v 1.8 2005/11/24 14:54:12 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 @@ -77,7 +77,8 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = ) else [ ok_button ] in ok ~title:"Logged in" ~buttons ~cookie - q ("Welcome " ^ username ^ "." ^ + dbh hostid q + ("Welcome " ^ username ^ "." ^ if force_password_change then " Please change your password now." else "") with @@ -85,7 +86,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = error ~title:"Bad name or password" ~back_button:true - q "The name or password was wrong." + dbh hostid q "The name or password was wrong." let () = register_script run diff --git a/scripts/logout.ml b/scripts/logout.ml index e4827bc..b955f53 100644 --- a/scripts/logout.ml +++ b/scripts/logout.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: logout.ml,v 1.5 2005/03/31 14:24:04 rich Exp $ + * $Id: logout.ml,v 1.6 2005/11/24 14:54:12 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 @@ -29,7 +29,7 @@ open Cocanwiki_ok let expires = "Sun, 09-Sep-2001 02:46:40 GMT" -let run r (q : cgi) (dbh : Dbi.connection) _ _ user = +let run r (q : cgi) (dbh : Dbi.connection) hostid _ user = (* The logout function removes all of the associated cookies from the * database. This isn't required, but is nice semantics, and also helps * to reduce the size of the usercookies table in the database. @@ -47,7 +47,7 @@ let run r (q : cgi) (dbh : Dbi.connection) _ _ user = let cookie = Cookie.cookie "auth" "none" ~path:"/" ~expires in ok ~title:"Logged out" ~buttons:[ok_button "/"] ~cookie - q "You have been logged out." + dbh hostid q "You have been logged out." let () = register_script run diff --git a/scripts/mail_import.ml b/scripts/mail_import.ml index 008d991..9e24bfb 100644 --- a/scripts/mail_import.ml +++ b/scripts/mail_import.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: mail_import.ml,v 1.8 2005/11/17 10:14:42 rich Exp $ + * $Id: mail_import.ml,v 1.9 2005/11/24 14:54:12 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 @@ -59,7 +59,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ user = with Not_found -> error ~back_button:true ~title:"No message" - q "No message was uploaded."; + dbh hostid q "No message was uploaded."; return () in (* Parse the message. *) @@ -86,7 +86,8 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ user = *) if date = "" || inet_message_id = "" then ( error ~back_button:true ~title:"Headers missing" - q "Date or Message-ID header missing. Cannot handle this message. "; + dbh hostid q + "Date or Message-ID header missing. Cannot handle this message. "; return () ); @@ -155,7 +156,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ user = let id = sth#fetch1int () in if not overwrite then ( ok ~title:"Message exists" - q "Message already imported"; + dbh hostid q "Message already imported"; return () ); Some id @@ -363,7 +364,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ user = (* Finish off. *) ok ~title:"Imported" - q ("Message " ^ inet_message_id ^ " was imported.") + dbh hostid q ("Message " ^ inet_message_id ^ " was imported.") let () = register_script ~restrict:[CanImportMail] run diff --git a/scripts/mail_rebuild.ml b/scripts/mail_rebuild.ml index cb5ba0e..d429eb9 100644 --- a/scripts/mail_rebuild.ml +++ b/scripts/mail_rebuild.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: mail_rebuild.ml,v 1.1 2004/10/21 11:42:04 rich Exp $ + * $Id: mail_rebuild.ml,v 1.2 2005/11/24 14:54:12 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 @@ -39,7 +39,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ user = (* Finish off. *) ok ~title:"Rebuilt" - q ("Thread index rebuilt.") + dbh hostid q "Thread index rebuilt." let () = register_script ~restrict:[CanImportMail] run diff --git a/scripts/mailing_list_confirm.ml b/scripts/mailing_list_confirm.ml index c1308e6..65e1b57 100644 --- a/scripts/mailing_list_confirm.ml +++ b/scripts/mailing_list_confirm.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: mailing_list_confirm.ml,v 1.3 2004/10/04 15:19:56 rich Exp $ + * $Id: mailing_list_confirm.ml,v 1.4 2005/11/24 14:54:12 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 @@ -41,7 +41,8 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = with Not_found -> error ~close_button:true ~title:"Email already confirmed" - q "It looks like that email address has already been confirmed."; + dbh hostid q + "It looks like that email address has already been confirmed."; return () in (* Update the database. *) @@ -54,8 +55,8 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = (* Confirmed. *) let buttons = [ ok_button "/" ] in ok ~buttons ~title:"Confirmed" - q ("Your email address has been confirmed. " ^ - "You are now on our mailing list.") + dbh hostid q ("Your email address has been confirmed. " ^ + "You are now on our mailing list.") let () = register_script ~restrict:[CanView] run diff --git a/scripts/mailing_list_send.ml b/scripts/mailing_list_send.ml index 623cfff..35c50d2 100644 --- a/scripts/mailing_list_send.ml +++ b/scripts/mailing_list_send.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: mailing_list_send.ml,v 1.5 2005/03/31 14:24:04 rich Exp $ + * $Id: mailing_list_send.ml,v 1.6 2005/11/24 14:54:12 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 @@ -37,7 +37,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } _ = if email = "" then ( error ~title:"No email address" ~back_button:true - q "You must give an email address."; + dbh hostid q "You must give an email address."; return () ); @@ -57,7 +57,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } _ = if registered then ( error ~title:"Email address already used" ~back_button:true - q + dbh hostid q ("That email address is already on our mailing list. "^ "If you are not receiving mailing list messages, then you will " ^ "need to confirm that address. If you continue to have problems " ^ @@ -92,9 +92,10 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } _ = (* Finish up. *) let buttons = [ ok_button "/" ] in ok ~buttons ~title:"Confirmation email sent" - q ("Please check your email now. You have been sent a confirmation " ^ - "email so we can verify the email address is yours. Click on the " ^ - "first link in that email to confirm.") + dbh hostid q + ("Please check your email now. You have been sent a confirmation " ^ + "email so we can verify the email address is yours. Click on the " ^ + "first link in that email to confirm.") let () = register_script ~restrict:[CanView] run diff --git a/scripts/mailing_list_unsubscribe.ml b/scripts/mailing_list_unsubscribe.ml index d2b1328..11b5865 100644 --- a/scripts/mailing_list_unsubscribe.ml +++ b/scripts/mailing_list_unsubscribe.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: mailing_list_unsubscribe.ml,v 1.1 2004/09/24 16:41:16 rich Exp $ + * $Id: mailing_list_unsubscribe.ml,v 1.2 2005/11/24 14:54:12 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 @@ -40,7 +40,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = (* Confirmed. *) let buttons = [ ok_button "/" ] in ok ~buttons ~title:"Unsubscribed" - q "Your email address has been unsubscribed." + dbh hostid q "Your email address has been unsubscribed." let () = register_script run diff --git a/scripts/page.ml b/scripts/page.ml index aa66aed..b4e553c 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 . * Copyright (C) 2004 Merjis Ltd. - * $Id: page.ml,v 1.41 2005/11/23 11:05:54 rich Exp $ + * $Id: page.ml,v 1.42 2005/11/24 14:54:12 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 @@ -486,8 +486,9 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid let rec loop page' i = if i > max_redirect then ( error ~title:"Too many redirections" ~back_button:true - q ("Too many redirects between pages. This may happen because " ^ - "of a cycle of redirections."); + dbh hostid q + ("Too many redirects between pages. This may happen because " ^ + "of a cycle of redirections."); return () ) else match fetch_page page' version allow_redirect with diff --git a/scripts/page_email_confirm.ml b/scripts/page_email_confirm.ml index 8eea8d6..9676149 100644 --- a/scripts/page_email_confirm.ml +++ b/scripts/page_email_confirm.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: page_email_confirm.ml,v 1.2 2004/10/04 15:19:56 rich Exp $ + * $Id: page_email_confirm.ml,v 1.3 2005/11/24 14:54:12 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 @@ -43,7 +43,8 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = with Not_found -> error ~close_button:true ~title:"Email already confirmed" - q "It looks like that email address has already been confirmed."; + dbh hostid q + "It looks like that email address has already been confirmed."; return () in (* Update the database. *) @@ -56,8 +57,9 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = (* Confirmed. *) let buttons = [ ok_button ("/" ^ page) ] in ok ~buttons ~title:"Confirmed" - q ("Your email address has been confirmed. You will now receive " ^ - "an email whenever that page is updated.") + dbh hostid q + ("Your email address has been confirmed. You will now receive " ^ + "an email whenever that page is updated.") let () = register_script ~restrict:[CanView] run diff --git a/scripts/page_email_send.ml b/scripts/page_email_send.ml index 49b0b28..a679faa 100644 --- a/scripts/page_email_send.ml +++ b/scripts/page_email_send.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: page_email_send.ml,v 1.3 2005/03/31 14:24:04 rich Exp $ + * $Id: page_email_send.ml,v 1.4 2005/11/24 14:54:12 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 @@ -37,7 +37,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } _ = if email = "" then ( error ~title:"No email address" ~back_button:true - q "You must give an email address."; + dbh hostid q "You must give an email address."; return () ); @@ -57,7 +57,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } _ = if registered then ( error ~title:"Email address already used" ~back_button:true - q + dbh hostid q ("That email address is already used for notifications from this page. "^ "If you are not receiving updates for this page, then you will " ^ "need to confirm that address. If you continue to have problems " ^ @@ -93,9 +93,10 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } _ = (* Finish up. *) let buttons = [ ok_button ("/" ^ page) ] in ok ~buttons ~title:"Confirmation email sent" - q ("Please check your email now. You have been sent a confirmation " ^ - "email so we can verify the email address is yours. Click on the " ^ - "first link in that email to confirm.") + dbh hostid q + ("Please check your email now. You have been sent a confirmation " ^ + "email so we can verify the email address is yours. Click on the " ^ + "first link in that email to confirm.") let () = register_script ~restrict:[CanView] run diff --git a/scripts/page_email_unsubscribe.ml b/scripts/page_email_unsubscribe.ml index eb354ff..55749c4 100644 --- a/scripts/page_email_unsubscribe.ml +++ b/scripts/page_email_unsubscribe.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: page_email_unsubscribe.ml,v 1.1 2004/09/24 15:53:57 rich Exp $ + * $Id: page_email_unsubscribe.ml,v 1.2 2005/11/24 14:54:12 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 @@ -40,7 +40,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = (* Confirmed. *) let buttons = [ ok_button "/" ] in ok ~buttons ~title:"Unsubscribed" - q "Your email address has been unsubscribed." + dbh hostid q "Your email address has been unsubscribed." let () = register_script run diff --git a/scripts/rename_page.ml b/scripts/rename_page.ml index 579369c..32cfff8 100644 --- a/scripts/rename_page.ml +++ b/scripts/rename_page.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: rename_page.ml,v 1.2 2004/11/22 11:11:52 rich Exp $ + * $Id: rename_page.ml,v 1.3 2005/11/24 14:54:12 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 @@ -44,7 +44,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = (* New title mustn't be empty string. *) if new_title = "" then ( error ~back_button:true ~title:"Empty title not allowed" - q "The new title cannot be empty."; + dbh hostid q "The new title cannot be empty."; return () ); @@ -63,9 +63,10 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = | Wikilib.GenURL_OK url | Wikilib.GenURL_Duplicate url -> url | Wikilib.GenURL_TooShort | Wikilib.GenURL_BadURL -> error ~title:"Bad title" ~back_button:true - q ("The new title for the page isn't valid. " ^ - "It may be too short or it may not contain " ^ - "enough alphabet letters."); + dbh hostid q + ("The new title for the page isn't valid. " ^ + "It may be too short or it may not contain " ^ + "enough alphabet letters."); return () in if page = new_page then ( @@ -90,10 +91,11 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = with SaveURLError -> error ~title:"Page exists" - q ("Another page with the same title exists. " ^ - "If you tried to rename a page, then rename it back to the " ^ - "original title, then you may see this error. This is a bug " ^ - "which you should raise with the site administrator."); + dbh hostid q + ("Another page with the same title exists. " ^ + "If you tried to rename a page, then rename it back to the " ^ + "original title, then you may see this error. This is a bug " ^ + "which you should raise with the site administrator."); return () ); @@ -111,7 +113,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = let buttons = [ ok_button ("/" ^ new_page) ] in ok ~title:"Page renamed" ~buttons - q "That page was renamed." + dbh hostid q "That page was renamed." let () = register_script ~restrict:[CanEdit] run diff --git a/scripts/restore.ml b/scripts/restore.ml index a3ed7c2..3501f70 100644 --- a/scripts/restore.ml +++ b/scripts/restore.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: restore.ml,v 1.18 2005/11/19 10:36:42 rich Exp $ + * $Id: restore.ml,v 1.19 2005/11/24 14:54:12 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 @@ -105,7 +105,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = (* Done. *) let buttons = [ ok_button ("/" ^ page) ] in ok ~title:"Restored" ~buttons - q "The old page was restored successfully." + dbh hostid q "The old page was restored successfully." ) else q#redirect ("http://" ^ hostname ^ "/" ^ page) diff --git a/scripts/restore_form.ml b/scripts/restore_form.ml index e1c4c49..859e9a7 100644 --- a/scripts/restore_form.ml +++ b/scripts/restore_form.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: restore_form.ml,v 1.10 2004/11/01 12:57:53 rich Exp $ + * $Id: restore_form.ml,v 1.11 2005/11/24 14:54:12 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 @@ -50,7 +50,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ user = if version = old_version then ( error ~back_button:true ~title:"Restoring live version" - q "You seem to be trying to restore the live version."; + dbh hostid q "You seem to be trying to restore the live version."; return () ); diff --git a/scripts/send_feedback.ml b/scripts/send_feedback.ml index a2929a1..a6ccb83 100644 --- a/scripts/send_feedback.ml +++ b/scripts/send_feedback.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: send_feedback.ml,v 1.5 2005/03/31 14:24:04 rich Exp $ + * $Id: send_feedback.ml,v 1.6 2005/11/24 14:54:12 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 @@ -86,7 +86,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = (* Confirm. *) ok ~title:"Thank you for your feedback" ~buttons:[ok_button "/"] - q "An email has been sent to the site administrators." + dbh hostid q "An email has been sent to the site administrators." let () = register_script ~restrict:[CanView] run diff --git a/scripts/set_password.ml b/scripts/set_password.ml index df9c815..e98a7b2 100644 --- a/scripts/set_password.ml +++ b/scripts/set_password.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: set_password.ml,v 1.2 2004/09/23 11:56:47 rich Exp $ + * $Id: set_password.ml,v 1.3 2005/11/24 14:54:12 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 @@ -34,7 +34,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = if password1 <> password2 then ( error ~back_button:true ~title:"Passwords don't match" - q "The two passwords you gave aren't identical."; + dbh hostid q "The two passwords you gave aren't identical."; return () ); @@ -47,7 +47,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = dbh#commit (); ok ~title:"Password updated" ~buttons:[ok_button "/_users"] - q "The password on that user account was updated." + dbh hostid q "The password on that user account was updated." let () = register_script ~restrict:[CanManageUsers] run diff --git a/scripts/signup.ml b/scripts/signup.ml index 84a44aa..b98cede 100644 --- a/scripts/signup.ml +++ b/scripts/signup.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: signup.ml,v 1.8 2005/11/17 10:14:42 rich Exp $ + * $Id: signup.ml,v 1.9 2005/11/24 14:54:13 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 @@ -47,13 +47,13 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = if username = "" || password1 = "" || password2 = "" then ( error ~back_button:true ~title:"Bad username or password" - q "The username or password you gave is empty."; + dbh hostid q "The username or password you gave is empty."; return () ); if password1 <> password2 then ( error ~back_button:true ~title:"Passwords don't match" - q "The two passwords you gave aren't identical."; + dbh hostid q "The two passwords you gave aren't identical."; return () ); @@ -75,9 +75,10 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = (try sth#fetch1 (); error ~back_button:true ~title:"Username already taken" - q ("Someone, possibly you, has already taken that username. " ^ - "If you think you have forgotten your password, try going back " ^ - "and clicking on the 'Forgotten your password?' link."); + dbh hostid q + ("Someone, possibly you, has already taken that username. " ^ + "If you think you have forgotten your password, try going back " ^ + "and clicking on the 'Forgotten your password?' link."); return () with Not_found -> ()); @@ -104,8 +105,9 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = ok ~title:"Account created" ~buttons ~cookie - q ("An account was created for you, " ^ username ^ ". " ^ - "We hope you enjoy using this service.") + dbh hostid q + ("An account was created for you, " ^ username ^ ". " ^ + "We hope you enjoy using this service.") let () = register_script run diff --git a/scripts/source.ml b/scripts/source.ml index 269a3ad..0a0fb20 100644 --- a/scripts/source.ml +++ b/scripts/source.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: source.ml,v 1.2 2004/11/02 18:47:54 rich Exp $ + * $Id: source.ml,v 1.3 2005/11/24 14:54:13 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 @@ -43,7 +43,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = with Not_found -> error ~title:"Page not found" - q "That page was not found"; + dbh hostid q "That page was not found"; return () in (* XXX CSS - eventually both title and CSS fields should be returned in diff --git a/scripts/undelete_file.ml b/scripts/undelete_file.ml index 0f751e2..01e5d53 100644 --- a/scripts/undelete_file.ml +++ b/scripts/undelete_file.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: undelete_file.ml,v 1.6 2004/09/09 12:21:22 rich Exp $ + * $Id: undelete_file.ml,v 1.7 2005/11/24 14:54:13 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 @@ -62,7 +62,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } _ = (* Done. *) let buttons = [ ok_button "/_files" ] in ok ~title:"File restored" ~buttons - q "File was restored successfully." + dbh hostid q "File was restored successfully." ) else q#redirect ("http://" ^ hostname ^ "/_files") diff --git a/scripts/undelete_image.ml b/scripts/undelete_image.ml index 8128f61..991b8b2 100644 --- a/scripts/undelete_image.ml +++ b/scripts/undelete_image.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: undelete_image.ml,v 1.6 2004/09/09 12:21:22 rich Exp $ + * $Id: undelete_image.ml,v 1.7 2005/11/24 14:54:13 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 @@ -67,7 +67,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } _ = (* Done. *) let buttons = [ ok_button "/_images" ] in ok ~title:"Image restored" ~buttons - q "Image was restored successfully." + dbh hostid q "Image was restored successfully." ) else q#redirect ("http://" ^ hostname ^ "/_images") diff --git a/scripts/upload_file.ml b/scripts/upload_file.ml index fc567b0..6776ee0 100644 --- a/scripts/upload_file.ml +++ b/scripts/upload_file.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: upload_file.ml,v 1.10 2004/11/01 17:05:14 rich Exp $ + * $Id: upload_file.ml,v 1.11 2005/11/24 14:54:13 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 @@ -48,14 +48,15 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } user= with Not_found -> error ~title:"No file" ~back_button:true - q "No file was uploaded."; + dbh hostid q "No file was uploaded."; return () in (* Check the name is valid. *) if not (Pcre.pmatch ~rex:file_ok_re name) then ( error ~title:"Bad File Name" ~back_button:true - q ("The File Name must contain only lowercase English letters, " ^ - "numbers, dots, dashes and underscore."); + dbh hostid q + ("The File Name must contain only lowercase English letters, " ^ + "numbers, dots, dashes and underscore."); return () ); @@ -77,7 +78,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } user= if exists then ( if not replace then ( error ~title:"File already exists" ~back_button:true - q ("An file with the same name already exists."); + dbh hostid q "An file with the same name already exists."; return () ) else ( let sth = dbh#prepare_cached "update files @@ -106,7 +107,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } user= let buttons = [ ok_button "/_files" ] in ok ~title:"File uploaded" ~buttons - q "File was uploaded successfully." + dbh hostid q "File was uploaded successfully." let () = register_script ~restrict:[CanEdit] run diff --git a/scripts/upload_image.ml b/scripts/upload_image.ml index 238b5a2..4101832 100644 --- a/scripts/upload_image.ml +++ b/scripts/upload_image.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: upload_image.ml,v 1.11 2004/11/01 17:05:14 rich Exp $ + * $Id: upload_image.ml,v 1.12 2005/11/24 14:54:13 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 @@ -50,16 +50,17 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } user= with Not_found -> error ~title:"No image" ~back_button:true - q "No image was uploaded."; + dbh hostid q "No image was uploaded."; return () in (* Check the name is valid. *) if not (Pcre.pmatch ~rex:image_ok_re name) then ( error ~title:"Bad Image Name" ~back_button:true - q ("The Image Name must contain only lowercase English letters, " ^ - "numbers, dots, dashes and underscore. " ^ - "It must end with .jpg, .gif or .png " ^ - "depending on the image format."); + dbh hostid q + ("The Image Name must contain only lowercase English letters, " ^ + "numbers, dots, dashes and underscore. " ^ + "It must end with .jpg, .gif or .png " ^ + "depending on the image format."); return () ); @@ -69,8 +70,9 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } user= with Invalid_argument _ -> error ~title:"Bad image" ~back_button:true - q ("Unknown image type. Is the file you uploaded really an " ^ - "image?"); + dbh hostid q + ("Unknown image type. Is the file you uploaded really an " ^ + "image?"); return () in (* Check the image filename extension matches the MIME type. *) @@ -86,19 +88,21 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } user= | _ -> assert false in if not ext_ok then ( error ~title:"Bad Image Name" ~back_button:true - q ("The Image Name extension has to match the image format. " ^ - "For example if the image is in JPEG format, the name must " ^ - "be 'something.jpg'. I detected the following image type " ^ - "in the file you uploaded: " ^ mime_type); + dbh hostid q + ("The Image Name extension has to match the image format. " ^ + "For example if the image is in JPEG format, the name must " ^ + "be 'something.jpg'. I detected the following image type " ^ + "in the file you uploaded: " ^ mime_type); return () ); (* Check some ALT text was supplied. *) if string_is_whitespace alt then ( error ~title:"Missing Alt text" ~back_button:true - q ("You must supply Alt text describing the image. This is required " ^ - "by accessibility laws and to allow search engines to discover the " ^ - "content of images."); + dbh hostid q + ("You must supply Alt text describing the image. This is required " ^ + "by accessibility laws and to allow search engines to discover the " ^ + "content of images."); return () ); @@ -124,7 +128,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } user= if exists then ( if not replace then ( error ~title:"Image already exists" ~back_button:true - q ("An image with the same name already exists."); + dbh hostid q "An image with the same name already exists."; return () ) else ( let sth = dbh#prepare_cached "update images @@ -157,7 +161,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } user= let buttons = [ ok_button "/_images" ] in ok ~title:"Image uploaded" ~buttons - q "Image was uploaded successfully." + dbh hostid q "Image was uploaded successfully." let () = register_script ~restrict:[CanEdit] run diff --git a/scripts/user_prefs.ml b/scripts/user_prefs.ml index 8884c83..59471fb 100644 --- a/scripts/user_prefs.ml +++ b/scripts/user_prefs.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: user_prefs.ml,v 1.5 2005/03/31 14:24:04 rich Exp $ + * $Id: user_prefs.ml,v 1.6 2005/11/24 14:54:13 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 @@ -99,7 +99,8 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname=hostname} user = let buttons = [ ok_button "/_userprefs" ] in ok ~title:"Preferences updated" ~buttons - q ("Your user preferences were updated. " ^ + dbh hostid q + ("Your user preferences were updated. " ^ if confirm_needed then ("Because you changed your email address, we have sent a " ^ "confirmation email to your new address. You will need to " ^ diff --git a/templates/footer.html b/templates/footer.html index 6baf7e8..36bf46d 100644 --- a/templates/footer.html +++ b/templates/footer.html @@ -29,6 +29,8 @@ ::end:: +::if(has_pagebug)::::pagebug::::end:: +