Added code to use and manage this permission.
Fixed certain scripts which are "CanView"-only.
feedback_email text,
mailing_list boolean DEFAULT false NOT NULL,
is_template boolean DEFAULT false NOT NULL,
- search_box boolean DEFAULT true NOT NULL
+ search_box boolean DEFAULT true NOT NULL,
+ view_anon boolean DEFAULT true NOT NULL
);
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: cocanwiki.ml,v 1.13 2004/09/27 12:37:54 rich Exp $
+ * $Id: cocanwiki.ml,v 1.14 2004/10/04 15:19:56 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
*)
let _get_dbh r = Pool.get r "cocanwiki"
+(* The "host object". *)
+type host_t = { hostname : string;
+ edit_anon : bool;
+ view_anon : bool }
+
(* Permissions and restrictions.
*
* Use the optional ~restrict parameter to register_script to restrict
* who can use the script. For example:
* register_script ~restrict:[CanEdit ; CanManageUsers] run
*)
-type permissions_t = CanEdit | CanManageUsers | CanManageContacts
+type permissions_t = CanView | CanEdit | CanManageUsers | CanManageContacts
| CanManageSite | CanEditGlobalCSS
(* The "user object". *)
| User of int * string * permissions_t list
(* Userid, name, permissions. *)
-let test_permission edit_anon perm user =
+let test_permission {edit_anon = edit_anon; view_anon = view_anon} perm user =
if perm = CanEdit && edit_anon then true
+ else if perm = CanView && view_anon then true
else match user with
Anonymous -> false
| User (_, _, perms) -> List.mem perm perms
-let can_edit edit_anon = test_permission edit_anon CanEdit
-let can_manage_users = test_permission false CanManageUsers
-let can_manage_contacts = test_permission false CanManageContacts
-let can_manage_site = test_permission false CanManageSite
-let can_edit_global_css = test_permission false CanEditGlobalCSS
-
-(* The "host object". *)
-type host_t = { hostname : string;
- edit_anon : bool; }
+let can_edit host = test_permission host CanEdit
+let can_manage_users host = test_permission host CanManageUsers
+let can_manage_contacts host = test_permission host CanManageContacts
+let can_manage_site host = test_permission host CanManageSite
+let can_edit_global_css host = test_permission host CanEditGlobalCSS
(* Our wrapper around the standard [register_script] function.
*
(* Get the host ID, by comparing the Host: header with the hostnames
* table in the database.
*)
- let hostid, hostname, edit_anon =
+ let hostid, hostname, edit_anon, view_anon =
let hostname = try Request.hostname r
with Not_found -> failwith "No ``Host:'' header in request" in
let hostname = String.lowercase hostname in
let sth =
dbh#prepare_cached
- "select h.id, h.canonical_hostname, h.edit_anon
+ "select h.id, h.canonical_hostname, h.edit_anon, h.view_anon
from hostnames hn, hosts h
where hn.name = ? and hn.hostid = h.id" in
sth#execute [`String hostname];
try
(match sth#fetch1 () with
- [ `Int id; `String hostname; `Bool edit_anon ] ->
- id, hostname, edit_anon
+ [ `Int id; `String hostname;
+ `Bool edit_anon; `Bool view_anon ] ->
+ id, hostname, edit_anon, view_anon
| _ -> assert false)
with
Not_found ->
"the hosts/hostnames tables in the database.") in
(* Create the host object. *)
- let host = { hostname = hostname; edit_anon = edit_anon; } in
+ let host = { hostname = hostname;
+ edit_anon = edit_anon;
+ view_anon = view_anon } in
(* Look for the user's cookie, and determine from this the user
* object.
`Bool can_edit; `Bool can_manage_users;
`Bool can_manage_contacts; `Bool can_manage_site;
`Bool can_edit_global_css ] ->
- let perms = if can_edit then [ CanEdit ] else [] in
+ (* Every logged in user can view. *)
+ let perms = [CanView] in
+ let perms =
+ if can_edit then CanEdit :: perms
+ else perms in
let perms =
if can_manage_users then CanManageUsers :: perms
else perms in
[] -> true (* empty list = no restrictions *)
| rs ->
List.fold_left (||) false
- (List.map (fun r -> test_permission edit_anon r user) rs) in
+ (List.map (fun r -> test_permission host r user) rs) in
if permitted then (
(* Call the actual CGI script. *)
run r q dbh hostid host user
- ) else
- error ~back_button:true
- ~title:"Access denied"
- q "You do not have permission to access this part of the site."
+ ) else (
+ if user = Anonymous then
+ q#redirect ("http://" ^ hostname ^ "/_login")
+ else
+ error ~back_button:true
+ ~title:"Access denied"
+ q "You do not have permission to access this part of the site."
+ )
)
(* Convert a section name into something valid for use in <a name="...">
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: contact.ml,v 1.5 2004/09/27 12:37:54 rich Exp $
+ * $Id: contact.ml,v 1.6 2004/10/04 15:19:56 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
q "An email was sent and you should receive a reply shortly."
let () =
- register_script run
+ register_script ~restrict:[CanView] run
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: dead_ends.ml,v 1.1 2004/09/28 11:51:38 rich Exp $
+ * $Id: dead_ends.ml,v 1.2 2004/10/04 15:19:56 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
q#template template
let () =
- register_script run
+ register_script ~restrict:[CanView] run
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: edit_host_css.ml,v 1.1 2004/09/22 11:41:03 rich Exp $
+ * $Id: edit_host_css.ml,v 1.2 2004/10/04 15:19:56 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
"Note: You must RELOAD the page to see changes to stylesheets.")
let () =
- register_script run
+ register_script ~restrict:[CanEdit] run
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: edit_host_css_form.ml,v 1.1 2004/09/22 11:41:03 rich Exp $
+ * $Id: edit_host_css_form.ml,v 1.2 2004/10/04 15:19:56 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
q#template template
let () =
- register_script run
+ register_script ~restrict:[CanEdit] run
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: edit_host_settings.ml,v 1.4 2004/09/27 16:21:09 rich Exp $
+ * $Id: edit_host_settings.ml,v 1.5 2004/10/04 15:19:56 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
let feedback_email = q#param "feedback_email" in
let mailing_list = q#param_true "mailing_list" in
let search_box = q#param_true "search_box" in
+ let view_anon = q#param_true "view_anon" in
let theme_css = if theme_css = "" then `Null else `String theme_css in
let feedback_email =
let sth = dbh#prepare_cached "update hosts set edit_anon = ?,
create_account_anon = ?, theme_css = ?,
feedback_email = ?, mailing_list = ?,
- search_box = ?
+ search_box = ?, view_anon = ?
where id = ?" in
sth#execute [`Bool edit_anon; `Bool create_account_anon;
theme_css; feedback_email; `Bool mailing_list; `Bool search_box;
+ `Bool view_anon;
`Int hostid];
dbh#commit ();
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: edit_host_settings_form.ml,v 1.3 2004/09/27 16:21:09 rich Exp $
+ * $Id: edit_host_settings_form.ml,v 1.4 2004/10/04 15:19:56 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
let sth =
dbh#prepare_cached
"select canonical_hostname, edit_anon, create_account_anon, theme_css,
- feedback_email, mailing_list, search_box
+ feedback_email, mailing_list, search_box, view_anon
from hosts where id = ?" in
sth#execute [`Int hostid];
let canonical_hostname, edit_anon, create_account_anon, theme_css,
- feedback_email, mailing_list, search_box =
+ feedback_email, mailing_list, search_box, view_anon =
match sth#fetch1 () with
[ `String canonical_hostname;
`Bool edit_anon; `Bool create_account_anon;
(`String _ | `Null) as theme_css;
(`String _ | `Null) as feedback_email;
- `Bool mailing_list; `Bool search_box ] ->
+ `Bool mailing_list; `Bool search_box; `Bool view_anon ] ->
let theme_css =
match theme_css with `String s -> s | `Null -> "" in
let feedback_email =
match feedback_email with `String s -> s | `Null -> "" in
canonical_hostname, edit_anon, create_account_anon, theme_css,
- feedback_email, mailing_list, search_box
+ feedback_email, mailing_list, search_box, view_anon
| _ -> assert false in
template#set "canonical_hostname" canonical_hostname;
template#set "feedback_email" feedback_email;
template#conditional "mailing_list" mailing_list;
template#conditional "search_box" search_box;
+ template#conditional "view_anon" view_anon;
(* Themes table. *)
let table =
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: file.ml,v 1.6 2004/09/27 12:37:54 rich Exp $
+ * $Id: file.ml,v 1.7 2004/10/04 15:19:56 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
print_string r data
let () =
- register_script run
+ register_script ~restrict:[CanView] run
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: host_menu.ml,v 1.3 2004/09/27 16:21:09 rich Exp $
+ * $Id: host_menu.ml,v 1.4 2004/10/04 15:19:56 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
"select h.canonical_hostname, h.css is not null, h.edit_anon,
h.create_account_anon, h.theme_css is not null,
t.name, t.description, h.feedback_email, h.mailing_list,
- h.search_box
+ h.search_box, h.view_anon
from hosts h left outer join themes t on h.theme_css = t.theme_css
where h.id = ?" in
sth#execute [`Int hostid];
let canonical_hostname, has_global_css, edit_anon, create_account_anon,
has_theme_css, theme_name, theme_description, has_feedback_email,
- feedback_email, mailing_list, search_box =
+ feedback_email, mailing_list, search_box, view_anon =
match sth#fetch1 () with
[ `String canonical_hostname; `Bool has_global_css;
`Bool edit_anon; `Bool create_account_anon; `Bool has_theme_css;
(`String _ | `Null) as theme_name;
(`String _ | `Null) as theme_description;
(`String _ | `Null) as feedback_email;
- `Bool mailing_list; `Bool search_box ] ->
+ `Bool mailing_list; `Bool search_box; `Bool view_anon ] ->
let theme_name =
match theme_name with `String s -> s | `Null -> "" in
let theme_description =
| `Null -> "", false in
canonical_hostname, has_global_css, edit_anon, create_account_anon,
has_theme_css, theme_name, theme_description, has_feedback_email,
- feedback_email, mailing_list, search_box
+ feedback_email, mailing_list, search_box, view_anon
| _ -> assert false in
template#set "canonical_hostname" canonical_hostname;
template#set "feedback_email" feedback_email;
template#conditional "mailing_list" mailing_list;
template#conditional "search_box" search_box;
+ template#conditional "view_anon" view_anon;
q#template template
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: image.ml,v 1.6 2004/09/27 12:37:54 rich Exp $
+ * $Id: image.ml,v 1.7 2004/10/04 15:19:56 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
print_string r data
let () =
- register_script run
+ register_script ~restrict:[CanView] run
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: largest_pages.ml,v 1.2 2004/09/28 11:51:38 rich Exp $
+ * $Id: largest_pages.ml,v 1.3 2004/10/04 15:19:56 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
q#template template
let () =
- register_script run
+ register_script ~restrict:[CanView] run
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: mailing_list_confirm.ml,v 1.2 2004/09/24 16:45:02 rich Exp $
+ * $Id: mailing_list_confirm.ml,v 1.3 2004/10/04 15:19:56 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
"You are now on our mailing list.")
let () =
- register_script run
+ register_script ~restrict:[CanView] run
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: mailing_list_form.ml,v 1.1 2004/09/24 16:41:16 rich Exp $
+ * $Id: mailing_list_form.ml,v 1.2 2004/10/04 15:19:56 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
q#template template
let () =
- register_script run
+ register_script ~restrict:[CanView] run
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: mailing_list_send.ml,v 1.3 2004/09/24 17:11:57 rich Exp $
+ * $Id: mailing_list_send.ml,v 1.4 2004/10/04 15:19:56 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
"first link in that email to confirm.")
let () =
- register_script run
+ register_script ~restrict:[CanView] run
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: page.ml,v 1.24 2004/09/27 18:08:02 rich Exp $
+ * $Id: page.ml,v 1.25 2004/10/04 15:19:56 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
let xhtml_re = Pcre.regexp "<.*?>|[^<>]+"
-let run r (q : cgi) (dbh : Dbi.connection) hostid {edit_anon=edit_anon} user =
+let run r (q : cgi) (dbh : Dbi.connection) hostid
+ ({ edit_anon = edit_anon;
+ view_anon = view_anon } as host)
+ user =
let template_page = get_template dbh hostid "page.html" in
let template_404 = get_template dbh hostid "page_404.html" in
| _ -> assert false in
(* Can the user edit? Manage users? etc. *)
- let can_edit = can_edit edit_anon user in
- let can_manage_users = can_manage_users user in
- let can_manage_contacts = can_manage_contacts user in
- let can_manage_site = can_manage_site user in
- let can_edit_global_css = can_edit_global_css user in
+ let can_edit = can_edit host user in
+ let can_manage_users = can_manage_users host user in
+ let can_manage_contacts = can_manage_contacts host user in
+ let can_manage_site = can_manage_site host user in
+ let can_edit_global_css = can_edit_global_css host user in
(* Do we have a stats page set up? *)
let has_stats = server_settings_stats_page dbh <> None in
loop page 0
let () =
- register_script run
+ register_script ~restrict:[CanView] run
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: page_email_confirm.ml,v 1.1 2004/09/24 15:53:57 rich Exp $
+ * $Id: page_email_confirm.ml,v 1.2 2004/10/04 15:19:56 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
"an email whenever that page is updated.")
let () =
- register_script run
+ register_script ~restrict:[CanView] run
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: page_email_form.ml,v 1.1 2004/09/24 15:53:57 rich Exp $
+ * $Id: page_email_form.ml,v 1.2 2004/10/04 15:19:56 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
q#template template
let () =
- register_script run
+ register_script ~restrict:[CanView] run
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: page_email_send.ml,v 1.1 2004/09/24 15:53:57 rich Exp $
+ * $Id: page_email_send.ml,v 1.2 2004/10/04 15:19:56 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
"first link in that email to confirm.")
let () =
- register_script run
+ register_script ~restrict:[CanView] run
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: preview.ml,v 1.4 2004/09/09 12:21:22 rich Exp $
+ * $Id: preview.ml,v 1.5 2004/10/04 15:19:56 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
print_string r xhtml
let () =
- register_script run
+ register_script ~restrict:[CanView] run
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: rss.ml,v 1.1 2004/09/20 15:34:36 rich Exp $
+ * $Id: rss.ml,v 1.2 2004/10/04 15:19:56 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
q#template ~content_type:"text/xml" template
let () =
- register_script run
+ register_script ~restrict:[CanView] run
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: search.ml,v 1.4 2004/09/09 12:21:22 rich Exp $
+ * $Id: search.ml,v 1.5 2004/10/04 15:19:56 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
q#redirect query
let () =
- register_script run
+ register_script ~restrict:[CanView] run
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: send_feedback.ml,v 1.2 2004/09/23 11:56:47 rich Exp $
+ * $Id: send_feedback.ml,v 1.3 2004/10/04 15:19:56 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
q "An email has been sent to the site administrators."
let () =
- register_script run
+ register_script ~restrict:[CanView] run
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: send_feedback_form.ml,v 1.2 2004/09/26 17:49:46 rich Exp $
+ * $Id: send_feedback_form.ml,v 1.3 2004/10/04 15:19:56 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
q#template template
let () =
- register_script run
+ register_script ~restrict:[CanView] run
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: sitemap.ml,v 1.6 2004/09/09 12:21:22 rich Exp $
+ * $Id: sitemap.ml,v 1.7 2004/10/04 15:19:56 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
q#template template
let () =
- register_script run
+ register_script ~restrict:[CanView] run
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: what_links_here.ml,v 1.2 2004/09/28 11:56:52 rich Exp $
+ * $Id: what_links_here.ml,v 1.3 2004/10/04 15:19:56 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
q#template template
let () =
- register_script run
+ register_script ~restrict:[CanView] run
<tr>
<th> Global permissions: </th>
<td>
+<input type="checkbox" name="view_anon" value="1" ::if(view_anon)::checked="checked"::end:: id="view_anon"/><label for="view_anon">Allow anyone to see the site</label> <br/>
<input type="checkbox" name="edit_anon" value="1" ::if(edit_anon)::checked="checked"::end:: id="edit_anon"/><label for="edit_anon">Allow anonymous edits</label> <br/>
<input type="checkbox" name="create_account_anon" value="1" ::if(create_account_anon)::checked="checked"::end:: id="create_account_anon"/><label for="create_account_anon">Allow anyone to create accounts</label>
</td>
<a href="/_bin/edit_host_css_form.cmo">Edit global stylesheet ...</a> </td>
</tr>
<tr>
+<th> Allow anyone to see the site: </th>
+<td> ::if(view_anon)::Yes::else::No (private / intranet site)::end:: </td>
+</tr>
+<tr>
<th> Allow anonymous edits: </th>
<td> ::if(edit_anon)::Yes::else::No::end:: </td>
</tr>
git.annexia.org / cocanwiki.git / commitdiff