(*
* <COPYRIGHT>
* Copyright 2003 Gerd Stolpmann
*
* <GPL>
* This file is part of WTimer.
*
* WTimer 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.
*
* WTimer 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 WDialog; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
* </>
*)
(* $Id$
* ----------------------------------------------------------------------
*
*)
(* This module defines a virtual class "error_behaviour" for two
* purposes:
* - uniform handling of error situations
* - basic authentication checks that should be done for each click
*
* The dialogs (except startpage) should inherit from error_behaviour,
* and they should define these methods:
* - try_prepare_page instead of "prepare_page"
* - try_handle instead of "handle"
* - check_auth to get the basic auth checks
*
* There is a function check_auth that can be used as an implementation
* for the method check_auth. It checks that the user account still
* exists, and that (in the case of basic authentication) the variable
* REMOTE_USER has a valid value.
*)
open Wd_dialog
open Wd_run_cgi
open Wd_types
open Db_types.Types
open Db_types
open Db.Types
open Printf
exception Login_not_permitted
let errid_of_error error =
match error with
Db_ac.Types.Permission_denied -> "permission-denied"
| Db.Session.Session_not_found -> "session-not-found"
| Db.Session.Invalid_session_checksum -> "invalid-session-checksum"
| Db.Types.No_such_user _ -> "no-such-user"
| Db.Types.User_already_exists _ -> "user-already-exists"
| Db.Types.No_such_instance _ -> "no-such-instance"
| Db.Types.Instance_already_exists _ -> "instance-already-exists"
| Login_not_permitted -> "login-not-permitted"
| _ -> "internal-error"
;;
let check_auth db (session_opt : dialog_type option) =
(* This is called for all dialogs except "startpage" to verify that
* the user still has an account.
*)
let session =
match session_opt with Some s -> s | None -> assert false in
let dtd = session # application # dtd in
let option name =
try
let (e,_) = dtd # gen_entity name in
Pxp_dtd.Entity.replacement_text e
with
_ ->
failwith ("Cannot find configuration option " ^ name) in
let login_dialog = (option "login-dialog" = "yes") in
let login_user = session # string_variable "login-user" in
if not login_dialog then begin
(* check that login_user matches REMOTE_USER *)
let cgi = (session # environment).cgi in
let cgienv = cgi # environment in
if cgienv # cgi_remote_user <> login_user then
raise Login_not_permitted
end;
(* Check that the user account exists and permits login *)
let user_passes =
( try
let urec = Db.User.get db (User login_user) in
urec.u_login
with
No_such_user _ -> false
| Not_found -> false
) in
if not user_passes then
raise Login_not_permitted
;;
class virtual error_behaviour =
object(self)
method private virtual try_prepare_page : unit -> unit
method private virtual try_handle : unit -> unit
method private virtual check_auth : unit -> unit
method private prepare_error_page error =
let errid = errid_of_error error in
self # set_variable "runtime-error" (String_value errid);
self # set_next_page "runtime-error"
method private handle_error error =
self # prepare_error_page error;
()
method prepare_page() =
try
self # check_auth();
self # try_prepare_page()
with
( Db_ac.Types.Permission_denied
| Db.Session.Session_not_found
| Db.Session.Invalid_session_checksum
| Db.Types.No_such_user _
| Db.Types.User_already_exists _
| Db.Types.No_such_instance _
| Db.Types.Instance_already_exists _
| Login_not_permitted as error ) ->
self # prepare_error_page error
method handle() =
try
self # check_auth();
self # try_handle()
with
( Db_ac.Types.Permission_denied
| Db.Session.Session_not_found
| Db.Session.Invalid_session_checksum
| Db.Types.No_such_user _
| Db.Types.User_already_exists _
| Db.Types.No_such_instance _
| Db.Types.Instance_already_exists _
| Login_not_permitted as error ) ->
self # handle_error error
end