Commit 77812947 authored by stolpmann's avatar stolpmann

Added <q:wd-link> and <q:wd-xlink> to generate links for

applications that cannot use Javascript. Limited functionality, however.
See stdlib.xml for details.


git-svn-id: https://godirepo.camlcity.org/svn/wdialog/trunk@194 f54c9a64-0731-4a92-b797-30fd5898f27c
parent 7ce57ca8
<?xml version="1.0" encoding="us-ascii"?>
<!-- $Id: stdlib.xml,v 3.1 2002-02-12 20:28:58 stolpmann Exp $ -->
<!-- $Id: stdlib.xml,v 3.2 2004-12-12 17:57:32 stolpmann Exp $ -->
<!-- This is the library of standard templates for WDialog. Some of
the templates are called by built-in transformations, these
......@@ -139,6 +139,37 @@
</ui:libtemplate>
<!-- *** EXPERIMENTAL *** -->
<!-- <q:wd-link name="name-of-link">Text</q:wd-link>:
- Creates a link (HTML element "A") to the application itself. The session
- remains the same. This works only if the session is stored in a database.
- Furthermore, you must set enable_checksum:false when the database session
- manager is created, and your application must be prepared that the user
- clicks the link at any time (it is no longer guaranteed that the real
- browser session is in synch with the session object in the database).
- However, in practice the latter is usually caught because the interactor
- ID is not found in the database.
-
- By passing the linksuffix parameter, you can append an arbitrary suffix
- to the generated URL (e.g. pass parameters manually).
-->
<ui:libtemplate name="wd-link" from-caller="linksuffix body name">
<ui:default name="linksuffix">ui_dummy=1</ui:default>
<a href="$[self_base_url()]?uiobject_session=$[session_id()]:none&amp;uiobject_visible_pages=$[page()]&amp;anchor_$[create_anchor_event($name)]=1&amp;$linksuffix">$body</a>
</ui:libtemplate>
<!-- <q:wd-xlink name="name-of-link" index="arbitrary-value">Text</q:wd-xlink>:
- Same for indexed anchors.
-->
<ui:libtemplate name="wd-xlink" from-caller="linksuffix body name index">
<ui:default name="linksuffix">ui_dummy=1</ui:default>
<a href="$[self_base_url()]?uiobject_session=$[session_id()]:none&amp;uiobject_visible_pages=$[page()]&amp;xanchor_$[create_xanchor_event($name,$index)]=1&amp;$linksuffix">$body</a>
</ui:libtemplate>
<!-- **********************************************************************
*** CORE TEMPLATES ***
......@@ -460,7 +491,12 @@
History
$Log: stdlib.xml,v $
Revision 3.1 2002-02-12 20:28:58 stolpmann
Revision 3.2 2004-12-12 17:57:32 stolpmann
Added <q:wd-link> and <q:wd-xlink> to generate links for
applications that cannot use Javascript. Limited functionality, however.
See stdlib.xml for details.
Revision 3.1 2002/02/12 20:28:58 stolpmann
Initial release at sourceforge.
Revision 2.1 2002/02/07 17:29:37 gerd
......
......@@ -21,7 +21,7 @@
* </>
*)
(* $Id: wd_application.ml,v 3.7 2003-03-21 12:50:31 stolpmann Exp $
(* $Id: wd_application.ml,v 3.8 2004-12-12 17:57:32 stolpmann Exp $
* ----------------------------------------------------------------------
*
*)
......@@ -86,6 +86,10 @@ class application init_dtd : application_type =
self # add_var_function "dialog" Wd_var_functions.dialog;
self # add_var_function "page" Wd_var_functions.page;
self # add_var_function "language" Wd_var_functions.language;
self # add_var_function "self_base_url" Wd_var_functions.self_base_url;
self # add_var_function "session_id" Wd_var_functions.session_id;
self # add_var_function "create_anchor_event" Wd_var_functions.create_anchor_event;
self # add_var_function "create_xanchor_event" Wd_var_functions.create_xanchor_event;
(* There are also the following, magically defined functions:
* - type
* - is_associative
......@@ -197,7 +201,12 @@ class application init_dtd : application_type =
* History:
*
* $Log: wd_application.ml,v $
* Revision 3.7 2003-03-21 12:50:31 stolpmann
* Revision 3.8 2004-12-12 17:57:32 stolpmann
* Added <q:wd-link> and <q:wd-xlink> to generate links for
* applications that cannot use Javascript. Limited functionality, however.
* See stdlib.xml for details.
*
* Revision 3.7 2003/03/21 12:50:31 stolpmann
* Fix: encode_as_js_longstring can cope with UTF8-encoded strings
*
* Revision 3.6 2003/02/16 23:48:14 stolpmann
......
This diff is collapsed.
......@@ -21,14 +21,14 @@
* </>
*)
(* $Id: wd_dialog.ml,v 3.10 2003-03-10 23:23:27 stolpmann Exp $
(* $Id: wd_dialog.ml,v 3.11 2004-12-12 17:57:32 stolpmann Exp $
* ----------------------------------------------------------------------
*
*)
open Wd_types
let revision_dialog = "$Revision: 3.10 $" ;;
let revision_dialog = "$Revision: 3.11 $" ;;
(* intentionally the CVS revision string *)
type serialized_var_value =
......@@ -125,6 +125,8 @@ class virtual dialog
val mutable upload_manager = lazy ( assert false )
val mutable session = None
initializer
self # init (declaration # start_page);
......@@ -711,6 +713,17 @@ class virtual dialog
(* TODO: interactors *)
Format.fprintf f "@]@\n</dialog-value>";
method enter_session_scope s =
session <- Some s
method leave_session_scope () =
session <- None
method session =
match session with
Some s -> s
| None -> failwith "Session-related function called, but the dialog is currently outside the scope of a session"
method environment = environment
method declaration = declaration
method application = application
......@@ -755,6 +768,8 @@ class instant_session init_dialog : session_type =
Netencoding.Base64.encode ~linelength:64 encoded_session
method change_dialog dlg =
dialog <- dlg;
method session_id =
failwith "The instant session manager does not provide session IDs"
end
;;
......@@ -836,6 +851,11 @@ object (self)
checksum <- Digest.to_hex (Digest.string inst_session#serialize);
string_of_int id ^ ":" ^ key ^ ":" ^ checksum
method session_id =
string_of_int id ^ ":" ^ key
method change_dialog dlg =
inst_session # change_dialog dlg
end
......@@ -845,7 +865,8 @@ end
let id_key_cs_re = Netstring_pcre.regexp "^([0-9]+):([^:]*):([^:]*)$"
;;
class database_session_manager ?(private_key = "")
class database_session_manager ?(private_key = "")
?(enable_checksum = true)
~allocate ~insert ~update ~lookup () =
object (self)
inherit instant_session_manager () as super
......@@ -884,7 +905,7 @@ object (self)
Netstring_pcre.matched_group r 3 id_key_cs)
in
let value, checksum = lookup id key in
if cs <> checksum then raise Invalid_session_checksum;
if enable_checksum && cs <> checksum then raise Invalid_session_checksum;
new database_session ~update id key (super # unserialize universe env value)
end
;;
......@@ -894,7 +915,12 @@ end
* History:
*
* $Log: wd_dialog.ml,v $
* Revision 3.10 2003-03-10 23:23:27 stolpmann
* Revision 3.11 2004-12-12 17:57:32 stolpmann
* Added <q:wd-link> and <q:wd-xlink> to generate links for
* applications that cannot use Javascript. Limited functionality, however.
* See stdlib.xml for details.
*
* Revision 3.10 2003/03/10 23:23:27 stolpmann
* Another security improvement: The checksum now changes after
* every web request
*
......
......@@ -21,7 +21,7 @@
* </>
*)
(* $Id: wd_dialog.mli,v 3.6 2003-03-21 20:57:54 stolpmann Exp $
(* $Id: wd_dialog.mli,v 3.7 2004-12-12 17:57:32 stolpmann Exp $
* ----------------------------------------------------------------------
*
*)
......@@ -163,6 +163,7 @@ exception Session_not_found
class database_session_manager :
?private_key : string ->
?enable_checksum : bool ->
allocate:(unit -> int) ->
insert:(int -> string -> unit) ->
update:(int -> string -> string -> string -> unit) ->
......@@ -223,13 +224,26 @@ class database_session_manager :
* secure key unpredictable for the user, so nobody can "hijack" a
* session by guessing the secure key.
*
* @param enable_checksum If true (the default), the checksum of the
* web request is compared with the database checksum. This ensures that
* only responses of the latest dialog state can be processed. By
* setting this parameter to [false], the checksum is ignored, and the
* user can also submit historical web forms. In general, this is a bad
* idea, and you will run into trouble, unless your application is can
* cope with that.
*
*)
(* ======================================================================
* History:
*
* $Log: wd_dialog.mli,v $
* Revision 3.6 2003-03-21 20:57:54 stolpmann
* Revision 3.7 2004-12-12 17:57:32 stolpmann
* Added <q:wd-link> and <q:wd-xlink> to generate links for
* applications that cannot use Javascript. Limited functionality, however.
* See stdlib.xml for details.
*
* Revision 3.6 2003/03/21 20:57:54 stolpmann
* ocamldoc problems
*
* Revision 3.5 2003/03/21 14:23:44 stolpmann
......
......@@ -21,7 +21,7 @@
* </>
*)
(* $Id: wd_types.ml,v 3.7 2003-02-16 23:48:15 stolpmann Exp $
(* $Id: wd_types.ml,v 3.8 2004-12-12 17:57:32 stolpmann Exp $
* ----------------------------------------------------------------------
*
*)
......@@ -385,6 +385,10 @@ and virtual dialog_type =
* previously serialized dialog.
*)
method enter_session_scope : session_type -> unit
method leave_session_scope : unit -> unit
method session : session_type
method environment : environment
method declaration : dialog_decl_type
method application : application_type
......@@ -551,7 +555,8 @@ and session_manager_type =
end
and session_type =
object
object
method session_id : string
method dialog_name : string
method dialog : dialog_type
(* Returns the dialog *)
......@@ -593,14 +598,19 @@ exception Instantiation_error of string
* catch this exception and report the error from its own view
*)
let revision_types = "$Revision: 3.7 $" ;;
let revision_types = "$Revision: 3.8 $" ;;
(* Intentionally the CVS revision string! *)
(* ======================================================================
* History:
*
* $Log: wd_types.ml,v $
* Revision 3.7 2003-02-16 23:48:15 stolpmann
* Revision 3.8 2004-12-12 17:57:32 stolpmann
* Added <q:wd-link> and <q:wd-xlink> to generate links for
* applications that cannot use Javascript. Limited functionality, however.
* See stdlib.xml for details.
*
* Revision 3.7 2003/02/16 23:48:15 stolpmann
* Improved wd-debug-mode: there are now two styles
*
* Revision 3.6 2003/01/04 21:55:25 stolpmann
......
......@@ -21,7 +21,7 @@
* </>
*)
(* $Id: wd_types.mli,v 3.10 2003-03-21 14:23:44 stolpmann Exp $
(* $Id: wd_types.mli,v 3.11 2004-12-12 17:57:32 stolpmann Exp $
* ----------------------------------------------------------------------
*
*)
......@@ -368,7 +368,11 @@ and virtual dialog_type =
object ('self)
method copy : dialog_type
(** return a copy of the dialog *)
(** return a copy of the dialog
*
* The copy is not attached to a session, even if the original object
* is.
*)
method name : string
(** return the name of the dialog *)
method page_name : string
......@@ -478,6 +482,14 @@ and virtual dialog_type =
* previously serialized dialog.
*)
method enter_session_scope : session_type -> unit
(** Tells the dialog the current session *)
method leave_session_scope : unit -> unit
(** Tells the dialog that it is no longer under control of this session
*)
method session : session_type
(** Returns the current session. Fails when there is no session *)
method environment : environment
(** Return the environment of the current CGI activation *)
method declaration : dialog_decl_type
......@@ -752,6 +764,11 @@ and session_manager_type =
and session_type =
object
method session_id : string
(** Returns the ID of the session. Fails if the session does not have
* an ID (e.g. it is not stored in the database)
*)
method dialog_name : string
(** Returns the name of the dialog this session encapsulates *)
......@@ -834,7 +851,12 @@ val revision_types : string
* History:
*
* $Log: wd_types.mli,v $
* Revision 3.10 2003-03-21 14:23:44 stolpmann
* Revision 3.11 2004-12-12 17:57:32 stolpmann
* Added <q:wd-link> and <q:wd-xlink> to generate links for
* applications that cannot use Javascript. Limited functionality, however.
* See stdlib.xml for details.
*
* Revision 3.10 2003/03/21 14:23:44 stolpmann
* ocamldoc updated
*
* Revision 3.9 2003/02/21 21:58:53 stolpmann
......
......@@ -21,7 +21,7 @@
* </>
*)
(* $Id: wd_var_functions.ml,v 1.4 2003-06-21 12:09:08 stolpmann Exp $
(* $Id: wd_var_functions.ml,v 1.5 2004-12-12 17:57:32 stolpmann Exp $
* ----------------------------------------------------------------------
*
*)
......@@ -207,6 +207,20 @@ let unary_string_operation name op dlg args =
;;
let binary_string_operation name op dlg args =
match args with
[a1;a2] ->
( match a1, a2 with
(String_value s1), (String_value s2) ->
op dlg s1 s2
| _ ->
failwith ("function `" ^ name ^ "': bad type of operands")
)
| _ ->
failwith ("function `" ^ name ^ "': expects exactly two arguments")
;;
let rec count_height s n k =
let next_cr_or_lf = Pxp_lib.crlf_index_from s k in
if next_cr_or_lf >= 0 then begin
......@@ -311,12 +325,52 @@ let language =
)
let self_base_url =
const_operation "self_base_url"
(fun dlg ->
let cgi = (dlg # environment).cgi in
let script_path = cgi # environment # cgi_script_name in
let script_name = Filename.basename script_path in
String_value(script_name)
)
;;
let session_id =
const_operation "session_id"
(fun dlg ->
String_value(dlg # session # session_id)
)
;;
let create_anchor_event =
unary_string_operation "create_anchor_event"
(fun dlg s ->
let ia = dlg # interactors in
let id = Wd_interactor.add ia.ui_anchors s "" None None in
String_value id
)
;;
let create_xanchor_event =
binary_string_operation "create_xanchor_event"
(fun dlg s1 s2 ->
let ia = dlg # interactors in
let id = Wd_interactor.add ia.ui_indexed_anchors s1 s2 None None in
String_value id
)
;;
(* ======================================================================
* History:
*
* $Log: wd_var_functions.ml,v $
* Revision 1.4 2003-06-21 12:09:08 stolpmann
* Revision 1.5 2004-12-12 17:57:32 stolpmann
* Added <q:wd-link> and <q:wd-xlink> to generate links for
* applications that cannot use Javascript. Limited functionality, however.
* See stdlib.xml for details.
*
* Revision 1.4 2003/06/21 12:09:08 stolpmann
* Updates because of changes in Ocamlnet 0.96
*
* Revision 1.3 2003/02/16 01:07:03 stolpmann
......
......@@ -21,7 +21,7 @@
* </>
*)
(* $Id: wd_var_functions.mli,v 1.3 2003-02-16 01:07:03 stolpmann Exp $
(* $Id: wd_var_functions.mli,v 1.4 2004-12-12 17:57:32 stolpmann Exp $
* ----------------------------------------------------------------------
*
*)
......@@ -145,11 +145,29 @@ val page : dialog_type -> var_value list -> var_value
val language : dialog_type -> var_value list -> var_value
(** Returns the current language, or "" if none selected (no arguments) *)
val self_base_url : dialog_type -> var_value list -> var_value
(** Returns the URL pointing to the current script without session state *)
val session_id : dialog_type -> var_value list -> var_value
(** Returns the session ID without checksum *)
val create_anchor_event : dialog_type -> var_value list -> var_value
(** Add an anchor event and return the identifier *)
val create_xanchor_event : dialog_type -> var_value list -> var_value
(** Add an indexed anchor event and return the identifier *)
(* ======================================================================
* History:
*
* $Log: wd_var_functions.mli,v $
* Revision 1.3 2003-02-16 01:07:03 stolpmann
* Revision 1.4 2004-12-12 17:57:32 stolpmann
* Added <q:wd-link> and <q:wd-xlink> to generate links for
* applications that cannot use Javascript. Limited functionality, however.
* See stdlib.xml for details.
*
* Revision 1.3 2003/02/16 01:07:03 stolpmann
* size, substring, width: string positions are measured as
* the number of characters, not as the number of bytes
*
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment