From: rich <rich>
Date: Tue, 7 Sep 2004 16:19:43 +0000 (+0000)
Subject: Logging in and logging out.
X-Git-Url: http://git.annexia.org/?a=commitdiff_plain;h=a9168cad656af034b671c9dea53057845e2196c9;p=cocanwiki.git

Logging in and logging out.
---

diff --git a/cocanwiki.sql b/cocanwiki.sql
index 1962a3d..85f072f 100644
--- a/cocanwiki.sql
+++ b/cocanwiki.sql
@@ -101,7 +101,8 @@ CREATE TABLE hosts (
     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
 );
 
 
diff --git a/conf/cocanwiki.conf b/conf/cocanwiki.conf
index 88053b7..f17bfc3 100644
--- a/conf/cocanwiki.conf
+++ b/conf/cocanwiki.conf
@@ -1,5 +1,5 @@
 # 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.
@@ -51,6 +51,8 @@ RewriteRule ^/_admin$ /_bin/admin/admin.cmo [PT,L,QSA]
 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]
 
diff --git a/html/_css/login.css b/html/_css/login.css
new file mode 100644
index 0000000..710cde3
--- /dev/null
+++ b/html/_css/login.css
@@ -0,0 +1,16 @@
+/* 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;
+}
diff --git a/scripts/Makefile b/scripts/Makefile
index 9de6072..bba2cd1 100644
--- a/scripts/Makefile
+++ b/scripts/Makefile
@@ -1,5 +1,5 @@
 # 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
 
@@ -37,6 +37,9 @@ OBJS := create.cmo \
 	hoststyle.cmo \
 	image.cmo \
 	images.cmo \
+	login.cmo \
+	login_form.cmo \
+	logout.cmo \
 	page.cmo \
 	pagestyle.cmo \
 	preview.cmo \
diff --git a/scripts/cocanwiki.ml b/scripts/cocanwiki.ml
index be6ce98..9df94a7 100644
--- a/scripts/cocanwiki.ml
+++ b/scripts/cocanwiki.ml
@@ -1,7 +1,7 @@
 (* 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
@@ -46,8 +46,25 @@ let test_permission edit_anon perm user =
 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 ->
@@ -125,11 +142,13 @@ let register_script ?(restrict = []) run =
 	* 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. *)
diff --git a/scripts/login.ml b/scripts/login.ml
new file mode 100644
index 0000000..84829be
--- /dev/null
+++ b/scripts/login.ml
@@ -0,0 +1,55 @@
+(* 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
diff --git a/scripts/login_form.ml b/scripts/login_form.ml
new file mode 100644
index 0000000..9bd2fe3
--- /dev/null
+++ b/scripts/login_form.ml
@@ -0,0 +1,42 @@
+(* 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
diff --git a/scripts/logout.ml b/scripts/logout.ml
new file mode 100644
index 0000000..2386493
--- /dev/null
+++ b/scripts/logout.ml
@@ -0,0 +1,39 @@
+(* 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
diff --git a/scripts/page.ml b/scripts/page.ml
index 6c7bb75..1fcc223 100644
--- a/scripts/page.ml
+++ b/scripts/page.ml
@@ -1,7 +1,7 @@
 (* 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
@@ -26,7 +26,7 @@ type fp_status = FPOK of int * string * string * Dbi.datetime * bool
 	       | 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
 
@@ -97,6 +97,14 @@ let run r (q : cgi) (dbh : Dbi.connection) (hostid, _, _) _ =
 	   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
 
diff --git a/templates/login_form.html b/templates/login_form.html
new file mode 100644
index 0000000..534ca6a
--- /dev/null
+++ b/templates/login_form.html
@@ -0,0 +1,111 @@
+<!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&nbsp;page</a> | </li>
+<li> <a href="/_sitemap">Sitemap</a> | </li>
+<li> <a href="/_recent">Recent&nbsp;changes</a> </li>
+</ul>
+
+<ul id="bottommenu" class="menu">
+<li> <a href="/">Home&nbsp;page</a> | </li>
+<li> <a href="/_sitemap">Sitemap</a> | </li>
+<li> <a href="/_recent">Recent&nbsp;changes</a> </li>
+</ul>
+
+<hr/>
+
+<ul id="footer" class="menu">
+<li> <a href="/copyright">Copyright &copy; 2004</a> </li>
+</ul>
+
+</body>
+</html>
\ No newline at end of file
diff --git a/templates/page.html b/templates/page.html
index 0a94033..986c5f1 100644
--- a/templates/page.html
+++ b/templates/page.html
@@ -50,7 +50,8 @@
 <li> <a href="/_images">Images</a> | </li>
 <li> <a href="/_files">Files</a> | </li>
 <li> <a href="/::page_html_tag::/editcss">Edit&nbsp;stylesheet&nbsp;for&nbsp;this&nbsp;page</a> | </li>
-<li> <a href="/_bin/admin/admin.cmo">Wiki&nbsp;administration</a> </li>
+<li> <a href="/_bin/admin/admin.cmo">Wiki&nbsp;administration</a> | </li>
+<li> ::if(user_logged_in):: ::username_html:: <a href="/_logout">(logout)</a> ::else:: <a href="/_login">Create&nbsp;account&nbsp;or&nbsp;login</a> ::end:: </li>
 </ul>
 
 <hr/>