Added styling to some pages which previously were "outside" the site
[cocanwiki.git] / scripts / edit.ml
index 016b0bb..6ddbfc1 100644 (file)
@@ -1,7 +1,7 @@
 (* COCANWIKI - a wiki written in Objective CAML.
  * Written by Richard W.M. Jones <rich@merjis.com>.
  * Copyright (C) 2004 Merjis Ltd.
- * $Id: edit.ml,v 1.17 2004/10/09 09:52:10 rich Exp $
+ * $Id: edit.ml,v 1.33 2006/08/01 14:50:47 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
@@ -32,24 +32,9 @@ open Cocanwiki_ok
 open Cocanwiki_emailnotify
 open Cocanwiki_diff
 open Cocanwiki_strings
+open Cocanwiki_pages
 
-(* Page of title. *)
-type pt_t = Page of string | Title of string
-
-(* We keep an "internal model" of the page - see build_internal_model ()
- * below.
- *)
-type model_t = {
-  id : int;                            (* Original page ID (0 = none). *)
-  pt : pt_t;                           (* Page of title (only used if id=0) *)
-  description : string;                        (* Description. *)
-  redirect : string;                   (* Redirect to ("" = none). *)
-  contents : (string * string * string) list;
-                                       (* (sectionname, divname, content)
-                                        * for each section. *)
-}
-
-let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user =
+let run r (q : cgi) dbh hostid {hostname = hostname} user =
   let template = get_template dbh hostid "edit.html" in
   let template_conflict = get_template dbh hostid "edit_conflict.html" in
   let template_email = get_template dbh hostid "edit_page_email.txt" in
@@ -63,16 +48,19 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user =
       ignore (String.find ua "MSIE"); (* Throws Invalid_string if not found. *)
       true
     with
-       Not_found | String.Invalid_string -> false in
+       Not_found | Invalid_string -> false in
   template#conditional "msie" msie;
 
   (* Build the internal model from the parameters passed to the script. *)
   let build_internal_model () =
-    let id = int_of_string (q#param "id") in
+    let id = Int32.of_string (q#param "id") in
     let description = q#param "description" in
     let redirect = q#param "redirect" in
+    let redirect =
+      if string_is_whitespace redirect then
+       None else Some redirect in
     let pt = match q#param "pt_type" with
-       "page" -> Page (q#param "pt_value")
+      | "page" -> Page (q#param "pt_value")
       | "title" -> Title (q#param "pt_value")
       | _ -> failwith "unknown value for pt_type parameter" in
 
@@ -80,9 +68,15 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user =
     let i = ref 1 in
     while q#param_exists ("content_" ^ string_of_int !i) do
       let sectionname = q#param ("sectionname_" ^ string_of_int !i) in
+      let sectionname =
+       if string_is_whitespace sectionname then None else Some sectionname in
       let content = q#param ("content_" ^ string_of_int !i) in
       let divname = q#param ("divname_" ^ string_of_int !i) in
-      contents := (sectionname, divname, content) :: !contents;
+      let divname =
+       if string_is_whitespace divname then None else Some divname in
+      let jsgo = q#param ("jsgo_" ^ string_of_int !i) in
+      let jsgo = if string_is_whitespace jsgo then None else Some jsgo in
+      contents := (sectionname, divname, jsgo, content) :: !contents;
       incr i
     done;
     let contents = List.rev !contents in
@@ -91,7 +85,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user =
       pt = pt;
       description = description;
       redirect = redirect;
-      contents = contents; }
+      contents_ = contents; }
   in
 
   (* Check for errors in the model. *)
@@ -100,44 +94,70 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user =
     let add_error msg = errors := msg :: !errors in
     let get_errors () = List.rev !errors in
 
-    if model.redirect = "" then (
-      (* Empty page? *)
-      if model.contents = [] then
-       add_error ("This page is empty.  Use 'Insert new section here' " ^
-                  "to write something!");
-
-      (* Description field? *)
-      if model.description = "" then
-       add_error ("The description field is very important!  This field is " ^
-                   "used by search engines and directories to describe " ^
-                   "what's on this page.");
-    )
-    else (* it's a redirect *) (
-      (* Redirect points to a real page? *)
-      let sth = dbh#prepare_cached "select 1 from pages
-                                     where hostid = ?
-                                       and url is not null
-                                       and url = ?
-                                       and id <> ?
-                                       and redirect is null" in
-      sth#execute [`Int hostid; `String model.redirect; `Int model.id];
-
-      let ok = try sth#fetch1 () = [`Int 1] with Not_found -> false in
-      if not ok then
-       add_error ("Redirect must point to an ordinary page " ^
-                  "(ie. not to a page which is itself a redirect).")
+    (match model.redirect with
+     | None ->
+        (* Empty page? *)
+        if model.contents_ = [] then
+          add_error ("This page is empty.  Use 'Insert new section here' " ^
+                       "to write something!");
+
+        (* Description field? *)
+        if model.description = "" then
+          add_error ("The description field is very important!  " ^
+                       "This field is " ^
+                       "used by search engines and directories to describe " ^
+                       "what's on this page.");
+
+     | Some redirect ->
+        (* Redirect points to a real page? *)
+        let rows =
+          let model_id = model.id in
+          PGSQL(dbh)
+          "select 1 from pages
+             where hostid = $hostid and url is not null
+               and url = $redirect and id <> $model_id
+               and redirect is null" in
+
+        let ok = rows = [Some 1l] in
+        if not ok then
+          add_error ("Redirect must point to an ordinary page " ^
+                       "(ie. not to a page which is itself a redirect).")
     );
 
     (* All sections after the first one have sectionnames?  The first
      * section ONLY is allowed to have an empty title.
      *)
-    if model.contents <> [] then
-      List.iter (function (sectionnames, _, _)
-                    when string_is_whitespace sectionnames ->
-                      add_error
-                      ("Every section except the first must have a title.");
-                  | _ -> ())
-       (List.tl model.contents);
+    if model.contents_ <> [] then
+      List.iter (function
+                | (None, _, _, _) ->
+                    add_error
+                      "Every section except the first must have a title.";
+                | _ -> ())
+       (List.tl model.contents_);
+
+    (* There are two constraints on any non-null jsgo's:
+     * (1) Must only be present if divname is non-null.
+     * (2) Must point to a valid URL on the current host.
+     *)
+    List.iter (
+      function
+      | (_, None, Some _, _) ->
+         add_error
+           "Javascript onclick can only be used with a CSS id."
+      | (_, _, Some jsgo, _) ->
+         let rows =
+           PGSQL(dbh) "select 1 from pages
+                         where hostid = $hostid
+                           and url is not null
+                           and url = $jsgo
+                           and redirect is null" in
+         let ok = rows = [Some 1l] in
+         if not ok then
+           add_error ("Javascript onclick must point to an ordinary page " ^
+                      "on the current site (ie. not to a redirect). " ^
+                      "Do not put '/' at the beginning of the URL.")
+      | _ -> ()
+    ) model.contents_;
 
     get_errors ()
   in
@@ -151,8 +171,8 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user =
         | _, [] -> [ item ]
         | n, x :: xs -> x :: (loop (n-1, xs))
     in
-    let contents = loop (posn, model.contents) in
-    { model with contents = contents }
+    let contents = loop (posn, model.contents_) in
+    { model with contents_ = contents }
   in
   let action_moveup model posn =
     (* posn = 1 means move up the first element, ie. do nothing
@@ -167,8 +187,8 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user =
         | 2, x :: y :: xs -> y :: x :: xs
         | n, x :: xs -> x :: (loop (n-1, xs))
     in
-    let contents = loop (posn, model.contents) in
-    { model with contents = contents }
+    let contents = loop (posn, model.contents_) in
+    { model with contents_ = contents }
   in
   let action_movedn model posn =
     (* posn = 1 means move down the first element to the second position
@@ -181,8 +201,8 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user =
         | 1, x :: y :: xs -> y :: x :: xs
         | n, x :: xs -> x :: (loop (n-1, xs))
     in
-    let contents = loop (posn, model.contents) in
-    { model with contents = contents }
+    let contents = loop (posn, model.contents_) in
+    { model with contents_ = contents }
   in
   let action_delete model posn =
     (* posn = 1 means delete the first element *)
@@ -193,13 +213,13 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user =
         | 1, x :: xs -> xs
         | n, x :: xs -> x :: (loop (n-1, xs))
     in
-    let contents = loop (posn, model.contents) in
-    { model with contents = contents }
+    let contents = loop (posn, model.contents_) in
+    { model with contents_ = contents }
   in
 
   (* Convert model to template. *)
   let model_to_template model template =
-    template#set "id" (string_of_int model.id);
+    template#set "id" (Int32.to_string model.id);
     template#set "description" model.description;
 
     (match model.pt with
@@ -211,42 +231,52 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user =
           template#set "pt_value" title);
 
     (* Redirects table. *)
-    let sth = dbh#prepare_cached "select url, title from pages
-                                   where url is not null
-                                     and redirect is null
-                                     and hostid = ? and id <> ?
-                                   order by 2" in
-    sth#execute [`Int hostid; `Int model.id];
-    let table = sth#map (function [`String url; `String title] ->
-                          let selected = model.redirect = url in
-                          [ "url", Template.VarString url;
-                            "title", Template.VarString title;
-                            "selected", Template.VarConditional selected ]
-                          | _ -> assert false) in
+    let rows =
+      let model_id = model.id in
+      PGSQL(dbh)
+      "select url, title from pages
+        where url is not null
+          and redirect is null
+          and hostid = $hostid and id <> $model_id
+        order by 2" in
+    let table = List.map (
+      fun (url, title) ->
+       let url = Option.get url in
+       let selected = model.redirect = Some url in
+       [ "url", Template.VarString url;
+         "title", Template.VarString title;
+         "selected", Template.VarConditional selected ]
+    ) rows in
     template#table "redirects" table;
 
-    if model.id <> 0 then (
+    if model.id <> 0l then (
       (* Need to go to the database to get the title of the page ... *)
-      let sth = dbh#prepare_cached "select title from pages
-                                     where hostid = ? and id = ?" in
-      sth#execute [`Int hostid; `Int model.id];
-      let title = sth#fetch1string () in
+      let rows =
+       let model_id = model.id in
+       PGSQL(dbh)
+         "select title from pages
+            where hostid = $hostid and id = $model_id" in
+      let title = List.hd rows in
       template#set "title" title;
     ) else (
       match model.pt with
-         Page page -> template#set "title" page
-       | Title title -> template#set "title" title
+      | Page page -> template#set "title" page
+      | Title title -> template#set "title" title
     );
 
     let ordering = ref 0 in
     let table =
       List.map
-       (fun (sectionname, divname, content) ->
-          incr ordering; let ordering = !ordering in
-          [ "ordering", Template.VarString (string_of_int ordering);
+       (fun (sectionname, divname, jsgo, content) ->
+          incr ordering; let ordering = Int32.of_int !ordering in
+          let sectionname = match sectionname with None -> "" | Some s -> s in
+          let divname = match divname with None -> "" | Some s -> s in
+          let jsgo = match jsgo with None -> "" | Some s -> s in
+          [ "ordering", Template.VarString (Int32.to_string ordering);
             "sectionname", Template.VarString sectionname;
             "divname", Template.VarString divname;
-            "content", Template.VarString content ]) model.contents in
+            "jsgo", Template.VarString jsgo;
+            "content", Template.VarString content ]) model.contents_ in
     template#table "contents" table;
 
     (* Check for errors and put those into the template. *)
@@ -259,75 +289,39 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user =
 
   (* Check if a URL exists in the database. *)
   let page_exists page =
-    let sth =
-      dbh#prepare_cached "select 1 from pages where hostid = ? and url = ?" in
-    sth#execute [`Int hostid; `String page];
-
-    try sth#fetch1int () = 1 with Not_found -> false
+    let rows = PGSQL(dbh)
+      "select 1 from pages where hostid = $hostid and url = $page" in
+    rows = [ Some 1l ]
   in
 
   (* Begin editing a page, pulling the page out of the database and building
    * a model from it.
    *)
   let begin_editing page =
-    (* Pull out the page itself from the database. *)
-    let sth = dbh#prepare_cached "select id, title, description,
-                                         coalesce (redirect, '')
-                                    from pages
-                                   where hostid = ? and url = ?" in
-    sth#execute [`Int hostid; `String page];
-
-    let pageid, title, description, redirect =
-      match sth#fetch1 () with
-         [`Int pageid; `String title; `String description; `String redirect]->
-           pageid, title, description, redirect
-       | _ -> assert false in
-
-    (* Get the sections. *)
-    let sth = dbh#prepare_cached "select coalesce (sectionname, ''),
-                                         content,
-                                         coalesce (divname, '')
-                                    from contents
-                                   where pageid = ?
-                                   order by ordering" in
-    sth#execute [`Int pageid];
-
-    let contents =
-      sth#map (function
-                | [`String sectionname; `String content; `String divname] ->
-                    sectionname, divname, content
-                | _ -> assert false) in
-
-    let model = { id = pageid;
-                 pt = Page page;
-                 description = description;
-                 redirect = redirect;
-                 contents = contents; } in
-
+    let model = load_page dbh hostid ~url:page () in
     model_to_template model template
   in
 
   (* Begin editing with a blank page, typically a template. *)
   let begin_editing_new pt =
-    let url, title =
-      match pt with
-         Page url -> url, url
-       | Title title ->
-           match Wikilib.generate_url_of_title dbh hostid title with
-               Wikilib.GenURL_OK url -> url, title
-             | Wikilib.GenURL_Duplicate url ->
-                 q#redirect ("http://" ^ hostname ^ "/" ^ url);
-                 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.";
-                 return () in
-
-    let model = { id = 0;
-                 pt = pt;
-                 description = title;
-                 redirect = "";
-                 contents = [] } in
+    (* Just check the title. *)
+    (match pt with
+     | Page url -> ()
+     | Title title ->
+        match Wikilib.generate_url_of_title r dbh hostid title with
+        | Wikilib.GenURL_OK url -> ()
+        | Wikilib.GenURL_Duplicate url ->
+            q#redirect ("http://" ^ hostname ^ "/" ^ url)
+        | Wikilib.GenURL_TooShort | Wikilib.GenURL_BadURL ->
+            error ~back_button:true ~title:"Bad page name"
+              dbh hostid q
+              "The page name supplied is too short or invalid.";
+            return ()
+    );
+
+    let model = match pt with
+      | Page url -> new_page pt
+      | Title title -> new_page_with_title title in
 
     model_to_template model template
   in
@@ -371,7 +365,10 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user =
 
     if is_action "insert" then (
       let posn = get_action "insert" in
-      let item = "New section - change this", "", "Write some content here." in
+      let item =
+       Some "The title of this section",
+       None, None,
+       "Write something here." in
       model := action_insert !model posn item
     ) else if is_action "moveup" then (
       let posn = get_action "moveup" in
@@ -387,233 +384,100 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user =
     model_to_template !model template
   in
 
-  (* Try to save the page.  Returns a boolean indicating if the
-   * page was saved successfully.
+  (* Try to save the page.  Only returns if there were errors in
+   * the model.
    *)
   let try_save () =
     let model = build_internal_model () in
     let no_errors = [] = check_for_errors model in
     if no_errors then (
       (* No errors, so we can save the page ... *)
-
-      (* Get the IP address of the user, if available. *)
-      let logged_ip =
-       try `String (Connection.remote_ip (Request.connection r))
-       with Not_found -> `Null in
-
-      let logged_user =
-       match user with
-         | User (id, _, _) -> `Int id
-         | _ -> `Null in
-
-      (* Get redirect. *)
-      let redirect =
-       if model.redirect = "" then `Null
-        else `String model.redirect in
-
       let url, pageid =
-       (* Creating a new page (id = 0)?  If so, we're just going to insert
-        * a new row, which is easy.
+       try
+         save_page r dbh hostid ~user model
+       with
+           SaveURLError ->
+             error ~back_button:true ~title:"Page exists"
+               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) ->
+             (* Edited by someone else ...  Get the other's changes. *)
+             let other_diff, _ =
+               get_diff dbh hostid url ~old_version ~version:new_version () in
+
+             (* Synthesize our own changes. *)
+             let old_page = get_version_for_diff dbh old_version in
+             let new_page =
+               page_for_diff css (List.map (
+                                    fun (sectionname, _, _, content) ->
+                                      let sectionname = match sectionname with
+                                        | None -> ""
+                                        | Some s -> s in
+                                      sectionname, content
+                                  ) model.contents_) in
+             let our_diff = diff_cmd old_page new_page in
+
+             (* Fill out the conflict template. *)
+             template_conflict#set "other_diff" other_diff;
+             template_conflict#set "our_diff" our_diff;
+             template_conflict#set "old_version"
+               (Int32.to_string old_version);
+             template_conflict#set "new_version"
+               (Int32.to_string new_version);
+             template_conflict#set "url" url;
+
+             q#template template_conflict;
+             return () in
+
+      (* General email notification of page edits.  Send an email to
+       * anyone in the page_emails table who has a confirmed address
+       * and who hasn't received an email already today.
+       *)
+      let rows = PGSQL(dbh)
+       "select email, opt_out from page_emails
+          where hostid = $hostid and url = $url
+            and pending is null
+            and last_sent < current_date" in
+      let addrs = List.map (
+       fun (email, opt_out) ->
+         email, opt_out
+      ) rows in
+
+      if addrs <> [] then (
+       (* Construct the email. *)
+       template_email#set "hostname" hostname;
+       template_email#set "page" url;
+
+       let subject =
+         "Site notice: " ^ hostname ^ "/" ^ url ^ " has been updated" in
+
+       let content_type =
+         "text/plain", ["charset", Mimestring.mk_param "UTF-8"] in
+
+       (* Send each email individually (they all have different opt out
+        * links).
         *)
-       if model.id = 0 then (
-         (* Create the page title or URL. *)
-         let url, title =
-           match model.pt with
-               Page url -> url, url
-             | Title title ->
-                 match Wikilib.generate_url_of_title dbh hostid title with
-                     Wikilib.GenURL_OK url -> url, title
-                   | Wikilib.GenURL_Duplicate url ->
-                       error ~back_button:true ~title:"Page exists"
-                         q ("While you were editing that page, it looks " ^
-                            "like another user created the same page.");
-                       return ()
-                   | _ ->
-                       assert false (* This should have been detected in
-                                     * begin_editing_new.
-                                     *) in
-
-         let sth = dbh#prepare_cached "insert into pages (hostid, url, title,
-                                        description, logged_ip, logged_user,
-                                        redirect)
-                                        values (?, ?, ?, ?, ?, ?, ?)" in
-         sth#execute [`Int hostid; `String url; `String title;
-                      `String model.description; logged_ip; logged_user;
-                      redirect];
-
-         let pageid = sth#serial "pages_id_seq" in
-
-         (* Create the page contents. *)
-         let sth = dbh#prepare_cached "insert into contents (pageid,
-                                        ordering, sectionname, divname,
-                                        content)
-                                        values (?, ?, ?, ?, ?)" in
-         let ordering = ref 0 in       (* Creating new ordering. *)
-         List.iter (fun (sectionname, divname, content) ->
-                      let divname =
-                        if string_is_whitespace divname then `Null
-                        else `String divname in
-                      let sectionname =
-                        if string_is_whitespace sectionname then `Null
-                        else `String sectionname in
-                      incr ordering; let ordering = !ordering in
-                      sth#execute [`Int pageid; `Int ordering;
-                                   sectionname; divname;
-                                   `String content])
-           model.contents;
-
-         url, pageid
-       )
-       (* Otherwise it's an old page which we're updating. *)
-       else (
-         (* Pull out fields from the database. *)
-         let sth = dbh#prepare_cached "select creation_date,
-                                               coalesce (url, url_deleted),
-                                               title, css
-                                          from pages
-                                         where hostid = ? and id = ?" in
-         sth#execute [`Int hostid; `Int model.id];
-
-         let creation_date, url, title, css =
-           match sth#fetch1 () with
-               [ creation_date; `String url; `String title; css ] ->
-                 creation_date, url, title, css
-             | _ -> assert false in
-
-         (* Has someone else edited this page in the meantime? *)
-         let sth = dbh#prepare_cached "select max(id) from pages
-                                         where hostid = ? and url = ?" in
-         sth#execute [`Int hostid; `String url];
-
-         let max_id = sth#fetch1int () in
-         let edited = max_id <> model.id in
-
-         if edited then (
-           (* Edited by someone else ...  Get the other's changes. *)
-           let other_diff, _ =
-             get_diff dbh hostid url
-               ~old_version:model.id ~version:max_id () in
-
-           (* Synthesize our own changes. *)
-           let old_page = get_version_for_diff dbh model.id in
-           let new_page =
-             let css = match css with
-                 `Null -> "" | `String css -> css
-               | _ -> assert false in
-             page_for_diff css (List.map (fun (sectionname, _, content) ->
-                               sectionname, content) model.contents) in
-           let our_diff = diff_cmd old_page new_page in
-
-           (* Fill out the conflict template. *)
-           template_conflict#set "other_diff" other_diff;
-           template_conflict#set "our_diff" our_diff;
-           template_conflict#set "old_version" (string_of_int model.id);
-           template_conflict#set "new_version" (string_of_int max_id);
-           template_conflict#set "url" url;
-
-           q#template template_conflict;
-           return ()
-         );
-
-         (* Defer the pages_redirect_cn constraint because that would
-          * temporarily fail on the next UPDATE.
-          *)
-         let sth =
-           dbh#prepare_cached
-             "set constraints pages_redirect_cn, sitemenu_url_cn,
-                   page_emails_url_cn, links_from_cn deferred" in
-         sth#execute [];
-
-         (* Mark the old page as deleted.  NB. There is a small race
-          * condition here because PostgreSQL doesn't do isolation
-          * properly.  If a user tries to visit this page between the
-          * delete and the creation of the new page, then they'll get
-          * a page not found error. (XXX)
-          *)
-         let sth = dbh#prepare_cached "update pages set url_deleted = url,
-                                                         url = null
-                                         where hostid = ? and id = ?" in
-         sth#execute [`Int hostid; `Int model.id];
-
-         (* Create the new page. *)
-         let sth = dbh#prepare_cached "insert into pages (hostid, url, title,
-                                        description, creation_date, logged_ip,
-                                        logged_user, redirect, css)
-                                        values (?, ?, ?, ?, ?, ?, ?, ?, ?)" in
-         sth#execute [`Int hostid; `String url; `String title;
-                      `String model.description; creation_date; logged_ip;
-                      logged_user; redirect; css];
-
-         (* New page ID <> old page ID model.id. *)
-         let pageid = sth#serial "pages_id_seq" in
-
-         (* Create the page contents. *)
-         let sth = dbh#prepare_cached "insert into contents (pageid,
-                                        ordering, sectionname, divname,
-                                        content)
-                                        values (?, ?, ?, ?, ?)" in
-         let ordering = ref 0 in       (* Creating new ordering. *)
-         List.iter (fun (sectionname, divname, content) ->
-                      let divname =
-                        if string_is_whitespace divname then `Null
-                        else `String divname in
-                      let sectionname =
-                        if string_is_whitespace sectionname then `Null
-                        else `String sectionname in
-                      incr ordering; let ordering = !ordering in
-                      sth#execute [`Int pageid; `Int ordering;
-                                   sectionname; divname;
-                                   `String content])
-           model.contents;
-
-         (* General email notification of page edits.  Send an email to
-          * anyone in the page_emails table who has a confirmed address
-          * and who hasn't received an email already today.
-          *)
-         let sth = dbh#prepare_cached "select email, opt_out from page_emails
-                                         where hostid = ? and url = ?
-                                           and pending is null
-                                           and last_sent < current_date" in
-         sth#execute [`Int hostid; `String url];
-
-         let addrs = sth#map (function [`String email; `String opt_out] ->
-                                email, opt_out
-                                | _ -> assert false) in
-
-         if addrs <> [] then (
-           (* Construct the email. *)
-           template_email#set "hostname" hostname;
-           template_email#set "page" url;
-
-           let subject =
-             "Site notice: " ^ hostname ^ "/" ^ url ^ " has been updated" in
-
-           (* Send each email individually (they all have different opt out
-            * links).
-            *)
-           List.iter (fun (to_addr, opt_out) ->
-                        template_email#set "opt_out" opt_out;
-                        let body = template_email#to_string in
-                        Sendmail.send_mail ~subject
-                          ~to_addr:[to_addr] ~body ())
-             addrs
-         );
-
-         (* Update the database to record when these emails were sent. *)
-         let sth = dbh#prepare_cached "update page_emails
-                                           set last_sent = current_date
-                                         where hostid = ? and url = ?
-                                           and pending is null" in
-         sth#execute [`Int hostid; `String url];
-
-         url, pageid
-       ) in
-
-      (* Keep the links table in synch. *)
-      Cocanwiki_links.update_links_for_page dbh hostid url;
+       List.iter (fun (to_addr, opt_out) ->
+                    template_email#set "opt_out" opt_out;
+                    let body = template_email#to_string in
+
+                    let msg = Netsendmail.compose ~to_addrs:["", to_addr]
+                      ~subject ~content_type body in
+                    Netsendmail.sendmail msg)
+         addrs
+      );
+
+      (* Update the database to record when these emails were sent. *)
+      PGSQL(dbh)
+       "update page_emails
+            set last_sent = current_date
+          where hostid = $hostid and url = $url
+            and pending is null";
 
       (* Commit changes to the database. *)
-      dbh#commit ();
+      PGOCaml.commit dbh;
 
       (* Email notification, if anyone is listed for this host. *)
       let subject = "Page " ^ url ^ " has been edited" in
@@ -624,21 +488,21 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user =
        "Page: http://" ^ hostname ^ "/" ^ url ^ "\n\n" ^
        diff in
 
-      email_notify ~body ~subject dbh hostid;
+      email_notify ~body ~subject ~user dbh hostid;
 
       (* Redirect back to the URL. *)
-      q#redirect ("http://" ^ hostname ^ "/" ^ url);
-      return ()
+      q#redirect ("http://" ^ hostname ^ "/" ^ url)
     );
   in
 
   let cancel id =
     let url =
-      if id <> 0 then (
-       let sth = dbh#prepare_cached "select url from pages
-                                       where hostid = ? and id = ?" in
-       sth#execute [`Int hostid; `Int id];
-       sth#fetch1string ()
+      if id <> 0l then (
+       let rows = PGSQL(dbh)
+         "select coalesce (url, url_deleted)
+             from pages
+            where hostid = $hostid and id = $id" in
+       Option.get (List.hd rows)
       ) else if q#param "pt_type" = "page" then
        q#param "pt_value"
       else
@@ -648,11 +512,10 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user =
         *)
        "" in
 
-    q#redirect ("http://" ^ hostname ^ "/" ^ url);
-    return ()
+    q#redirect ("http://" ^ hostname ^ "/" ^ url)
   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.
@@ -664,7 +527,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user =
    *   title - page doesn't yet exist; create it.
    *)
   let id =
-    try Some (int_of_string (q#param "id")) with Not_found -> None in
+    try Some (Int32.of_string (q#param "id")) with Not_found -> None in
   (match id with
      | None ->                         (* Begin editing the page. *)
         if q#param_exists "page" then (