[Gd-chatter] r10802 - in trunk/libraries: koala/sources/examples/wiki web-framework

[hannes at gwydiondylan.org]

Author: hannes
Date: Sat Jun 17 21:29:36 2006
New Revision: 10802

Modified:
   trunk/libraries/koala/sources/examples/wiki/classes.dylan
   trunk/libraries/koala/sources/examples/wiki/wiki.dylan
   trunk/libraries/web-framework/library.dylan
   trunk/libraries/web-framework/storage.dylan
   trunk/libraries/web-framework/users.dylan
Log:
Bug: 7219
*locked database access
*hmm, this can still be unsafe (a malicious/not educated user
  can change objects in the storage table without aquiring the lock
 -> I'd really like to have atomic-section support


Modified: trunk/libraries/koala/sources/examples/wiki/classes.dylan
==============================================================================
--- trunk/libraries/koala/sources/examples/wiki/classes.dylan	(original)
+++ trunk/libraries/koala/sources/examples/wiki/classes.dylan	Sat Jun 17 21:29:36 2006
@@ -67,7 +67,9 @@
   let page = find-page(title);
   unless (page)
     page := make(<wiki-page-content>, page-title: title);
-    storage(<wiki-page-content>)[title] := page;
+    with-storage (pages = <wiki-page-content>)
+      pages[title] := page;
+    end;
   end;
   let version = size(page.revisions) + 1;
   unless (version > 1 & content = page.latest-text)
@@ -75,8 +77,10 @@
                         content: content,
                         page-version: version,
                         wiki-page-content: page,
-                        comment: comment);
-    add!(page.revisions, revision);
+                          comment: comment);
+    with-storage (pages = <wiki-page-content>)
+      add!(page.revisions, revision);
+    end;
     save(revision);
   end;
 end;

Modified: trunk/libraries/koala/sources/examples/wiki/wiki.dylan
==============================================================================
--- trunk/libraries/koala/sources/examples/wiki/wiki.dylan	(original)
+++ trunk/libraries/koala/sources/examples/wiki/wiki.dylan	Sat Jun 17 21:29:36 2006
@@ -638,9 +638,9 @@
       application-arguments()[0]
     end;
   //register-url("/wiki/wiki.css", maybe-serve-static-file);
-  dumper();
-  *xmpp-bot* := make(<xmpp-bot>, jid: "dylanbot at jabber.berlin.ccc.de/here", password: "fnord");
-  sleep(5);
+  //dumper();
+  //*xmpp-bot* := make(<xmpp-bot>, jid: "dylanbot at jabber.berlin.ccc.de/here", password: "fnord");
+  //sleep(5);
   start-server(config-file: config-file);
 end;
 

Modified: trunk/libraries/web-framework/library.dylan
==============================================================================
--- trunk/libraries/web-framework/library.dylan	(original)
+++ trunk/libraries/web-framework/library.dylan	Sat Jun 17 21:29:36 2006
@@ -35,6 +35,7 @@
   use koala;
 
   export storage,
+    \with-storage,
     dump-data,
     dumper,
     save,

Modified: trunk/libraries/web-framework/storage.dylan
==============================================================================
--- trunk/libraries/web-framework/storage.dylan	(original)
+++ trunk/libraries/web-framework/storage.dylan	Sat Jun 17 21:29:36 2006
@@ -19,6 +19,8 @@
 
 define variable *version* :: <integer> = 0;
 
+define constant $database-lock = make(<lock>);
+
 define method version () => (res :: <integer>)
   *version*;
 end;
@@ -29,7 +31,7 @@
   <stretchy-vector>;
 end;
 
-define method storage (type) => (res)
+define method storage (type)
   let res = element(*storage*, type, default: #f);
   unless (res)
     res := make(storage-type(type));
@@ -38,10 +40,25 @@
   res;
 end;
 
+
+define macro with-storage
+  { with-storage (?:variable = ?type:expression)
+      ?body:body
+    end }
+ =>  { begin
+         with-lock($database-lock)
+           let ?variable = storage(?type);
+           ?body
+         end
+       end }
+end;
+
 define open generic save (object :: <object>) => ();
 
 define method save (object) => ()
-  add!(storage(object.object-class), object);
+  with-lock($database-lock)
+    add!(storage(object.object-class), object);
+  end;
 end;
 
 define class <storage> (<object>)
@@ -52,18 +69,20 @@
 define constant $filename = last(split(application-name(), '/'));
 
 define method dump-data () => ()
-  let loc = concatenate(*directory*,
-                        $filename,
-                        "-",
-                        integer-to-string(*version*));
-  let dood = make(<dood>,
-                  locator: loc,
-                  direction: #"output",
-                  if-exists: #"replace");
-  dood-root(dood) := make(<storage>);
-  dood-commit(dood);
-  dood-close(dood);
-  *version* := *version* + 1;
+  with-lock ($database-lock)
+    let loc = concatenate(*directory*,
+                          $filename,
+                          "-",
+                          integer-to-string(*version*));
+    let dood = make(<dood>,
+                    locator: loc,
+                    direction: #"output",
+                    if-exists: #"replace");
+    dood-root(dood) := make(<storage>);
+    dood-commit(dood);
+    dood-close(dood);
+    *version* := *version* + 1;
+  end;
 end;
 
 define method restore (filename :: <string>) => ()
@@ -73,11 +92,13 @@
                   direction: #"input");
   let storage = dood-root(dood);
   dood-close(dood);
-  *storage* := storage.hash-table;
-  if (storage.table-version >= *version*)
-    *version* := storage.table-version + 1;
-  else
-    *version* := *version* + 1;
+  with-lock ($database-lock)
+    *storage* := storage.hash-table;
+    if (storage.table-version >= *version*)
+      *version* := storage.table-version + 1;
+    else
+      *version* := *version* + 1;
+    end;
   end;
 end;
 
@@ -100,12 +121,15 @@
   end;
 end;
 
-define function dumper (#key interval :: <integer> = 300) => ()
+define function dumper (#key interval :: <integer> = 300, do-something :: <function>) => ()
   make(<thread>,
        function: method()
                      sleep(23);
                      while(#t)
                        dump-data();
+                       if (do-something)
+                         do-something()
+                       end;
                        sleep(interval);
                      end;
                  end);

Modified: trunk/libraries/web-framework/users.dylan
==============================================================================
--- trunk/libraries/web-framework/users.dylan	(original)
+++ trunk/libraries/web-framework/users.dylan	Sat Jun 17 21:29:36 2006
@@ -11,7 +11,9 @@
 define method initialize (user :: <user>, #rest rest, #key, #all-keys)
   next-method();
   check(user);
-  storage(<user>)[user.username] := user;
+  with-storage (table = <user>)
+    table[user.username] := user;
+  end;
 end;
 
 define inline-only method key (user :: <user>)