From: rich Date: Tue, 7 Sep 2004 13:40:09 +0000 (+0000) Subject: Support for users, roles, restrictions. X-Git-Url: http://git.annexia.org/?a=commitdiff_plain;h=714e5e5b4b585da1eca55274e3903ee9a1dbf0d6;p=cocanwiki.git Support for users, roles, restrictions. --- diff --git a/cocanwiki.sql b/cocanwiki.sql index b3f8646..1962a3d 100644 --- a/cocanwiki.sql +++ b/cocanwiki.sql @@ -51,7 +51,7 @@ GRANT ALL ON TABLE pages TO "www-data"; -- --- TOC entry 19 (OID 536004) +-- TOC entry 23 (OID 536004) -- Name: pages_id_seq; Type: ACL; Schema: public; Owner: rich -- @@ -84,7 +84,7 @@ GRANT ALL ON TABLE contents TO "www-data"; -- --- TOC entry 20 (OID 536021) +-- TOC entry 24 (OID 536021) -- Name: contents_id_seq; Type: ACL; Schema: public; Owner: rich -- @@ -100,7 +100,8 @@ GRANT ALL ON TABLE contents_id_seq TO "www-data"; CREATE TABLE hosts ( id serial NOT NULL, canonical_hostname text NOT NULL, - css text + css text, + edit_anon boolean DEFAULT true NOT NULL ); @@ -114,7 +115,7 @@ GRANT ALL ON TABLE hosts TO "www-data"; -- --- TOC entry 21 (OID 536371) +-- TOC entry 25 (OID 536371) -- Name: hosts_id_seq; Type: ACL; Schema: public; Owner: rich -- @@ -199,7 +200,7 @@ GRANT ALL ON TABLE images TO "www-data"; -- --- TOC entry 22 (OID 537151) +-- TOC entry 26 (OID 537151) -- Name: images_id_seq; Type: ACL; Schema: public; Owner: rich -- @@ -234,7 +235,7 @@ GRANT ALL ON TABLE files TO "www-data"; -- --- TOC entry 23 (OID 537166) +-- TOC entry 27 (OID 537166) -- Name: files_id_seq; Type: ACL; Schema: public; Owner: rich -- @@ -243,7 +244,62 @@ GRANT ALL ON TABLE files_id_seq TO "www-data"; -- --- TOC entry 28 (OID 536388) +-- TOC entry 19 (OID 540816) +-- Name: users; Type: TABLE; Schema: public; Owner: rich +-- + +CREATE TABLE users ( + id serial NOT NULL, + hostid integer NOT NULL, + name text NOT NULL, + "password" text NOT NULL, + email text, + registration_date date DEFAULT ('now'::text)::date NOT NULL, + can_edit boolean DEFAULT true NOT NULL, + can_manage_users boolean DEFAULT false NOT NULL +); + + +-- +-- TOC entry 20 (OID 540816) +-- Name: users; Type: ACL; Schema: public; Owner: rich +-- + +REVOKE ALL ON TABLE users FROM PUBLIC; +GRANT ALL ON TABLE users TO "www-data"; + + +-- +-- TOC entry 28 (OID 540816) +-- Name: users_id_seq; Type: ACL; Schema: public; Owner: rich +-- + +REVOKE ALL ON TABLE users_id_seq FROM PUBLIC; +GRANT ALL ON TABLE users_id_seq TO "www-data"; + + +-- +-- TOC entry 21 (OID 540832) +-- Name: usercookies; Type: TABLE; Schema: public; Owner: rich +-- + +CREATE TABLE usercookies ( + userid integer NOT NULL, + cookie text NOT NULL +); + + +-- +-- TOC entry 22 (OID 540832) +-- Name: usercookies; Type: ACL; Schema: public; Owner: rich +-- + +REVOKE ALL ON TABLE usercookies FROM PUBLIC; +GRANT ALL ON TABLE usercookies TO "www-data"; + + +-- +-- TOC entry 33 (OID 536388) -- Name: hostnames_hostid_name_uq; Type: INDEX; Schema: public; Owner: rich -- @@ -251,7 +307,7 @@ CREATE UNIQUE INDEX hostnames_hostid_name_uq ON hostnames USING btree (hostid, n -- --- TOC entry 29 (OID 536389) +-- TOC entry 34 (OID 536389) -- Name: hostnams_name_uq; Type: INDEX; Schema: public; Owner: rich -- @@ -259,7 +315,7 @@ CREATE UNIQUE INDEX hostnams_name_uq ON hostnames USING btree (name); -- --- TOC entry 25 (OID 536419) +-- TOC entry 30 (OID 536419) -- Name: pages_url_uq; Type: INDEX; Schema: public; Owner: rich -- @@ -267,7 +323,7 @@ CREATE UNIQUE INDEX pages_url_uq ON pages USING btree (hostid, url); -- --- TOC entry 30 (OID 536924) +-- TOC entry 35 (OID 536924) -- Name: email_notify_email_uq; Type: INDEX; Schema: public; Owner: rich -- @@ -275,7 +331,7 @@ CREATE UNIQUE INDEX email_notify_email_uq ON email_notify USING btree (hostid, e -- --- TOC entry 31 (OID 540251) +-- TOC entry 36 (OID 540251) -- Name: images_name_uq; Type: INDEX; Schema: public; Owner: rich -- @@ -283,7 +339,7 @@ CREATE UNIQUE INDEX images_name_uq ON images USING btree (hostid, name); -- --- TOC entry 33 (OID 540252) +-- TOC entry 38 (OID 540252) -- Name: files_name_uq; Type: INDEX; Schema: public; Owner: rich -- @@ -291,7 +347,15 @@ CREATE UNIQUE INDEX files_name_uq ON files USING btree (hostid, name); -- --- TOC entry 24 (OID 536012) +-- TOC entry 40 (OID 540831) +-- Name: users_name_uq; Type: INDEX; Schema: public; Owner: rich +-- + +CREATE UNIQUE INDEX users_name_uq ON users USING btree (hostid, name); + + +-- +-- TOC entry 29 (OID 536012) -- Name: pages_pkey; Type: CONSTRAINT; Schema: public; Owner: rich -- @@ -300,7 +364,7 @@ ALTER TABLE ONLY pages -- --- TOC entry 26 (OID 536027) +-- TOC entry 31 (OID 536027) -- Name: contents_pkey; Type: CONSTRAINT; Schema: public; Owner: rich -- @@ -309,7 +373,7 @@ ALTER TABLE ONLY contents -- --- TOC entry 27 (OID 536377) +-- TOC entry 32 (OID 536377) -- Name: hosts_pkey; Type: CONSTRAINT; Schema: public; Owner: rich -- @@ -318,7 +382,7 @@ ALTER TABLE ONLY hosts -- --- TOC entry 32 (OID 537158) +-- TOC entry 37 (OID 537158) -- Name: images_pkey; Type: CONSTRAINT; Schema: public; Owner: rich -- @@ -327,7 +391,7 @@ ALTER TABLE ONLY images -- --- TOC entry 34 (OID 537173) +-- TOC entry 39 (OID 537173) -- Name: files_pkey; Type: CONSTRAINT; Schema: public; Owner: rich -- @@ -336,7 +400,16 @@ ALTER TABLE ONLY files -- --- TOC entry 37 (OID 536029) +-- TOC entry 41 (OID 540825) +-- Name: users_pkey; Type: CONSTRAINT; Schema: public; Owner: rich +-- + +ALTER TABLE ONLY users + ADD CONSTRAINT users_pkey PRIMARY KEY (id); + + +-- +-- TOC entry 44 (OID 536029) -- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich -- @@ -345,7 +418,7 @@ ALTER TABLE ONLY contents -- --- TOC entry 39 (OID 536384) +-- TOC entry 46 (OID 536384) -- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich -- @@ -354,7 +427,7 @@ ALTER TABLE ONLY hostnames -- --- TOC entry 38 (OID 536394) +-- TOC entry 45 (OID 536394) -- Name: hosts_hostname_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich -- @@ -363,7 +436,7 @@ ALTER TABLE ONLY hosts -- --- TOC entry 35 (OID 536404) +-- TOC entry 42 (OID 536404) -- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich -- @@ -372,7 +445,7 @@ ALTER TABLE ONLY pages -- --- TOC entry 40 (OID 536920) +-- TOC entry 47 (OID 536920) -- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich -- @@ -381,7 +454,7 @@ ALTER TABLE ONLY email_notify -- --- TOC entry 41 (OID 537160) +-- TOC entry 48 (OID 537160) -- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich -- @@ -390,7 +463,7 @@ ALTER TABLE ONLY images -- --- TOC entry 42 (OID 537175) +-- TOC entry 49 (OID 537175) -- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich -- @@ -399,7 +472,7 @@ ALTER TABLE ONLY files -- --- TOC entry 36 (OID 539155) +-- TOC entry 43 (OID 539155) -- Name: pages_redirect_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich -- @@ -407,6 +480,24 @@ ALTER TABLE ONLY pages ADD CONSTRAINT pages_redirect_cn FOREIGN KEY (hostid, redirect) REFERENCES pages(hostid, url) DEFERRABLE; +-- +-- TOC entry 50 (OID 540827) +-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich +-- + +ALTER TABLE ONLY users + ADD CONSTRAINT "$1" FOREIGN KEY (hostid) REFERENCES hosts(id); + + +-- +-- TOC entry 51 (OID 540837) +-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich +-- + +ALTER TABLE ONLY usercookies + ADD CONSTRAINT "$1" FOREIGN KEY (userid) REFERENCES users(id); + + SET SESSION AUTHORIZATION 'postgres'; -- diff --git a/scripts/.depend b/scripts/.depend index dfe6e05..9ad65e0 100644 --- a/scripts/.depend +++ b/scripts/.depend @@ -1,13 +1,17 @@ cgi_expires.cmo: merjisforwiki.cmi cgi_expires.cmx: merjisforwiki.cmx -cocanwiki.cmo: merjisforwiki.cmi -cocanwiki.cmx: merjisforwiki.cmx +cocanwiki.cmo: cocanwiki_ok.cmo merjisforwiki.cmi +cocanwiki.cmx: cocanwiki_ok.cmx merjisforwiki.cmx +cocanwiki_date.cmo: merjisforwiki.cmi +cocanwiki_date.cmx: merjisforwiki.cmx cocanwiki_diff.cmo: merjisforwiki.cmi cocanwiki_diff.cmx: merjisforwiki.cmx cocanwiki_emailnotify.cmo: merjisforwiki.cmi cocanwiki_emailnotify.cmx: merjisforwiki.cmx -cocanwiki_ok.cmo: cocanwiki.cmo merjisforwiki.cmi -cocanwiki_ok.cmx: cocanwiki.cmx merjisforwiki.cmx +cocanwiki_ok.cmo: cocanwiki_template.cmo merjisforwiki.cmi +cocanwiki_ok.cmx: cocanwiki_template.cmx merjisforwiki.cmx +cocanwiki_template.cmo: merjisforwiki.cmi +cocanwiki_template.cmx: merjisforwiki.cmx create.cmo: cocanwiki.cmo cocanwiki_emailnotify.cmo cocanwiki_ok.cmo \ wikilib.cmi create.cmx: cocanwiki.cmx cocanwiki_emailnotify.cmx cocanwiki_ok.cmx \ @@ -62,6 +66,14 @@ preview.cmo: cocanwiki.cmo wikilib.cmi preview.cmx: cocanwiki.cmx wikilib.cmx recent.cmo: cocanwiki.cmo recent.cmx: cocanwiki.cmx +restore.cmo: cocanwiki.cmo cocanwiki_diff.cmo cocanwiki_emailnotify.cmo \ + cocanwiki_ok.cmo merjisforwiki.cmi +restore.cmx: cocanwiki.cmx cocanwiki_diff.cmx cocanwiki_emailnotify.cmx \ + cocanwiki_ok.cmx merjisforwiki.cmx +restore_form.cmo: cocanwiki.cmo cocanwiki_diff.cmo cocanwiki_ok.cmo \ + merjisforwiki.cmi +restore_form.cmx: cocanwiki.cmx cocanwiki_diff.cmx cocanwiki_ok.cmx \ + merjisforwiki.cmx search.cmo: cocanwiki.cmo search.cmx: cocanwiki.cmx sitemap.cmo: cocanwiki.cmo merjisforwiki.cmi wikilib.cmi diff --git a/scripts/Makefile b/scripts/Makefile index be3200c..9ffd52f 100644 --- a/scripts/Makefile +++ b/scripts/Makefile @@ -1,5 +1,5 @@ # Makefile for COCANWIKI. -# $Id: Makefile,v 1.1 2004/09/07 10:14:09 rich Exp $ +# $Id: Makefile,v 1.2 2004/09/07 13:40:10 rich Exp $ include ../Makefile.config @@ -9,9 +9,11 @@ CPP := cpp LIB_OBJS := \ merjisforwiki.cmo \ + cocanwiki_date.cmo \ + cocanwiki_template.cmo \ + cocanwiki_ok.cmo \ cocanwiki.cmo \ cocanwiki_version.cmo \ - cocanwiki_ok.cmo \ cocanwiki_diff.cmo \ cocanwiki_emailnotify.cmo \ wikilib.cmo \ diff --git a/scripts/admin/admin.ml b/scripts/admin/admin.ml index 109cf8d..78c93f5 100644 --- a/scripts/admin/admin.ml +++ b/scripts/admin/admin.ml @@ -1,7 +1,7 @@ (* COCANWIKI scripts. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: admin.ml,v 1.1 2004/09/07 10:14:10 rich Exp $ + * $Id: admin.ml,v 1.2 2004/09/07 13:40:10 rich Exp $ *) open Apache @@ -12,6 +12,7 @@ open Printf open Merjisforwiki open Cocanwiki +open Cocanwiki_template let template = get_template "admin/admin.html" diff --git a/scripts/admin/create_host_form.ml b/scripts/admin/create_host_form.ml index 824536f..dabc5f0 100644 --- a/scripts/admin/create_host_form.ml +++ b/scripts/admin/create_host_form.ml @@ -1,7 +1,7 @@ (* COCANWIKI scripts. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: create_host_form.ml,v 1.1 2004/09/07 10:14:10 rich Exp $ + * $Id: create_host_form.ml,v 1.2 2004/09/07 13:40:10 rich Exp $ * * NB. Because there might not be any hosts existing when this Wiki * is created, this is not a normal Cocanwiki.register_script script. @@ -13,7 +13,7 @@ open Registry open Cgi open Printf -let template = Cocanwiki.get_template "admin/create_host_form.html" +let template = Cocanwiki_template.get_template "admin/create_host_form.html" let run r = let q = new cgi r in diff --git a/scripts/admin/edit_emails.ml b/scripts/admin/edit_emails.ml index 732dee0..a3b39ea 100644 --- a/scripts/admin/edit_emails.ml +++ b/scripts/admin/edit_emails.ml @@ -1,7 +1,7 @@ (* COCANWIKI scripts. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: edit_emails.ml,v 1.1 2004/09/07 10:14:10 rich Exp $ + * $Id: edit_emails.ml,v 1.2 2004/09/07 13:40:10 rich Exp $ *) open Apache @@ -17,11 +17,11 @@ open Cocanwiki_ok let split_re = Pcre.regexp "[\\r\\n,;]+" let email_re = Pcre.regexp "(.*)<(.*)>" -let run r (q : cgi) (dbh : Dbi.connection) hostid_hostname _ = +let run r (q : cgi) (dbh : Dbi.connection) host_stuff _ = let hostid = int_of_string (q#param "hostid") in if q#param_true "cancel" then ( - let _, hostname = hostid_hostname in + let _, hostname, _ = host_stuff in q#redirect ("http://" ^ hostname ^ "/_bin/admin/host.cmo?hostid=" ^ string_of_int hostid); raise CgiExit diff --git a/scripts/admin/edit_emails_form.ml b/scripts/admin/edit_emails_form.ml index 8c32335..404a07b 100644 --- a/scripts/admin/edit_emails_form.ml +++ b/scripts/admin/edit_emails_form.ml @@ -1,7 +1,7 @@ (* COCANWIKI scripts. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: edit_emails_form.ml,v 1.1 2004/09/07 10:14:10 rich Exp $ + * $Id: edit_emails_form.ml,v 1.2 2004/09/07 13:40:10 rich Exp $ *) open Apache @@ -10,6 +10,7 @@ open Cgi open Printf open Cocanwiki +open Cocanwiki_template let template = get_template "admin/edit_emails_form.html" diff --git a/scripts/admin/edit_host_css.ml b/scripts/admin/edit_host_css.ml index 04a2ad9..4a25b66 100644 --- a/scripts/admin/edit_host_css.ml +++ b/scripts/admin/edit_host_css.ml @@ -1,7 +1,7 @@ (* COCANWIKI scripts. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: edit_host_css.ml,v 1.1 2004/09/07 10:14:10 rich Exp $ + * $Id: edit_host_css.ml,v 1.2 2004/09/07 13:40:10 rich Exp $ *) open Apache @@ -14,7 +14,7 @@ open Merjisforwiki open Cocanwiki open Cocanwiki_ok -let run r (q : cgi) (dbh : Dbi.connection) (hostid, _) _ = +let run r (q : cgi) (dbh : Dbi.connection) (hostid, _, _) _ = let hostid = int_of_string (q#param "hostid") in let css = q#param "css" in diff --git a/scripts/admin/edit_host_css_form.ml b/scripts/admin/edit_host_css_form.ml index 815fe9c..71e4eca 100644 --- a/scripts/admin/edit_host_css_form.ml +++ b/scripts/admin/edit_host_css_form.ml @@ -1,7 +1,7 @@ (* COCANWIKI scripts. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: edit_host_css_form.ml,v 1.1 2004/09/07 10:14:10 rich Exp $ + * $Id: edit_host_css_form.ml,v 1.2 2004/09/07 13:40:10 rich Exp $ *) open Apache @@ -10,6 +10,7 @@ open Cgi open Printf open Cocanwiki +open Cocanwiki_template let template = get_template "admin/edit_host_css_form.html" diff --git a/scripts/admin/edit_hostnames.ml b/scripts/admin/edit_hostnames.ml index 3a37aa7..bff0fa8 100644 --- a/scripts/admin/edit_hostnames.ml +++ b/scripts/admin/edit_hostnames.ml @@ -1,7 +1,7 @@ (* COCANWIKI scripts. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: edit_hostnames.ml,v 1.1 2004/09/07 10:14:10 rich Exp $ + * $Id: edit_hostnames.ml,v 1.2 2004/09/07 13:40:10 rich Exp $ *) open Apache @@ -16,11 +16,11 @@ open Cocanwiki_ok let split_re = Pcre.regexp "[\\s,;]+" -let run r (q : cgi) (dbh : Dbi.connection) hostid_hostname _ = +let run r (q : cgi) (dbh : Dbi.connection) host_stuff _ = let hostid = int_of_string (q#param "hostid") in if q#param_true "cancel" then ( - let _, hostname = hostid_hostname in + let _, hostname, _ = host_stuff in q#redirect ("http://" ^ hostname ^ "/_bin/admin/host.cmo?hostid=" ^ string_of_int hostid); raise CgiExit diff --git a/scripts/admin/edit_hostnames_form.ml b/scripts/admin/edit_hostnames_form.ml index 30dd87d..2665fb6 100644 --- a/scripts/admin/edit_hostnames_form.ml +++ b/scripts/admin/edit_hostnames_form.ml @@ -1,7 +1,7 @@ (* COCANWIKI scripts. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: edit_hostnames_form.ml,v 1.1 2004/09/07 10:14:10 rich Exp $ + * $Id: edit_hostnames_form.ml,v 1.2 2004/09/07 13:40:10 rich Exp $ *) open Apache @@ -10,6 +10,7 @@ open Cgi open Printf open Cocanwiki +open Cocanwiki_template let template = get_template "admin/edit_hostnames_form.html" diff --git a/scripts/admin/host.ml b/scripts/admin/host.ml index 96d6a04..95056ab 100644 --- a/scripts/admin/host.ml +++ b/scripts/admin/host.ml @@ -1,7 +1,7 @@ (* COCANWIKI scripts. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: host.ml,v 1.1 2004/09/07 10:14:10 rich Exp $ + * $Id: host.ml,v 1.2 2004/09/07 13:40:10 rich Exp $ *) open Apache @@ -12,6 +12,7 @@ open Printf open Merjisforwiki open Cocanwiki +open Cocanwiki_template let template = get_template "admin/host.html" diff --git a/scripts/cocanwiki.ml b/scripts/cocanwiki.ml index 6852dc4..cfe43f7 100644 --- a/scripts/cocanwiki.ml +++ b/scripts/cocanwiki.ml @@ -1,7 +1,7 @@ (* COCANWIKI scripts. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: cocanwiki.ml,v 1.1 2004/09/07 10:14:09 rich Exp $ + * $Id: cocanwiki.ml,v 1.2 2004/09/07 13:40:10 rich Exp $ *) open Apache @@ -11,24 +11,9 @@ open Printf open Merjisforwiki -module Pool = DbiPool (Dbi_postgres) +open Cocanwiki_ok -(* Wrapper around [Cgi.Template.template] function which loads the - * template from a pre-defined path and sets up some default variables. - *) -let get_template = - let path = - try Sys.getenv "COCANWIKI_TEMPLATES" - with Not_found -> "/usr/share/cocanwiki/templates" in - let is_dir path = - try (Unix.stat path).Unix.st_kind = Unix.S_DIR - with Unix.Unix_error _ -> false in - if not (is_dir path) then - failwith ("environment variable $COCANWIKI_TEMPLATES " ^ - "must be set to point to my 'templates' directory " ^ - "(see README file for more details)"); - fun filename -> - Template.template (path // filename) +module Pool = DbiPool (Dbi_postgres) (* Generate a printable datestamp for pages. *) let printable_date (date, _) = @@ -49,8 +34,30 @@ let _get_dbh r = Pool.get r "cocanwiki" *) exception CgiExit +(* 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 + +(* The "user object". *) +type user_t = Anonymous (* Not logged in. *) + | User of int * string * permissions_t list + (* Userid, name, permissions. *) + +let test_permission edit_anon perm user = + if perm = CanEdit && edit_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 + (* Our wrapper around the standard [register_script] function. *) -let register_script run = +let register_script ?(restrict = []) run = (* Actually register the script with the real [Registry] module. *) register_script (fun r -> @@ -60,30 +67,88 @@ let register_script run = (* Get the host ID, by comparing the Host: header with the hostnames * table in the database. *) - let hostid, hostname = + let hostid, hostname, edit_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 - from hostnames hn, hosts h - where hn.name = ? - and hn.hostid = h.id" in + let sth = + dbh#prepare_cached + "select h.id, h.canonical_hostname, h.edit_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 ] -> id, hostname + [ `Int id; `String hostname; `Bool edit_anon ] -> + id, hostname, edit_anon | _ -> assert false) with Not_found -> failwith ("Hostname ``" ^ hostname ^ "'' not found in " ^ "the hosts/hostnames tables in the database.") in - (* Call the actual CGI script. Note the fourth (unit) argument - * is reserved for later usage (for authentication information). + (* Look for the user's cookie, and determine from this the user + * object. + *) + let user = + try + let cookie = + (* Allow the user to deliberately specify an extra "cookie" + * parameter, which we will send back as a cookie. This is + * useful for "mail my password"-type scripts. + *) + if q#param_exists "cookie" then ( + let value = q#param "cookie" in + let cookie = Cookie.cookie ~name:"auth" ~value ~path:"/" () in + Table.set (Request.headers_out r) "Set-Cookie" cookie#as_string; + value + ) else ( + (* Normal cookie, from the headers. *) + let header = Table.get (Request.headers_in r) "Cookie" in + let cookies = Cookie.parse header in + let cookie = + List.find (fun cookie -> cookie#name = "auth") cookies in + cookie#value + ) in + + let sth = + dbh#prepare_cached + "select u.id, u.name, u.can_edit, u.can_manage_users + from usercookies uc, users u + where uc.cookie = ? and uc.userid = u.id and u.hostid = ?" in + sth#execute [`String cookie; `Int hostid]; + (match sth#fetch1 () with + [ `Int userid; `String name; + `Bool can_edit; `Bool can_manage_users ] -> + let perms = + (if can_edit then [ CanEdit ] else []) @ + (if can_manage_users then [ CanManageUsers ] else []) in + User (userid, name, perms) + | _ -> assert false) + with + Not_found -> Anonymous + in + + (* If the ~restrict parameter is given, then we want to check that + * the user has sufficient permission to run this script. *) - try - run r q dbh (hostid, hostname) () - with - CgiExit -> ()) + let permitted = + match restrict with + [] -> true (* empty list = no restrictions *) + | rs -> + List.fold_left ((||)) false + (List.map (fun r -> test_permission edit_anon r user) rs) in + + if permitted then ( + (* Call the actual CGI script. *) + try + run r q dbh (hostid, hostname, edit_anon) user + with + CgiExit -> () + ) else + error ~back_button:true + ~title:"Access denied" + q "You do not have permission to access this part of the site." + ) diff --git a/scripts/cocanwiki_date.ml b/scripts/cocanwiki_date.ml new file mode 100644 index 0000000..ba42c74 --- /dev/null +++ b/scripts/cocanwiki_date.ml @@ -0,0 +1,20 @@ +(* COCANWIKI scripts. + * Written by Richard W.M. Jones . + * Copyright (C) 2004 Merjis Ltd. + * $Id: cocanwiki_date.ml,v 1.1 2004/09/07 13:40:10 rich Exp $ + *) + +open Apache +open Registry +open Cgi +open Printf + +open Merjisforwiki + +(* Generate a printable datestamp for pages. *) +let printable_date (date, _) = + sprintf "%d %s %04d" date.Dbi.day (short_month date.Dbi.month) date.Dbi.year + +let printable_date_time (date, time) = + sprintf "%d %s %04d %02d:%02d" date.Dbi.day (short_month date.Dbi.month) + date.Dbi.year time.Dbi.hour time.Dbi.min diff --git a/scripts/cocanwiki_ok.ml b/scripts/cocanwiki_ok.ml index 02b6f2f..a7fe4ed 100644 --- a/scripts/cocanwiki_ok.ml +++ b/scripts/cocanwiki_ok.ml @@ -1,7 +1,7 @@ (* COCANWIKI scripts. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: cocanwiki_ok.ml,v 1.1 2004/09/07 10:14:09 rich Exp $ + * $Id: cocanwiki_ok.ml,v 1.2 2004/09/07 13:40:10 rich Exp $ *) open Apache @@ -11,7 +11,7 @@ open Printf open Merjisforwiki -open Cocanwiki +open Cocanwiki_template (* Override StdPages.ok and StdPages.error with out our versions. * Also have some standard buttons around. diff --git a/scripts/cocanwiki_template.ml b/scripts/cocanwiki_template.ml new file mode 100644 index 0000000..ca0f915 --- /dev/null +++ b/scripts/cocanwiki_template.ml @@ -0,0 +1,27 @@ +(* COCANWIKI scripts. + * Written by Richard W.M. Jones . + * Copyright (C) 2004 Merjis Ltd. + * $Id: cocanwiki_template.ml,v 1.1 2004/09/07 13:40:10 rich Exp $ + *) + +open Apache +open Cgi + +open Merjisforwiki + +(* Wrapper around [Cgi.Template.template] function which loads the + * template from a pre-defined path and sets up some default variables. + *) +let get_template = + let path = + try Sys.getenv "COCANWIKI_TEMPLATES" + with Not_found -> "/usr/share/cocanwiki/templates" in + let is_dir path = + try (Unix.stat path).Unix.st_kind = Unix.S_DIR + with Unix.Unix_error _ -> false in + if not (is_dir path) then + failwith ("environment variable $COCANWIKI_TEMPLATES " ^ + "must be set to point to my 'templates' directory " ^ + "(see README file for more details)"); + fun filename -> + Template.template (path // filename) diff --git a/scripts/create.ml b/scripts/create.ml index 420d1ef..c7bc6f2 100644 --- a/scripts/create.ml +++ b/scripts/create.ml @@ -1,7 +1,7 @@ (* COCANWIKI scripts. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: create.ml,v 1.1 2004/09/07 10:14:09 rich Exp $ + * $Id: create.ml,v 1.2 2004/09/07 13:40:10 rich Exp $ *) open Apache @@ -15,7 +15,7 @@ open Cocanwiki open Cocanwiki_emailnotify open Cocanwiki_ok -let run r (q : cgi) (dbh : Dbi.connection) (hostid, hostname) _ = +let run r (q : cgi) (dbh : Dbi.connection) (hostid, hostname, _) _ = (* Get the page title. *) let title = q#param "title" in diff --git a/scripts/create_form.ml b/scripts/create_form.ml index 6336021..124be21 100644 --- a/scripts/create_form.ml +++ b/scripts/create_form.ml @@ -1,7 +1,7 @@ (* COCANWIKI scripts. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: create_form.ml,v 1.1 2004/09/07 10:14:09 rich Exp $ + * $Id: create_form.ml,v 1.2 2004/09/07 13:40:10 rich Exp $ *) open Apache @@ -12,11 +12,12 @@ open Printf open ExtString open Cocanwiki +open Cocanwiki_template open Cocanwiki_ok let template = get_template "create_form.html" -let run r (q : cgi) (dbh : Dbi.connection) (hostid, hostname) _ = +let run r (q : cgi) (dbh : Dbi.connection) (hostid, hostname, _) _ = (* Get the page title. *) let title = q#param "title" in diff --git a/scripts/delete_file.ml b/scripts/delete_file.ml index e2b5e2f..7159e01 100644 --- a/scripts/delete_file.ml +++ b/scripts/delete_file.ml @@ -1,7 +1,7 @@ (* COCANWIKI scripts. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: delete_file.ml,v 1.1 2004/09/07 10:14:09 rich Exp $ + * $Id: delete_file.ml,v 1.2 2004/09/07 13:40:10 rich Exp $ *) open Apache @@ -15,7 +15,7 @@ open Cocanwiki_emailnotify open Merjisforwiki -let run r (q : cgi) (dbh : Dbi.connection) (hostid, hostname) _ = +let run r (q : cgi) (dbh : Dbi.connection) (hostid, hostname, _) _ = let id = int_of_string (q#param "id") in if q#param_true "yes" then ( diff --git a/scripts/delete_file_form.ml b/scripts/delete_file_form.ml index 1b71ec2..49814ed 100644 --- a/scripts/delete_file_form.ml +++ b/scripts/delete_file_form.ml @@ -1,7 +1,7 @@ (* COCANWIKI scripts. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: delete_file_form.ml,v 1.1 2004/09/07 10:14:09 rich Exp $ + * $Id: delete_file_form.ml,v 1.2 2004/09/07 13:40:10 rich Exp $ *) open Apache @@ -10,12 +10,13 @@ open Cgi open Printf open Cocanwiki +open Cocanwiki_template open Merjisforwiki let template = get_template "delete_file_form.html" -let run r (q : cgi) (dbh : Dbi.connection) (hostid, _) _ = +let run r (q : cgi) (dbh : Dbi.connection) (hostid, _, _) _ = let id = int_of_string (q#param "id") in let sth = dbh#prepare_cached "select name from files diff --git a/scripts/delete_image.ml b/scripts/delete_image.ml index 63b03d1..04c7f6f 100644 --- a/scripts/delete_image.ml +++ b/scripts/delete_image.ml @@ -1,7 +1,7 @@ (* COCANWIKI scripts. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: delete_image.ml,v 1.1 2004/09/07 10:14:09 rich Exp $ + * $Id: delete_image.ml,v 1.2 2004/09/07 13:40:10 rich Exp $ *) open Apache @@ -15,7 +15,7 @@ open Cocanwiki_emailnotify open Merjisforwiki -let run r (q : cgi) (dbh : Dbi.connection) (hostid, hostname) _ = +let run r (q : cgi) (dbh : Dbi.connection) (hostid, hostname, _) _ = let id = int_of_string (q#param "id") in if q#param_true "yes" then ( diff --git a/scripts/delete_image_form.ml b/scripts/delete_image_form.ml index 6d17059..3c87e27 100644 --- a/scripts/delete_image_form.ml +++ b/scripts/delete_image_form.ml @@ -1,7 +1,7 @@ (* COCANWIKI scripts. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: delete_image_form.ml,v 1.1 2004/09/07 10:14:09 rich Exp $ + * $Id: delete_image_form.ml,v 1.2 2004/09/07 13:40:10 rich Exp $ *) open Apache @@ -9,13 +9,14 @@ open Registry open Cgi open Printf -open Cocanwiki - open Merjisforwiki +open Cocanwiki +open Cocanwiki_template + let template = get_template "delete_image_form.html" -let run r (q : cgi) (dbh : Dbi.connection) (hostid, _) _ = +let run r (q : cgi) (dbh : Dbi.connection) (hostid, _, _) _ = let id = int_of_string (q#param "id") in let sth = dbh#prepare_cached "select name, width, height, alt diff --git a/scripts/diff.ml b/scripts/diff.ml index 1d0ad76..24ffd4f 100644 --- a/scripts/diff.ml +++ b/scripts/diff.ml @@ -1,7 +1,7 @@ (* COCANWIKI scripts. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: diff.ml,v 1.1 2004/09/07 10:14:09 rich Exp $ + * $Id: diff.ml,v 1.2 2004/09/07 13:40:10 rich Exp $ *) open Apache @@ -9,14 +9,15 @@ open Registry open Cgi open Printf +open Merjisforwiki + open Cocanwiki +open Cocanwiki_template open Cocanwiki_diff -open Merjisforwiki - let template = get_template "diff.html" -let run r (q : cgi) (dbh : Dbi.connection) (hostid, _) _ = +let run r (q : cgi) (dbh : Dbi.connection) (hostid, _, _) _ = let page = q#param "page" in let page = if page = "" then "index" else page in diff --git a/scripts/edit.ml b/scripts/edit.ml index d86815c..19324f9 100644 --- a/scripts/edit.ml +++ b/scripts/edit.ml @@ -1,7 +1,7 @@ (* COCANWIKI scripts. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: edit.ml,v 1.1 2004/09/07 10:14:09 rich Exp $ + * $Id: edit.ml,v 1.2 2004/09/07 13:40:10 rich Exp $ *) open Apache @@ -14,6 +14,7 @@ open ExtString open Merjisforwiki open Cocanwiki +open Cocanwiki_template open Cocanwiki_ok open Cocanwiki_emailnotify open Cocanwiki_diff @@ -33,7 +34,7 @@ type model_t = { * for each section. *) } -let run r (q : cgi) (dbh : Dbi.connection) (hostid, hostname) _ = +let run r (q : cgi) (dbh : Dbi.connection) (hostid, hostname, _) _ = (* Workaround bugs in IE, specifically lack of support for