[Gd-chatter] r11477 - trunk/libraries/network/web-framework

[turbo24prg at gwydiondylan.org]

Author: turbo24prg
Date: Mon Oct 29 20:09:44 2007
New Revision: 11477

Modified:
   trunk/libraries/network/web-framework/dsp.dylan
   trunk/libraries/network/web-framework/library.dylan
   trunk/libraries/network/web-framework/permission.dylan
   trunk/libraries/network/web-framework/users.dylan
Log:
Job: minor
koala API changes and minor improvements


Modified: trunk/libraries/network/web-framework/dsp.dylan
==============================================================================
--- trunk/libraries/network/web-framework/dsp.dylan	(original)
+++ trunk/libraries/network/web-framework/dsp.dylan	Mon Oct 29 20:09:44 2007
@@ -11,23 +11,26 @@
 // sent values
 define thread variable *form* = #f;
 
-
-define tag show-login-url in web-framework
- (page :: <dylan-server-page>, response :: <response>)
- ()
-  format(output-stream(response),
-    "/?login&amp;redirect=%s", current-url(escaped?: #t));
-end;
-
-define tag show-logout-url in web-framework
- (page :: <dylan-server-page>, response :: <response>)
- ()
-  format(output-stream(response),
-    "/?logout&amp;redirect=%s", current-url(escaped?: #t));
+define tag show-login-url in web-framework (page :: <dylan-server-page>)
+ (redirect :: type-union(<string>, <boolean>), current :: <boolean>)
+  format(current-response().output-stream, "/?login%s",
+    if (redirect)
+      format-to-string("&amp;redirect=%s",
+        encode-url(if (current) current-url() else redirect end if, reserved?: #t));
+    else "" end);
+end;
+
+define tag show-logout-url in web-framework (page :: <dylan-server-page>)
+ (redirect :: type-union(<string>, <boolean>), current :: <boolean>)
+  format(current-response().output-stream, "/?logout%s",
+    if (redirect)
+      format-to-string("&amp;redirect=%s",
+        encode-url(if (current) current-url() else redirect end if, reserved?: #t));
+    else "" end);
 end;
 
-define named-method authenticated? in web-framework
- (page :: <dylan-server-page>, request :: <request>)
+
+define named-method authenticated? in web-framework (page :: <dylan-server-page>)
   authenticated-user()
 end;
 
@@ -51,12 +54,12 @@
  { define action-test ( ?:name ) in ?taglib:name end }
   => { 
        define named-method ?name ## "?" in ?taglib
-        (page :: <dylan-server-page>, request :: <request>)
+        (page :: <dylan-server-page>)
          *action* = ?#"name"
        end;
 
        define named-method ?name ## "-permitted?" in ?taglib
-        (page :: <dylan-server-page>, request :: <request>)
+        (page :: <dylan-server-page>)
          block ()
            permitted?(?#"name");
            #t;
@@ -89,7 +92,7 @@
       define thread variable "*" ## ?name ## "*" = #f;
 
       define named-method ?name ## "?" in ?taglib
-       (page :: <dylan-server-page>, request :: <request>)
+       (page :: <dylan-server-page>)
         "*" ## ?name ## "*"
       end 
     }
@@ -115,7 +118,7 @@
  { define error-test (?:name) in ?taglib:name end }
   => { 
        define named-method ?name ## "-error?" in ?taglib
-        (page :: <dylan-server-page>, request :: <request>)
+        (page :: <dylan-server-page>)
          member?(?#"name", *errors*)
        end 
      }

Modified: trunk/libraries/network/web-framework/library.dylan
==============================================================================
--- trunk/libraries/network/web-framework/library.dylan	(original)
+++ trunk/libraries/network/web-framework/library.dylan	Mon Oct 29 20:09:44 2007
@@ -235,9 +235,12 @@
 define module permission
   use common-dylan;
 
-  export <permission-error>,
-    <authentication-error>;
-  export permitted?;
+  export with-permission,
+    <permission-error>,
+    <authentication-error>,
+    permitted?,
+    permission-error,
+    authentication-error;
 end;
 
 define module web-framework

Modified: trunk/libraries/network/web-framework/permission.dylan
==============================================================================
--- trunk/libraries/network/web-framework/permission.dylan	(original)
+++ trunk/libraries/network/web-framework/permission.dylan	Mon Oct 29 20:09:44 2007
@@ -1,9 +1,8 @@
 module: permission
 author: turbo24prg
 
-/*
 define macro with-permission
- { with-permission(?action:*)
+ { with-permission (?action:*)
     ?:body
    end }
  =>
@@ -11,16 +10,19 @@
        permitted?(?action);
        ?body
      exception (condition :: <permission-error>)
-       get(*unprivileged-page*);
+       permission-error(?action)
      exception (condition :: <authentication-error>)
-       get(*not-logged-in-page*);
+       authentication-error(?action);
      end block }
 end;
-*/
+
+define open generic authentication-error (action :: <object>, #key #all-keys);
+define open generic permission-error (action :: <object>, #key #all-keys);
+
 define class <permission-error> (<error>) end;
 define class <authentication-error> (<error>) end;
 
-define generic permitted? (action :: <symbol>, #key #all-keys)
+define open generic permitted? (action :: <object>, #key #all-keys)
  => (permitted? :: <boolean>);
 
 define method permitted? (action :: <symbol>, #key)

Modified: trunk/libraries/network/web-framework/users.dylan
==============================================================================
--- trunk/libraries/network/web-framework/users.dylan	(original)
+++ trunk/libraries/network/web-framework/users.dylan	Mon Oct 29 20:09:44 2007
@@ -124,3 +124,9 @@
   add-header(headers, "WWW-Authenticate", concatenate("Basic realm=\"", realm, "\""));
   unauthorized-error(headers: headers);
 end;
+
+define method \= (user1 :: <user>, user2 :: <user>)
+ => (equal? :: <boolean>);
+  user1.username = user2.username
+end;
+