From 71958fc27c100df65016307d29e71e166d7a6906 Mon Sep 17 00:00:00 2001 From: rich Date: Thu, 27 Jul 2006 16:46:55 +0000 Subject: [PATCH] Added external functions allowing the markup to be extended. First extension: {{phone}} which automates CDVMM phone numbers. --- scripts/Makefile | 6 +- scripts/edit.ml | 6 +- scripts/lib/cdvmm_phone_numbers.ml | 149 ++++++++++++++++++++++++++++++++++ scripts/lib/cocanwiki.ml | 6 +- scripts/lib/cocanwiki_ext_calendar.ml | 5 +- scripts/lib/cocanwiki_extensions.ml | 45 ++++++++++ scripts/lib/cocanwiki_links.ml | 12 +-- scripts/lib/cocanwiki_links.mli | 6 +- scripts/lib/cocanwiki_mail.ml | 10 +-- scripts/lib/cocanwiki_mail.mli | 4 +- scripts/lib/cocanwiki_pages.ml | 15 ++-- scripts/lib/cocanwiki_pages.mli | 4 +- scripts/lib/wikilib.ml | 86 +++++++++++++++----- scripts/lib/wikilib.mli | 6 +- scripts/mail_import.ml | 8 +- scripts/mail_rebuild.ml | 4 +- scripts/page.ml | 13 ++- scripts/page_rss.ml | 4 +- scripts/preview.ml | 4 +- scripts/rebuild_links.ml | 4 +- scripts/rename_page.ml | 10 +-- scripts/restore.ml | 4 +- scripts/search.ml | 4 +- scripts/sitemap.ml | 4 +- 24 files changed, 330 insertions(+), 89 deletions(-) create mode 100644 scripts/lib/cdvmm_phone_numbers.ml create mode 100644 scripts/lib/cocanwiki_extensions.ml diff --git a/scripts/Makefile b/scripts/Makefile index e5961de..5b85aaf 100644 --- a/scripts/Makefile +++ b/scripts/Makefile @@ -1,5 +1,5 @@ # Makefile for COCANWIKI. -# $Id: Makefile,v 1.48 2006/07/26 13:11:44 rich Exp $ +# $Id: Makefile,v 1.49 2006/07/27 16:46:55 rich Exp $ include ../Makefile.config @@ -31,6 +31,7 @@ ADMIN_OBJS := $(ADMIN_SRCS:.ml=.cmo) # PGDATABASE=cocanwiki ocamldsort -pp "'$(PGOCAML_PP)'" -byte *.ml *.mli LIB_OBJS := \ lib/cocanwiki_version.cmo \ + lib/cocanwiki_extensions.cmo \ lib/cocanwiki_date.cmo \ lib/cocanwiki_files.cmo \ lib/cocanwiki_server_settings.cmo \ @@ -47,7 +48,8 @@ LIB_OBJS := \ lib/cocanwiki_emailnotify.cmo \ lib/cocanwiki_diff.cmo \ lib/cocanwiki_pages.cmo \ - lib/cocanwiki_mail.cmo + lib/cocanwiki_mail.cmo \ + lib/cdvmm_phone_numbers.cmo INSTDIR := ../html/_bin diff --git a/scripts/edit.ml b/scripts/edit.ml index 001f933..ca86f55 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.30 2006/07/26 13:41:37 rich Exp $ + * $Id: edit.ml,v 1.31 2006/07/27 16:46:55 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 @@ -308,7 +308,7 @@ let run r (q : cgi) dbh hostid {hostname = hostname} user = (match pt with | Page url -> () | Title title -> - match Wikilib.generate_url_of_title dbh hostid title with + match Wikilib.generate_url_of_title r dbh hostid title with | Wikilib.GenURL_OK url -> () | Wikilib.GenURL_Duplicate url -> q#redirect ("http://" ^ hostname ^ "/" ^ url) @@ -395,7 +395,7 @@ let run r (q : cgi) dbh hostid {hostname = hostname} user = let url, pageid = try - save_page dbh hostid ~user ~r model + save_page r dbh hostid ~user model with SaveURLError -> error ~back_button:true ~title:"Page exists" diff --git a/scripts/lib/cdvmm_phone_numbers.ml b/scripts/lib/cdvmm_phone_numbers.ml new file mode 100644 index 0000000..b3b9ea4 --- /dev/null +++ b/scripts/lib/cdvmm_phone_numbers.ml @@ -0,0 +1,149 @@ +(* An example of a pre-page handler and an external function. + * $Id: cdvmm_phone_numbers.ml,v 1.1 2006/07/27 16:46:55 rich Exp $ + *) + +open Apache +open Cgi + +open ExtString + +open Cocanwiki_extensions + +(* Check we're running against the correct website. *) +let rex = + Pcre.regexp "(\\.cdvmortgage\\.com|chasedevere\\.team-?notepad\\.com)$" +let check_website r = + let hostname = + try Request.hostname r + with Not_found -> + failwith "Cdvmm_phone_numbers: no Host header sent in request" in + Pcre.pmatch ~rex (String.lowercase hostname) + +(* The phone numbers. *) +let numbers = [ + "bweb", "0800 358 5062"; (* Bweb *) + "cweb", "0800 358 5063"; (* Cweb *) + "dweb", "0800 358 5064"; (* Dweb *) + "eweb", "0800 358 5066"; (* Eweb *) + "fweb", "0800 358 5067"; (* Fweb *) + "aweb", "0800 358 5068"; (* Aweb (not paid) *) + "mse", "0800 358 5533"; (* Moneysavingexpert *) + "euro", "0800 358 1780"; (* Euro/dollar/euribor/libor *) + "mass", "0800 358 1781"; (* Mortgage broker *) + "offset", "0800 358 1782"; (* Offset *) + "hnw", "0800 358 1783"; (* Professionals / HNW *) + "btl", "0800 358 1784"; (* Buy to let *) + "sp", "0800 358 1785"; (* Subprimes *) + "selfcert", "0800 358 1786"; (* Self-cert *) + "hweb", "0800 358 1787"; (* Hweb (appears in brand adverts) *) + "iweb", "0800 358 1788"; (* Iweb Bidvertiser *) +] + +(* Default numbers go to Fweb. *) +let default_id = "fweb" +let default_number = "0800 358 5067" + +(* The name of the cookie. *) +let cookie_name = "phone" + +(* When cookies expire. *) +let expires = "Wed, 18-May-2033 04:33:20 GMT" + +(* Get the phone cookie if the browser sent one. + * If no phone cookies, raises Not_found. + *) +let get_phone_cookie q = q#cookie cookie_name + +let mse_re = Pcre.regexp ~flags:[`CASELESS] "moneysavingexpert" + +let pre_page r (q : cgi) dbh hostid _ = + if check_website r then ( + let id = + try + (* Get the phone cookie, if it exists. *) + let phone = get_phone_cookie q in + let phone = phone#value in + + (* Is it a valid cookie? If not this raises Not_found and we + * treat it as if we hadn't seen a cookie at all. + *) + ignore (List.assoc phone numbers); + + phone + with + Not_found -> (* No cookie or invalid cookie - send one. *) + (* Which cookie should we send? *) + let id = + let headers = Request.headers_in r in + let referer = + try Table.get headers "Referer" with Not_found -> "" in + if Pcre.pmatch ~rex:mse_re referer then + "mse" + else ( + let utm_source = + try q#param "utm_source" with Not_found -> "" in + let utm_campaign = + try q#param "utm_campaign" with Not_found -> "" in + + if String.starts_with utm_campaign "currency" || + String.starts_with utm_campaign "libor" then + "euro" + else if String.starts_with utm_campaign "mass" then + "mass" + else if String.starts_with utm_campaign "offset" then + "offset" + else if String.starts_with utm_campaign "hnw" then + "hnw" + else if String.starts_with utm_campaign "buy" then + "btl" + else if String.starts_with utm_campaign "sub" then + "sp" + else if String.starts_with utm_campaign "self" then + "selfcert" + else if String.starts_with utm_source "bidver" then + "iweb" + else + default_id + ) in + + let cookie = Cookie.cookie cookie_name id ~path:"/" ~expires in + Table.set (Request.headers_out r) "Set-Cookie" cookie#to_string; + + id in + (* Make a note of the id which we can use in the {{phone}} + * external function (defined below). + *) + let notes = Request.notes r in + Table.set notes cookie_name id + ) + +let phone r dbh hostid _ = + if check_website r then ( + (* Have we got a noted phone number? *) + let notes = Request.notes r in + let id = + try + Table.get notes cookie_name + with + Not_found -> + prerr_endline "Cdvmm_phone_numbers: warning: no 'phone' note"; + default_id in + + (* Is it a valid note? Get the phone number itself. *) + let number = + try List.assoc id numbers + with + Not_found -> + prerr_endline ("Cdvmm_phone_numbers: warning: bad id: " ^ id); + default_number in + + (* Return the number. *) + number + + ) else + "{{phone}}" (* XXX Should be able to decline this call. *) + +(* Register pre-page handler and external function. *) +let () = + pre_page_handlers := pre_page :: !pre_page_handlers; + external_functions := ("phone", phone) :: !external_functions diff --git a/scripts/lib/cocanwiki.ml b/scripts/lib/cocanwiki.ml index 8772306..752c60c 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.12 2006/07/26 16:26:44 rich Exp $ + * $Id: cocanwiki.ml,v 1.13 2006/07/27 16:46:55 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 @@ -321,9 +321,5 @@ let linkname_of_sectionname str = done; str -(* List of extensions currently registered. *) -type extension_t = PGOCaml.pa_pg_data PGOCaml.t -> int32 -> string -> string -let extensions = ref ([] : (string * extension_t) list) - (* Maximum degree of redirection. *) let max_redirect = 4 diff --git a/scripts/lib/cocanwiki_ext_calendar.ml b/scripts/lib/cocanwiki_ext_calendar.ml index bbd5506..bb80fb8 100644 --- a/scripts/lib/cocanwiki_ext_calendar.ml +++ b/scripts/lib/cocanwiki_ext_calendar.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_ext_calendar.ml,v 1.4 2006/07/26 13:12:11 rich Exp $ + * $Id: cocanwiki_ext_calendar.ml,v 1.5 2006/07/27 16:46:55 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 @@ -27,6 +27,7 @@ open Printf open ExtList open Cocanwiki +open Cocanwiki_extensions open Cocanwiki_template open Cocanwiki_strings open Cocanwiki_date @@ -52,7 +53,7 @@ let rec range a b = else [] -let extension dbh hostid url = +let extension r dbh hostid url = (* Validate a date in the form "yyyy[/mm[/dd]]". Returns a (yyyy, mm, dd) * tuple with missing fields set to 0. If the string doesn't parse or the * date isn't valid, then raises Not_found. diff --git a/scripts/lib/cocanwiki_extensions.ml b/scripts/lib/cocanwiki_extensions.ml new file mode 100644 index 0000000..286e372 --- /dev/null +++ b/scripts/lib/cocanwiki_extensions.ml @@ -0,0 +1,45 @@ +(* COCANWIKI - a wiki written in Objective CAML. + * Written by Richard W.M. Jones . + * Copyright (C) 2004-2006 Merjis Ltd. + * $Id: cocanwiki_extensions.ml,v 1.1 2006/07/27 16:46:55 rich Exp $ + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place - Suite 330, + * Boston, MA 02111-1307, USA. + *) + +open Apache +open Cgi + +(* List of extensions currently registered. These are special template + * pages. See for example Cocanwiki_ext_calendar. + *) +type extension_t = + Request.t -> PGOCaml.pa_pg_data PGOCaml.t -> int32 -> string -> string +let extensions : (string * extension_t) list ref = ref [] + +(* List of external functions currently registered. These are used + * within wiki markup as {{function}} or {{function:arg}}. + *) +type external_function_t = + Request.t -> PGOCaml.pa_pg_data PGOCaml.t -> int32 -> + string option -> string +let external_functions : (string * external_function_t) list ref = ref [] + +(* List of external pre-page handlers. These are called before + * each content page is displayed. See page.ml for more details. + *) +type pre_page_handler_t = + Request.t -> cgi -> PGOCaml.pa_pg_data PGOCaml.t -> int32 -> string -> unit +let pre_page_handlers : pre_page_handler_t list ref = ref [] diff --git a/scripts/lib/cocanwiki_links.ml b/scripts/lib/cocanwiki_links.ml index 2589050..423df87 100644 --- a/scripts/lib/cocanwiki_links.ml +++ b/scripts/lib/cocanwiki_links.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_links.ml,v 1.2 2006/03/27 16:43:44 rich Exp $ + * $Id: cocanwiki_links.ml,v 1.3 2006/07/27 16:46:55 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 @@ -30,8 +30,8 @@ let newpage_re = Pcre.regexp "class=\"newpage\"" let href_re = Pcre.regexp "href=\"/(.*?)\"" let title_re = Pcre.regexp "title=\"(.*?)\"" -let get_links_from_section dbh hostid content = - let html = Wikilib.xhtml_of_content dbh hostid content in +let get_links_from_section r dbh hostid content = + let html = Wikilib.xhtml_of_content r dbh hostid content in (* Split into attrs and non-attrs. We end up with a list like this: * [ "
    "; "
  • "; "Some text"; "
    • "; ... ] @@ -80,7 +80,7 @@ let get_links_from_section dbh hostid content = (* Map the titles to URLs. *) List.filter_map (fun title -> - match Wikilib.generate_url_of_title dbh hostid title with + match Wikilib.generate_url_of_title r dbh hostid title with | Wikilib.GenURL_OK url -> Some url | _ -> None) titles in @@ -101,7 +101,7 @@ let insert_link dbh hostid from_url to_url = ) ) -let update_links_for_page dbh hostid page = +let update_links_for_page r dbh hostid page = (* Delete entries in the old links table. *) PGSQL(dbh) "delete from links where hostid = $hostid and from_url = $page"; @@ -117,7 +117,7 @@ let update_links_for_page dbh hostid page = (* Get the links from each section. *) List.iter ( fun content -> - let links = get_links_from_section dbh hostid content in + let links = get_links_from_section r dbh hostid content in List.iter (insert_link dbh hostid page) links ) rows diff --git a/scripts/lib/cocanwiki_links.mli b/scripts/lib/cocanwiki_links.mli index 09ea363..0b76b0f 100644 --- a/scripts/lib/cocanwiki_links.mli +++ b/scripts/lib/cocanwiki_links.mli @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: cocanwiki_links.mli,v 1.2 2006/03/27 16:43:44 rich Exp $ + * $Id: cocanwiki_links.mli,v 1.3 2006/07/27 16:46:55 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 @@ -19,7 +19,7 @@ * Boston, MA 02111-1307, USA. *) -val get_links_from_section : PGOCaml.pa_pg_data PGOCaml.t -> int32 -> string -> string list -val update_links_for_page : PGOCaml.pa_pg_data PGOCaml.t -> int32 -> string -> unit +val get_links_from_section : Apache.Request.t -> PGOCaml.pa_pg_data PGOCaml.t -> int32 -> string -> string list +val update_links_for_page : Apache.Request.t -> PGOCaml.pa_pg_data PGOCaml.t -> int32 -> string -> unit val insert_link : PGOCaml.pa_pg_data PGOCaml.t -> int32 -> string -> string -> unit val what_links_here : PGOCaml.pa_pg_data PGOCaml.t -> int32 -> string -> (string * string) list diff --git a/scripts/lib/cocanwiki_mail.ml b/scripts/lib/cocanwiki_mail.ml index eae28bb..bef38af 100644 --- a/scripts/lib/cocanwiki_mail.ml +++ b/scripts/lib/cocanwiki_mail.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_mail.ml,v 1.3 2006/07/26 13:41:40 rich Exp $ + * $Id: cocanwiki_mail.ml,v 1.4 2006/07/27 16:46:55 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 @@ -162,7 +162,7 @@ type tree = Tree of message option * tree list * The algorithm was originally by JWZ, http://www.jwz.org/doc/threading.html, * simplified and implemented by Radu Grigore . *) -let thread_mail dbh hostid ?user ?r year month = +let thread_mail r dbh hostid ?user year month = (* Pull out all the emails relevant to this month. *) let rows = let year = Int32.of_int year in @@ -341,7 +341,7 @@ let thread_mail dbh hostid ?user ?r year month = let title = sprintf "Mail/%04d/%02d/Thread Index" year month in let url = - match Wikilib.generate_url_of_title dbh hostid title with + match Wikilib.generate_url_of_title r dbh hostid title with Wikilib.GenURL_OK url -> url | Wikilib.GenURL_Duplicate url -> url | Wikilib.GenURL_TooShort | Wikilib.GenURL_BadURL -> @@ -384,7 +384,7 @@ let thread_mail dbh hostid ?user ?r year month = let url = let title = sprintf "Mail/%s (%ld)" subject id in - match Wikilib.generate_url_of_title dbh hostid title with + match Wikilib.generate_url_of_title r dbh hostid title with Wikilib.GenURL_OK url | Wikilib.GenURL_Duplicate url -> url | Wikilib.GenURL_TooShort | Wikilib.GenURL_BadURL -> failwith ("error finding URL for message: " ^ title) in @@ -414,7 +414,7 @@ let thread_mail dbh hostid ?user ?r year month = (* Save the page. *) try - ignore (save_page dbh hostid ?user ?r model) + ignore (save_page r dbh hostid ?user model) with | SaveURLError -> failwith "cocanwiki_mail: thread_mail: unexpected SaveURLError" diff --git a/scripts/lib/cocanwiki_mail.mli b/scripts/lib/cocanwiki_mail.mli index f651106..1353d35 100644 --- a/scripts/lib/cocanwiki_mail.mli +++ b/scripts/lib/cocanwiki_mail.mli @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: cocanwiki_mail.mli,v 1.2 2006/03/27 16:43:44 rich Exp $ + * $Id: cocanwiki_mail.mli,v 1.3 2006/07/27 16:46:55 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 @@ -21,7 +21,7 @@ open Cocanwiki -val thread_mail : PGOCaml.pa_pg_data PGOCaml.t -> int32 -> ?user:user_t -> ?r:Apache.Request.t -> int -> int -> unit +val thread_mail : Apache.Request.t -> PGOCaml.pa_pg_data PGOCaml.t -> int32 -> ?user:user_t -> int -> int -> unit (** [thread_mail dbh hostid year month] rebuilds the thread index * for (year, month). *) diff --git a/scripts/lib/cocanwiki_pages.ml b/scripts/lib/cocanwiki_pages.ml index fc4fce4..31bb251 100644 --- a/scripts/lib/cocanwiki_pages.ml +++ b/scripts/lib/cocanwiki_pages.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_pages.ml,v 1.6 2006/07/26 13:41:40 rich Exp $ + * $Id: cocanwiki_pages.ml,v 1.7 2006/07/27 16:46:55 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 @@ -97,7 +97,7 @@ let load_page dbh hostid ~url ?version () = contents_ = contents } in model -let save_page dbh hostid ?user ?r model = +let save_page r dbh hostid ?user model = (* Logging information, if available. *) let logged_user = match user with @@ -108,11 +108,8 @@ let save_page dbh hostid ?user ?r model = | _ -> None in let logged_ip = - match r with - None -> None - | Some r -> - try Some (Connection.remote_ip (Request.connection r)) - with Not_found -> None in + try Some (Connection.remote_ip (Request.connection r)) + with Not_found -> None in let url, pageid = (* Creating a new page (id = 0)? If so, we're just going to insert @@ -124,7 +121,7 @@ let save_page dbh hostid ?user ?r model = match model.pt with Page url -> url, url | Title title -> - match Wikilib.generate_url_of_title dbh hostid title with + match Wikilib.generate_url_of_title r dbh hostid title with Wikilib.GenURL_OK url -> url, title | _ -> raise SaveURLError in @@ -236,6 +233,6 @@ let save_page dbh hostid ?user ?r model = ) in (* Keep the links table in synch. *) - Cocanwiki_links.update_links_for_page dbh hostid url; + Cocanwiki_links.update_links_for_page r dbh hostid url; url, pageid diff --git a/scripts/lib/cocanwiki_pages.mli b/scripts/lib/cocanwiki_pages.mli index 81a41db..fb7c8c5 100644 --- a/scripts/lib/cocanwiki_pages.mli +++ b/scripts/lib/cocanwiki_pages.mli @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: cocanwiki_pages.mli,v 1.3 2006/07/26 13:41:40 rich Exp $ + * $Id: cocanwiki_pages.mli,v 1.4 2006/07/27 16:46:55 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 @@ -52,7 +52,7 @@ val load_page : PGOCaml.pa_pg_data PGOCaml.t -> int32 -> url:string -> ?version: * @raise Not_found If the page cannot be found. *) -val save_page : PGOCaml.pa_pg_data PGOCaml.t -> int32 -> ?user:user_t -> ?r:Apache.Request.t -> model -> string * int32 +val save_page : Apache.Request.t -> PGOCaml.pa_pg_data PGOCaml.t -> int32 -> ?user:user_t -> model -> string * int32 (** Save a page. If the page is new, this creates a new page in the * database. If the page is old, then the page is edited. * diff --git a/scripts/lib/wikilib.ml b/scripts/lib/wikilib.ml index e0213d3..9a71a40 100644 --- a/scripts/lib/wikilib.ml +++ b/scripts/lib/wikilib.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: wikilib.ml,v 1.7 2006/07/26 15:01:17 rich Exp $ + * $Id: wikilib.ml,v 1.8 2006/07/27 16:46:55 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 @@ -28,6 +28,7 @@ open Printf open ExtString open Cocanwiki_strings +open Cocanwiki_extensions (* Generate a URL for a new page with the given title. This code checks * if the URL already exists in the database and can return one of several @@ -40,14 +41,15 @@ type genurl_error_t = GenURL_OK of string let nontrivial_re = Pcre.regexp ~flags:[`CASELESS] "[a-z0-9]" -let generate_url_of_title dbh hostid title = +let generate_url_of_title r dbh hostid title = (* Create a suitable URL from this title. *) let url = String.map (function | '\000' .. ' ' | '<' | '>' | '&' | '"' | '+' | '#' | '%' | '?' -> '_' - | c -> Char.lowercase c) title in + | ('A' .. 'Z' as c) -> Char.lowercase c + | c -> c) title in (* Check URL is not too trivial. *) if not (Pcre.pmatch ~rex:nontrivial_re url) then @@ -92,9 +94,15 @@ let obscure_mailto url = (* This matches any markup. *) let markup_re = + (* A link, like [[...]]. *) let link = "\\[\\[\\s*(?:.+?)\\s*(?:\\|.+?\\s*)?\\]\\]" in - let tag = "" in - Pcre.regexp ("(.*?)((?:" ^ link ^ ")|(?:" ^ tag ^ "))(.*)") + (* A restricted HTML element, like or . *) + let tag = + "" in + (* An external function call, like {{call}} or {{call:arg}}. *) + let func = "{{(?:\\w+)(?::.*?)?}}" in + (* Combined. *) + Pcre.regexp ("(.*?)((?:" ^ link ^ ")|(?:" ^ tag ^ ")|(?:" ^ func ^ "))(.*)") (* This matches links only, and should be compatible with the link contained * in the above regexp. @@ -109,8 +117,13 @@ let file_re = let url_re = Pcre.regexp "^[a-z]+://" let mailto_re = Pcre.regexp "^mailto:" +(* This matches external function calls only, and should be compatible + * with the link contained in the above regexp. + *) +let func_re = Pcre.regexp "{{(\\w+)(?::(.*?))?}}" + (* Links. *) -let markup_link dbh hostid link = +let markup_link r dbh hostid link = let subs = Pcre.exec ~rex:link_re link in let url = Pcre.get_substring subs 1 in @@ -273,12 +286,32 @@ let markup_link dbh hostid link = escape_html text ^ "" ) +let markup_function r dbh hostid str = + let subs = Pcre.exec ~rex:func_re str in + let function_name = Pcre.get_substring subs 1 in + let function_arg = + try Some (Pcre.get_substring subs 2) with Not_found -> None in + + (* Look to see if there is a registered external function + * with that name. + *) + try + let fn = List.assoc function_name !external_functions in + + (* Call the external function and return the result. *) + fn r dbh hostid function_arg + + with + Not_found -> + str (* Not found - return the original string. *) + type find_t = FoundNothing | FoundOpen of string * string * string | FoundClose of string * string * string * string | FoundLink of string * string * string + | FoundCall of string * string * string -let _markup_paragraph dbh hostid text = +let _markup_paragraph r dbh hostid text = let find_earliest_markup text = let convert_b_and_i elem = if elem = "b" then "strong" @@ -293,7 +326,7 @@ let _markup_paragraph dbh hostid text = let rest = Pcre.get_substring subs 3 in if String.length markup > 2 && markup.[0] = '[' && markup.[1] = '[' then ( - let link = markup_link dbh hostid markup in + let link = markup_link r dbh hostid markup in FoundLink (first, link, rest) ) else if String.length markup > 2 && @@ -307,6 +340,11 @@ let _markup_paragraph dbh hostid text = let elem = convert_b_and_i elem in FoundOpen (first, elem, rest) ) + else if String.length markup > 2 && + markup.[0] = '{' && markup.[1] = '{' then ( + let call = markup_function r dbh hostid markup in + FoundCall (first, call, rest) + ) else failwith ("bad regexp: markup is '" ^ markup ^ "'"); with @@ -359,6 +397,8 @@ let _markup_paragraph dbh hostid text = escape_html first :: "<" :: elem :: ">" :: loop (rest, [elem]) | FoundLink (first, link, rest) -> escape_html first :: link :: loop (rest, []) + | FoundCall (first, link, rest) -> + escape_html first :: link :: loop (rest, []) ) | text, ((x :: xs) as stack) -> @@ -387,6 +427,9 @@ let _markup_paragraph dbh hostid text = | FoundLink (first, link, rest) -> (* link *) escape_html first :: link :: loop (rest, stack) + | FoundCall (first, link, rest) -> + (* external function *) + escape_html first :: link :: loop (rest, stack) ) in @@ -396,24 +439,24 @@ let _markup_paragraph dbh hostid text = (*prerr_endline ("after loop = " ^ text);*) text -let markup_paragraph ~first_para dbh hostid text = +let markup_paragraph ~first_para r dbh hostid text = let p = if first_para then "

    " else "

    " in - p ^ _markup_paragraph dbh hostid text ^ "

    " + p ^ _markup_paragraph r dbh hostid text ^ "

    " -let markup_heading dbh hostid level text = - let text = _markup_paragraph dbh hostid text in +let markup_heading r dbh hostid level text = + let text = _markup_paragraph r dbh hostid text in sprintf "%s" level text level -let markup_ul dbh hostid lines = +let markup_ul r dbh hostid lines = "
    • " ^ String.concat "
      • \n
    • " - (List.map (fun t -> _markup_paragraph dbh hostid t) lines) ^ + (List.map (fun t -> _markup_paragraph r dbh hostid t) lines) ^ "
    " -let markup_ol dbh hostid lines = +let markup_ol r dbh hostid lines = "
    1. " ^ String.concat "
      2. \n
    2. " - (List.map (fun t -> _markup_paragraph dbh hostid t) lines) ^ + (List.map (fun t -> _markup_paragraph r dbh hostid t) lines) ^ "
    " let markup_pre lines = @@ -642,7 +685,7 @@ let html_open_re = Pcre.regexp "^\\s*$" let html_close_re = Pcre.regexp "^\\s*$" let macro_re = Pcre.regexp "^{{(\\w+)}}\\s*$" -let xhtml_of_content dbh hostid text = +let xhtml_of_content r dbh hostid text = (* Split the text into lines. *) let lines = Pcre.split ~rex:split_lines_re text in @@ -786,13 +829,14 @@ let xhtml_of_content dbh hostid text = match st with | STBlank -> assert false (* Should never happen. *) | STParagraph para -> - markup_paragraph ~first_para:!first_para dbh hostid para + let first_para = !first_para in + markup_paragraph ~first_para r dbh hostid para | STHeading (level, text) -> - markup_heading dbh hostid level text + markup_heading r dbh hostid level text | STUnnumbered lines -> - markup_ul dbh hostid lines + markup_ul r dbh hostid lines | STNumbered lines -> - markup_ol dbh hostid lines + markup_ol r dbh hostid lines | STPreformatted lines -> markup_pre lines | STHTML html -> diff --git a/scripts/lib/wikilib.mli b/scripts/lib/wikilib.mli index d1b0c57..463a0f2 100644 --- a/scripts/lib/wikilib.mli +++ b/scripts/lib/wikilib.mli @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: wikilib.mli,v 1.2 2006/03/27 16:43:44 rich Exp $ + * $Id: wikilib.mli,v 1.3 2006/07/27 16:46:55 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 @@ -24,8 +24,8 @@ type genurl_error_t = GenURL_OK of string | GenURL_BadURL | GenURL_Duplicate of string -val generate_url_of_title : PGOCaml.pa_pg_data PGOCaml.t -> int32 -> string -> genurl_error_t +val generate_url_of_title : Apache.Request.t -> PGOCaml.pa_pg_data PGOCaml.t -> int32 -> string -> genurl_error_t -val xhtml_of_content : PGOCaml.pa_pg_data PGOCaml.t -> int32 -> string -> string +val xhtml_of_content : Apache.Request.t -> PGOCaml.pa_pg_data PGOCaml.t -> int32 -> string -> string val text_of_xhtml : string -> string diff --git a/scripts/mail_import.ml b/scripts/mail_import.ml index 44d2b41..572375d 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.13 2006/07/26 13:41:37 rich Exp $ + * $Id: mail_import.ml,v 1.14 2006/07/27 16:46:55 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 @@ -197,7 +197,7 @@ let run r (q : cgi) dbh hostid _ user = (* Choose a suitable URL. *) let url = - match Wikilib.generate_url_of_title dbh hostid title with + match Wikilib.generate_url_of_title r dbh hostid title with (* Duplicate URL is OK - eg. in the case where we are overwriting * an already imported message. *) @@ -349,11 +349,11 @@ let run r (q : cgi) dbh hostid _ user = * them because we want to script to fail abruptly if any of these * unexpected conditions arises. *) - ignore (save_page dbh hostid ~user ~r model); + ignore (save_page r dbh hostid ~user model); (* Rebuild threads? *) if rebuild then - thread_mail dbh hostid ~user ~r + thread_mail r dbh hostid ~user (Calendar.year (fst message_date)) (Date.int_of_month (Calendar.month (fst message_date))); diff --git a/scripts/mail_rebuild.ml b/scripts/mail_rebuild.ml index a16314a..458c692 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.4 2006/03/28 16:24:07 rich Exp $ + * $Id: mail_rebuild.ml,v 1.5 2006/07/27 16:46:55 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,7 +32,7 @@ let run r (q : cgi) dbh hostid _ user = let year = int_of_string (q#param "year") in let month = int_of_string (q#param "month") in - thread_mail dbh hostid ~user ~r year month; + thread_mail r dbh hostid ~user year month; (* Commit to the database. *) PGOCaml.commit dbh; diff --git a/scripts/page.ml b/scripts/page.ml index d1e8b09..dcc0f5a 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.47 2006/07/26 13:19:49 rich Exp $ + * $Id: page.ml,v 1.48 2006/07/27 16:46:55 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,6 +33,7 @@ open Cocanwiki_ok open Cocanwiki_date open Cocanwiki_server_settings open Cocanwiki_links +open Cocanwiki_extensions type fp_status = FPOK of int32 * string * string * Calendar.t * bool | FPInternalRedirect of string @@ -218,6 +219,12 @@ let run r (q : cgi) dbh hostid t#set "old_version" (Int32.to_string pageid); th#set "old_version" (Int32.to_string pageid)); + (* Just before we show the header, call any registered pre-page + * handlers. They might want to send cookies. + *) + List.iter (fun handler -> + handler r q dbh hostid page') !pre_page_handlers; + (* At this point, we can print out the header and flush it back to * the user, allowing the browser to start fetching stylesheets * and background images while we compose the page. @@ -265,7 +272,7 @@ let run r (q : cgi) dbh hostid "linkname", Template.VarString linkname; "content", Template.VarString - (Wikilib.xhtml_of_content dbh hostid content); + (Wikilib.xhtml_of_content r dbh hostid content); "has_divname", Template.VarConditional has_divname; "divname", Template.VarString divname; "has_jsgo", Template.VarConditional has_jsgo; @@ -276,7 +283,7 @@ let run r (q : cgi) dbh hostid match extension with None -> sections | Some extension -> - let content = extension dbh hostid page' in + let content = extension r dbh hostid page' in let section = [ "ordering", Template.VarString "0"; "has_sectionname", Template.VarConditional false; diff --git a/scripts/page_rss.ml b/scripts/page_rss.ml index b6bc2e0..a11103a 100644 --- a/scripts/page_rss.ml +++ b/scripts/page_rss.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_rss.ml,v 1.4 2006/03/28 16:24:08 rich Exp $ + * $Id: page_rss.ml,v 1.5 2006/07/27 16:46:55 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 @@ -71,7 +71,7 @@ let run r (q : cgi) dbh hostid {hostname = hostname} _ = List.map (fun (sectionname, content) -> let sectionname = match sectionname with | None -> "" | Some s -> s in - let content = Wikilib.xhtml_of_content dbh hostid content in + let content = Wikilib.xhtml_of_content r dbh hostid content in let linkname = linkname_of_sectionname sectionname in [ "sectionname", Template.VarString sectionname; "linkname", Template.VarString linkname; diff --git a/scripts/preview.ml b/scripts/preview.ml index fcadfdb..4e0e9ea 100644 --- a/scripts/preview.ml +++ b/scripts/preview.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: preview.ml,v 1.8 2006/03/27 18:09:46 rich Exp $ + * $Id: preview.ml,v 1.9 2006/07/27 16:46:55 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 @@ open Cocanwiki let run r (q : cgi) dbh hostid _ _ = let content = q#param "content" in - let xhtml = Wikilib.xhtml_of_content dbh hostid content in + let xhtml = Wikilib.xhtml_of_content r dbh hostid content in q#header ~content_type:"text/html; charset=utf-8" (); ignore (print_string r xhtml) diff --git a/scripts/rebuild_links.ml b/scripts/rebuild_links.ml index 21c2904..50e8d7e 100644 --- a/scripts/rebuild_links.ml +++ b/scripts/rebuild_links.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: rebuild_links.ml,v 1.6 2006/03/28 16:24:08 rich Exp $ + * $Id: rebuild_links.ml,v 1.7 2006/07/27 16:46:55 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 @@ -63,7 +63,7 @@ let run r (q : cgi) dbh hostid _ _ = template#set "pc" (string_of_int pc); ignore (print_string r template#to_string); - let links = get_links_from_section dbh hostid content in + let links = get_links_from_section r dbh hostid content in List.iter (insert_link dbh hostid url) links ) sections; diff --git a/scripts/rename_page.ml b/scripts/rename_page.ml index 3e257dc..8c0b0ed 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.6 2006/07/26 13:12:10 rich Exp $ + * $Id: rename_page.ml,v 1.7 2006/07/27 16:46:55 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 @@ -56,7 +56,7 @@ let run r (q : cgi) dbh hostid {hostname = hostname} user = let new_page = if page = "index" then page else - match Wikilib.generate_url_of_title dbh hostid new_title with + match Wikilib.generate_url_of_title r dbh hostid new_title with | Wikilib.GenURL_OK url | Wikilib.GenURL_Duplicate url -> url | Wikilib.GenURL_TooShort | Wikilib.GenURL_BadURL -> error ~title:"Bad title" ~back_button:true @@ -70,7 +70,7 @@ let run r (q : cgi) dbh hostid {hostname = hostname} user = (* If it's the same as the old URL, then this is a simple title change. *) let model = load_page dbh hostid ~url:page () in let model = { model with pt = Title new_title } in - let url, _ = save_page dbh hostid ~user ~r model in + let url, _ = save_page r dbh hostid ~user model in assert (url = new_page) ) else ( (* Not the same as the old URL, so set the old page to a redirect and @@ -81,10 +81,10 @@ let run r (q : cgi) dbh hostid {hostname = hostname} user = let new_model = { new_model with description = old_model.description; contents_ = old_model.contents_ } in let old_model = { old_model with redirect = Some new_page } in - ignore (save_page dbh hostid ~user ~r old_model); + ignore (save_page r dbh hostid ~user old_model); try - ignore (save_page dbh hostid ~user ~r new_model) + ignore (save_page r dbh hostid ~user new_model) with SaveURLError -> error ~title:"Page exists" diff --git a/scripts/restore.ml b/scripts/restore.ml index 431a937..e41d364 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.22 2006/07/26 13:41:37 rich Exp $ + * $Id: restore.ml,v 1.23 2006/07/27 16:46:55 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 @@ -78,7 +78,7 @@ let run r (q : cgi) dbh hostid {hostname = hostname} user = where pageid = $version"; (* Keep the links table in synch. *) - Cocanwiki_links.update_links_for_page dbh hostid page; + Cocanwiki_links.update_links_for_page r dbh hostid page; PGOCaml.commit dbh; diff --git a/scripts/search.ml b/scripts/search.ml index 13899ce..a4ac393 100644 --- a/scripts/search.ml +++ b/scripts/search.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: search.ml,v 1.10 2006/03/28 16:24:08 rich Exp $ + * $Id: search.ml,v 1.11 2006/07/27 16:46:55 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 @@ -186,7 +186,7 @@ let run r (q : cgi) dbh hostid host user = let content = truncate 160 (Wikilib.text_of_xhtml - (Wikilib.xhtml_of_content dbh hostid content)) in + (Wikilib.xhtml_of_content r dbh hostid content)) in let linkname = linkname_of_sectionname sectionname in let last_modified = printable_date last_modified in [ "url", Template.VarString url; diff --git a/scripts/sitemap.ml b/scripts/sitemap.ml index 1aa8f24..1220324 100644 --- a/scripts/sitemap.ml +++ b/scripts/sitemap.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: sitemap.ml,v 1.9 2006/03/28 16:24:08 rich Exp $ + * $Id: sitemap.ml,v 1.10 2006/07/27 16:46:55 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 @@ -60,7 +60,7 @@ let run r (q : cgi) dbh hostid { hostname = hostname } _ = | Some c -> truncate 160 (Wikilib.text_of_xhtml - (Wikilib.xhtml_of_content dbh hostid c))) ] + (Wikilib.xhtml_of_content r dbh hostid c))) ] | _ -> assert false) rows in template#set "hostname" hostname; -- 1.8.3.1