id serial NOT NULL,
canonical_hostname text NOT NULL,
css text,
- edit_anon boolean DEFAULT true NOT NULL
+ edit_anon boolean DEFAULT true NOT NULL,
+ create_account_anon boolean DEFAULT true NOT NULL
);
# Apache configuration for COCANWIKI.
-# $Id: cocanwiki.conf,v 1.1 2004/09/07 10:14:07 rich Exp $
+# $Id: cocanwiki.conf,v 1.2 2004/09/07 16:19:43 rich Exp $
# Uncomment the following lines if necessary. You will probably need
# to adjust the paths to reflect where cocanwiki is really installed.
RewriteRule ^/_files$ /_bin/files.cmo [PT,L,QSA]
RewriteRule ^/_global.css$ /_bin/hoststyle.cmo [PT,L,QSA]
RewriteRule ^/_images$ /_bin/images.cmo [PT,L,QSA]
+RewriteRule ^/_login$ /_bin/login_form.cmo [PT,L]
+RewriteRule ^/_logout$ /_bin/logout.cmo [PT,L,QSA]
RewriteRule ^/_recent$ /_bin/recent.cmo [PT,L,QSA]
RewriteRule ^/_sitemap$ /_bin/sitemap.cmo [PT,L,QSA]
--- /dev/null
+/* Stylesheet for COCANWIKI, derived from EWM.
+ * $Id: login.css,v 1.1 2004/09/07 16:19:43 rich Exp $
+ */
+
+table.create {
+ empty-cells: show;
+}
+
+table.create th {
+ vertical-align: top;
+ text-align: right;
+}
+
+table.create td {
+ vertical-align: top;
+}
# Makefile for COCANWIKI.
-# $Id: Makefile,v 1.3 2004/09/07 14:58:34 rich Exp $
+# $Id: Makefile,v 1.4 2004/09/07 16:19:43 rich Exp $
include ../Makefile.config
hoststyle.cmo \
image.cmo \
images.cmo \
+ login.cmo \
+ login_form.cmo \
+ logout.cmo \
page.cmo \
pagestyle.cmo \
preview.cmo \
(* COCANWIKI scripts.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: cocanwiki.ml,v 1.3 2004/09/07 14:58:34 rich Exp $
+ * $Id: cocanwiki.ml,v 1.4 2004/09/07 16:19:43 rich Exp $
*)
open Apache
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 ?(restrict = []) run =
+(* Our wrapper around the standard [register_script] function.
+ *
+ * The optional ~restrict and ~anonymous parameters work as follows:
+ *
+ * By default (neither parameter given), anonymous or logged-in users
+ * at any level are permitted to run the script.
+ *
+ * If ~anonymous:false then a user must be logged in to use the script.
+ *
+ * If ~restrict contains a list of permissions (eg. CanEdit, etc.) then
+ * the user must have the ability to do AT LEAST ONE of those actions.
+ * (Note that this does not necessarily imply that the user must be
+ * logged in, because in some circumstances even anonymous users have
+ * the CanEdit permission - very typical for a wiki).
+ *
+ * If ~anonymous:false and ~restrict is given then the user must be
+ * logged in AND have the ability to do AT LEAST ONE of those actions.
+ *)
+let register_script ?(restrict = []) ?(anonymous = true) run =
(* Actually register the script with the real [Registry] module. *)
register_script
(fun r ->
* the user has sufficient permission to run this script.
*)
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 not anonymous && user = Anonymous then false
+ else
+ 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. *)
--- /dev/null
+(* Easy Web Pages (EWP) scripts.
+ * Written by Richard W.M. Jones <rich@merjis.com>.
+ * Copyright (C) 2004 Merjis Ltd.
+ * $Id: login.ml,v 1.1 2004/09/07 16:19:43 rich Exp $
+ *)
+
+open Apache
+open Registry
+open Cgi
+open Printf
+
+open Cocanwiki
+open Cocanwiki_ok
+
+let expires = "Wed, 18-May-2033 04:33:20 GMT"
+
+let run r (q : cgi) (dbh : Dbi.connection) (hostid, _, _) _ =
+ let username = q#param "username" in
+ let password = q#param "password" in
+ let permanent = try "1" = q#param "permanent" with Not_found -> false in
+ let redirect = try q#param "redirect" with Not_found -> "/" in
+
+ let sth = dbh#prepare_cached "select id from users
+ where name = ? and password = ?
+ and hostid = ?" in
+ sth#execute [`String username; `String password; `Int hostid];
+
+ try
+ let userid = sth#fetch1int () in
+
+ (* Create a cookie. *)
+ let cookie = random_sessionid () in
+ let sth = dbh#prepare_cached "insert into usercookies (userid, cookie)
+ values (?, ?)" in
+ sth#execute [`Int userid; `String cookie];
+
+ dbh#commit ();
+
+ let cookie =
+ if permanent then
+ Cookie.cookie ~name:"auth" ~value:cookie ~path:"/" ~expires ()
+ else
+ Cookie.cookie ~name:"auth" ~value:cookie ~path:"/" () in
+
+ ok ~title:"Logged in" ~buttons:[ok_button redirect] ~cookie
+ q ("Welcome back " ^ username ^ ".")
+ with
+ Not_found ->
+ error
+ ~title:"Bad name or password"
+ ~back_button:true
+ q "The name or password was wrong."
+
+let () =
+ register_script run
--- /dev/null
+(* COCANWIKI scripts.
+ * Written by Richard W.M. Jones <rich@merjis.com>.
+ * Copyright (C) 2004 Merjis Ltd.
+ * $Id: login_form.ml,v 1.1 2004/09/07 16:19:43 rich Exp $
+ *)
+
+open Apache
+open Registry
+open Cgi
+open Printf
+
+open Cocanwiki
+open Cocanwiki_template
+open Cocanwiki_strings
+
+let template = get_template "login_form.html"
+
+let run r (q : cgi) (dbh : Dbi.connection) (hostid, _, _) _ =
+ let redirect = try q#param "redirect" with Not_found -> "" in
+
+ if string_is_whitespace redirect then
+ template#conditional "has_redirect" false
+ else (
+ template#conditional "has_redirect" true;
+ template#set "redirect" redirect
+ );
+
+ let sth = dbh#prepare_cached "select create_account_anon from hosts
+ where id = ?" in
+ sth#execute [`Int hostid];
+
+ let create_account_anon =
+ match sth#fetch1 () with
+ [ `Bool b ] -> b
+ | _ -> assert false in
+
+ template#conditional "create_account_anon" create_account_anon;
+
+ q#template template
+
+let () =
+ register_script run
--- /dev/null
+(* Easy Web Pages (EWP) scripts.
+ * Written by Richard W.M. Jones <rich@merjis.com>.
+ * Copyright (C) 2004 Merjis Ltd.
+ * $Id: logout.ml,v 1.1 2004/09/07 16:19:43 rich Exp $
+ *)
+
+open Apache
+open Registry
+open Cgi
+open Printf
+
+open Cocanwiki
+open Cocanwiki_ok
+
+let expires = "Sun, 09-Sep-2001 02:46:40 GMT"
+
+let run r (q : cgi) (dbh : Dbi.connection) _ user =
+ (* The logout function removes all of the associated cookies from the
+ * database. This isn't required, but is nice semantics, and also helps
+ * to reduce the size of the usercookies table in the database.
+ *)
+ (match user with
+ Anonymous -> ()
+ | User (userid, _, _) ->
+ let sth = dbh#prepare_cached "delete from usercookies
+ where userid = ?" in
+ sth#execute [`Int userid];
+
+ dbh#commit ()
+ );
+
+ let cookie =
+ Cookie.cookie ~name:"auth" ~value:"none" ~path:"/" ~expires () in
+
+ ok ~title:"Logged out" ~buttons:[ok_button "/"] ~cookie
+ q "You have been logged out."
+
+let () =
+ register_script run
(* COCANWIKI scripts.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: page.ml,v 1.3 2004/09/07 14:58:34 rich Exp $
+ * $Id: page.ml,v 1.4 2004/09/07 16:19:43 rich Exp $
*)
open Apache
| FPRedirect of string
| FPNotFound
-let run r (q : cgi) (dbh : Dbi.connection) (hostid, _, _) _ =
+let run r (q : cgi) (dbh : Dbi.connection) (hostid, _, _) user =
let page = q#param "page" in
let page = if page = "" then "index" else page in
t#conditional "is_old_version" true;
t#set "old_version" (string_of_int pageid));
+ (* Login status. *)
+ (match user with
+ Anonymous ->
+ t#conditional "user_logged_in" false
+ | User (_, username, _) ->
+ t#conditional "user_logged_in" true;
+ t#set "username" username);
+
q#template t
in
--- /dev/null
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+<head>
+<title>Create an account or log in</title>
+<meta name="description" content="Log in to this site for extra features." />
+<meta name="author" content="http://www.merjis.com/" />
+<link rel="stylesheet" href="/_css/standard.css" type="text/css" title="Standard"/>
+<link rel="stylesheet" href="/_css/login.css" type="text/css" title="Standard"/>
+</head><body>
+
+<h1>Create an account or log in</h1>
+
+<h2>Existing users log in</h2>
+
+<form method="post" action="/_bin/login.cmo">
+::if(has_redirect)::<input type="hidden" name="redirect" value="::redirect_html_tag::"/>::end::
+<table class="create">
+
+<tr>
+<th> Username: </th>
+<td> <input name="username" value="" size="32"/> </td>
+</tr>
+
+<tr>
+<th> Password: </th>
+<td> <input type="password" name="password" value="" size="32"/> </td>
+</tr>
+
+<tr>
+<th> </th>
+<td> <input type="checkbox" name="permanent" value="1" checked="checked" id="permanent"/><label for="permanent">Keep me logged in on this computer.</label> </td>
+</tr>
+
+<tr>
+<th> </th>
+<td> <input type="submit" value=" Login " /> </td>
+</tr>
+
+</table>
+</form>
+
+<p>
+<a href="/_bin/forgot_password_form.cmo">Forgotten your password?</a>
+</p>
+
+<h2>Create an account</h2>
+
+::if(create_account_anon)::
+
+<form method="post" action="/_bin/create_account.cmo">
+<table class="create">
+
+<tr>
+<th> Username: </th>
+<td> <input name="username" value="" size="32" maxlength="32"/> </td>
+</tr>
+
+<tr>
+<th> Password: </th>
+<td> <input type="password" name="password" value="" size="32" maxlength="32"/> </td>
+</tr>
+
+<tr>
+<th> Password again: </th>
+<td> <input type="password" name="password" value="" size="32" maxlength="32"/> </td>
+</tr>
+
+<tr>
+<th> Email address: </th>
+<td> <input name="email" value="" size="50" /> </td>
+</tr>
+
+<tr>
+<th> </th>
+<td> <input type="submit" value=" Create account " /> </td>
+</tr>
+
+</table>
+</form>
+
+::else::
+
+<p>
+Sorry, but the administrator of this site has stopped
+people from anonymously creating accounts. You will have
+to contact the administrator and ask them to create an
+account for you.
+</p>
+
+::end::
+
+<ul id="topmenu" class="menu">
+<li> <a href="/">Home page</a> | </li>
+<li> <a href="/_sitemap">Sitemap</a> | </li>
+<li> <a href="/_recent">Recent changes</a> </li>
+</ul>
+
+<ul id="bottommenu" class="menu">
+<li> <a href="/">Home page</a> | </li>
+<li> <a href="/_sitemap">Sitemap</a> | </li>
+<li> <a href="/_recent">Recent changes</a> </li>
+</ul>
+
+<hr/>
+
+<ul id="footer" class="menu">
+<li> <a href="/copyright">Copyright © 2004</a> </li>
+</ul>
+
+</body>
+</html>
\ No newline at end of file
<li> <a href="/_images">Images</a> | </li>
<li> <a href="/_files">Files</a> | </li>
<li> <a href="/::page_html_tag::/editcss">Edit stylesheet for this page</a> | </li>
-<li> <a href="/_bin/admin/admin.cmo">Wiki administration</a> </li>
+<li> <a href="/_bin/admin/admin.cmo">Wiki administration</a> | </li>
+<li> ::if(user_logged_in):: ::username_html:: <a href="/_logout">(logout)</a> ::else:: <a href="/_login">Create account or login</a> ::end:: </li>
</ul>
<hr/>