[Gd-chatter] r11156 - trunk/libraries/network/koala/sources/koala

hannes at gwydiondylan.org hannes at gwydiondylan.org
Sat Jan 27 03:07:42 CET 2007


Author: hannes
Date: Sat Jan 27 03:07:38 2007
New Revision: 11156

Removed:
   trunk/libraries/network/koala/sources/koala/resources.dylan
   trunk/libraries/network/koala/sources/koala/utils-main.dylan
Modified:
   trunk/libraries/network/koala/sources/koala/dsp.dylan
   trunk/libraries/network/koala/sources/koala/koala-unix.lid
   trunk/libraries/network/koala/sources/koala/koala.lid
   trunk/libraries/network/koala/sources/koala/library-unix.dylan
   trunk/libraries/network/koala/sources/koala/library.dylan
   trunk/libraries/network/koala/sources/koala/response.dylan
   trunk/libraries/network/koala/sources/koala/server.dylan
   trunk/libraries/network/koala/sources/koala/utils.dylan
Log:
Job: minor
remove resources-stuff from koala, since it is slower and
doesn't have sufficient locking implemented. 


Modified: trunk/libraries/network/koala/sources/koala/dsp.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/koala/dsp.dylan	(original)
+++ trunk/libraries/network/koala/sources/koala/dsp.dylan	Sat Jan 27 03:07:38 2007
@@ -95,14 +95,13 @@
 define method process-page (page :: <page>,
                             request :: <request>,
                             response :: <response>)
-  with-resource (pc = <page-context>)
-    dynamic-bind (*page-context* = pc)
-      select (request.request-method)
-        #"POST"   => respond-to-post(page, request, response);
-        #"GET"    => respond-to-get (page, request, response);
-        #"HEAD"   => respond-to-head(page, request, response);
-        otherwise => unsupported-request-method-error();
-      end;
+  let pc = make(<page-context>);
+  dynamic-bind (*page-context* = pc)
+    select (request.request-method)
+      #"POST"   => respond-to-post(page, request, response);
+      #"GET"    => respond-to-get (page, request, response);
+      #"HEAD"   => respond-to-head(page, request, response);
+      otherwise => unsupported-request-method-error();
     end;
   end;
 end process-page;
@@ -643,7 +642,7 @@
 define open primary class <dylan-server-page> (<file-page-mixin>, <page>)
   // A sequence of strings and functions.  Strings are output directly
   // to the network stream.  The functions are created by 'define tag'.
-  slot page-template :: <dsp-template>;
+  each-subclass slot page-template :: <dsp-template>;
 end;
 
 // define page my-dsp (<dylan-server-page>) (url: "/hello", source: make-locator(...), ...)
@@ -816,7 +815,7 @@
 //
 define open method process-template
     (page :: <dylan-server-page>, request :: <request>, response :: <response>)
-  when (page-source-modified?(page))
+  when (page-source-modified?(page) | ~ slot-initialized?(page, page-template))
     page.mod-time := file-property(source-location(page),
                                    #"modification-date");
     page.page-template := parse-page(page);

Modified: trunk/libraries/network/koala/sources/koala/koala-unix.lid
==============================================================================
--- trunk/libraries/network/koala/sources/koala/koala-unix.lid	(original)
+++ trunk/libraries/network/koala/sources/koala/koala-unix.lid	Sat Jan 27 03:07:38 2007
@@ -2,7 +2,6 @@
 files:	library-unix
 	log
 	utils
-	resources
 	variables
 	timer
 	substring
@@ -23,6 +22,5 @@
 	xml-rpc-server
 	config
 	responders
-	utils-main
 	koala-main
 	dsp-main

Modified: trunk/libraries/network/koala/sources/koala/koala.lid
==============================================================================
--- trunk/libraries/network/koala/sources/koala/koala.lid	(original)
+++ trunk/libraries/network/koala/sources/koala/koala.lid	Sat Jan 27 03:07:38 2007
@@ -2,7 +2,6 @@
 files:	library
 	log
 	utils
-	resources
 	variables
 	timer
 	substring
@@ -26,6 +25,5 @@
 	xml-rpc-server
 	config
 	responders
-	utils-main
 	koala-main
 	dsp-main

Modified: trunk/libraries/network/koala/sources/koala/library-unix.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/koala/library-unix.dylan	(original)
+++ trunk/libraries/network/koala/sources/koala/library-unix.dylan	Sat Jan 27 03:07:38 2007
@@ -80,16 +80,6 @@
     mod-time,
     mod-time-setter,
 
-    // Resource pools
-    allocate-resource,
-    deallocate-resource,
-    new-resource,
-    reinitialize-resource,
-    resource-deallocated,
-    resource-size,
-    with-resource,
-    test-resource,
-
     // Attributes
     <attributes-mixin>,
     get-attribute,
@@ -142,7 +132,7 @@
   // Do these really need to be exported?
   create
     <header-table>,
-    *max-single-header-size*,
+    *hmax-single-header-size*,
     *header-buffer-growth-amount*,
     // read-message-headers(stream) => header-table
     read-message-headers,
@@ -409,12 +399,12 @@
     current-row-number,          // dsp:table
 
     note-form-error,             // for any error encountered while processing a web form
-    note-form-message,           // for informative messages in response to processing a web form
-    note-field-error;            // for errors related to processing a specific form field
+    note-form-message;           // for informative messages in response to processing a web form
 
 /*
   // Persistence layer maps database records <-> web pages.
   export
+    note-field-error,            // for errors related to processing a specific form field
     with-database-connection,
     <database-record>,
     <modifiable-record>,

Modified: trunk/libraries/network/koala/sources/koala/library.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/koala/library.dylan	(original)
+++ trunk/libraries/network/koala/sources/koala/library.dylan	Sat Jan 27 03:07:38 2007
@@ -80,16 +80,6 @@
     mod-time,
     mod-time-setter,
 
-    // Resource pools
-    allocate-resource,
-    deallocate-resource,
-    new-resource,
-    reinitialize-resource,
-    resource-deallocated,
-    resource-size,
-    with-resource,
-    test-resource,
-
     // Attributes
     <attributes-mixin>,
     get-attribute,

Modified: trunk/libraries/network/koala/sources/koala/response.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/koala/response.dylan	(original)
+++ trunk/libraries/network/koala/sources/koala/response.dylan	Sat Jan 27 03:07:38 2007
@@ -8,9 +8,6 @@
 
 // Exported
 //
-// If you add a slot to this class you may need to reset that slot to
-// its initial value in the reinitialize-resource method below.
-//
 define open primary class <response> (<object>)
   slot get-request :: <request>, required-init-keyword: #"request";
 
@@ -27,9 +24,6 @@
   slot response-code    :: <integer> = 200;
   slot response-message :: <string>  = "OK";
 
-  // Whether or not the headers were allocated with allocate-resource, in which
-  // case they need to be deallocated with deallocate-resource.
-  slot headers-resourced? :: <boolean> = #f, init-keyword: #"headers-resourced?";
   slot headers-sent? :: <boolean> = #f;
 
   // Whether or not this is a buffered response.
@@ -64,7 +58,7 @@
       // output stream.
       set-content-type(response, default-dynamic-content-type(*virtual-host*),
                        if-exists?: #"ignore");
-      response.%output-stream := allocate-resource(<string-stream>);
+      response.%output-stream := make(<string-stream>, direction: #"output");
     end
 end;
 
@@ -89,60 +83,6 @@
   end;
 end;
 
-
-// Implements part of the resource protocol.
-//
-define method new-resource
-    (resource-class == <response>,
-     #rest initargs,
-     #key request :: <request>, headers :: false-or(<header-table>))
- => (response :: <response>)
-  make(<response>,
-       request: request,
-       headers: headers | allocate-resource(<header-table>),
-       headers-resourced?: ~headers);
-end;
-  
-
-// Implements part of the resource protocol.
-//
-define method reinitialize-resource
-    (response :: <response>,
-     #rest init-args,
-     #key request :: <request>, headers)
-  get-request(response) := request;
-  response-headers(response) := (headers | allocate-resource(<header-table>));
-  headers-resourced?(response) := ~headers;
-  response-code(response)    := 200;
-  response-message(response) := "OK";
-  // Note some reinitialization is done in the resource-deallocated method below.
-end;
-
-// Implements part of the resource protocol.
-//
-define method resource-deallocated
-    (response :: <response>)
-  let stream = %output-stream(response);
-  when (stream)
-    deallocate-resource(<string-stream>, stream);
-    response.%output-stream := #f;
-    response.headers-sent? := #f;
-    iff (response.headers-resourced?,
-         deallocate-resource(<header-table>, response.response-headers));
-  end;
-  next-method();
-end;
-
-// Implements part of the resource protocol.
-//
-define method resource-size
-    (response :: <response>) => (size :: <integer>)
-  let stream = response.%output-stream;
-  iff (stream,
-       stream-size(stream),
-       0)
-end;
-
 // The caller is telling us that either the request is complete or it's OK to
 // send a partial response.  Send the header lines, whatever part of the body
 // has been generated so far, and then clear the output stream.

Modified: trunk/libraries/network/koala/sources/koala/server.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/koala/server.dylan	(original)
+++ trunk/libraries/network/koala/sources/koala/server.dylan	Sat Jan 27 03:07:38 2007
@@ -463,20 +463,26 @@
                 ignore-errors(<socket-condition>,
                               close(client.client-socket, abort: #t));
                 release-client(client);
-                collect-garbage();
               end;
             end method;
       with-lock (server-lock)
-        wrapping-inc!(listener.connections-accepted);
-        wrapping-inc!(server.connections-accepted);
-        let thread = make(<thread>, name: "HTTP Responder",
-                          function:  do-respond);
-        client := make(<client>,
-                       server: server,
-                       listener: listener,
-                       socket: socket,
-                       thread: thread);
-        add!(server.clients, client);
+        block()
+          wrapping-inc!(listener.connections-accepted);
+          wrapping-inc!(server.connections-accepted);
+          let thread = make(<thread>, name: "HTTP Responder",
+                            function:  do-respond);
+          client := make(<client>,
+                         server: server,
+                         listener: listener,
+                         socket: socket,
+                         thread: thread);
+          add!(server.clients, client);
+        exception (e :: <error>)
+          //this should be <thread-error>, which is not yet exported
+          //needs a compiler bootstrap, so specify it sometime later
+          //hannes, 27th January 2007
+          log-info("Thread error %=", e)
+        end;
       end;
       loop();
     end when;
@@ -506,7 +512,7 @@
 
   // Query values from either the URL or the body of the POST, if Content-Type
   // is application/x-www-form-urlencoded.
-  slot request-query-values :: false-or(<string-table>) = #f;
+  constant slot request-query-values :: <string-table> = make(<string-table>);
 
   slot request-session :: false-or(<session>) = #f;
 
@@ -569,33 +575,27 @@
                   end;
                 end;
                   
-            with-resource (query-values = <string-table>)
+            block ()
               block ()
-                block ()
-                  request.request-query-values := query-values;
-                  read-request(request);
-                  dynamic-bind (*request-query-values* = query-values,
-                                *virtual-host* = virtual-host(request))
-                    log-debug("Virtual host for request is '%s'", 
-                              vhost-name(*virtual-host*));
-                    invoke-handler(request);
-                  end;
-                  force-output(request.request-socket);
-                exception (c :: <http-error>)
-                  // Always handle HTTP errors, even when debugging...
-                  send-error-response(request, c);
-                  exit-inner();
+                read-request(request);
+                dynamic-bind (*request-query-values* = request.request-query-values,
+                              *virtual-host* = virtual-host(request))
+                  log-debug("Virtual host for request is '%s'", 
+                            vhost-name(*virtual-host*));
+                  invoke-handler(request);
                 end;
-              cleanup
-                request.request-query-values := #f;
-                deallocate-resource(<string-table>, query-values);
-              exception (c :: <socket-condition>)
-                // Always exit the request handler when a socket error occurs...
-                log-debug("A socket error occurred: %s",
-                          condition-to-string(c));
-                exit-request-handler();
+                force-output(request.request-socket);
+              exception (c :: <http-error>)
+                // Always handle HTTP errors, even when debugging...
+                send-error-response(request, c);
+                exit-inner();
               end;
-            end with-resource;
+            exception (c :: <socket-condition>)
+              // Always exit the request handler when a socket error occurs...
+              log-debug("A socket error occurred: %s",
+                        condition-to-string(c));
+              exit-request-handler();
+            end;
           end block;
           request.request-keep-alive? | exit-request-handler();
         end with-simple-restart;
@@ -790,20 +790,17 @@
 
 define method send-error-response-internal (request :: <request>, err :: <error>)
   let headers = http-error-headers(err);
-  with-resource (response = <response>,
-                 request: request,
-                 headers: headers)
-    let one-liner = http-error-message-no-code(err);
-    unless (request-method(request) == #"head")
-      let out = output-stream(response);
-      set-content-type(response, "text/plain");
-      write(out, condition-to-string(err));
-      write(out, "\r\n");
-    end unless;
-    response.response-code    := http-error-code(err);
-    response.response-message := one-liner;
-    send-response(response);
-  end;
+  let response = make(<response>, request: request, headers: headers);
+  let one-liner = http-error-message-no-code(err);
+  unless (request-method(request) == #"head")
+    let out = output-stream(response);
+    set-content-type(response, "text/plain");
+    write(out, condition-to-string(err));
+    write(out, "\r\n");
+  end unless;
+  response.response-code    := http-error-code(err);
+  response.response-message := one-liner;
+  send-response(response);
 end method;
 
 // Do whatever we need to do depending on the incoming headers for
@@ -941,25 +938,23 @@
 // and generate the appropriate error response.
 define method invoke-handler
     (request :: <request>) => ()
-  with-resource (headers = <header-table>)
-    with-resource (response = <response>,
-                   request: request,
-                   headers: headers)
-      if(request.request-keep-alive?)
-        add-header(response, "Connection", "Keep-Alive");
-      end if;
-      dynamic-bind (*response* = response)
-        if (request.request-responder)
-          log-debug("%s handler found", request-url(request));
-          request.request-responder(request, response);
-        else
-          // generates 404 if not found
-          maybe-serve-static-file(request, response);
-        end;
-      end;
-      send-response(response);
-    end with-resource;
-  end with-resource;
+  let headers = make(<header-table>);
+  let response = make(<response>,
+                      request: request,
+                      headers: headers);
+  if(request.request-keep-alive?)
+    add-header(response, "Connection", "Keep-Alive");
+  end if;
+  dynamic-bind (*response* = response)
+    if (request.request-responder)
+      log-debug("%s handler found", request-url(request));
+      request.request-responder(request, response);
+    else
+      // generates 404 if not found
+      maybe-serve-static-file(request, response);
+    end;
+  end;
+  send-response(response);
 end invoke-handler;
 
 // Read a line of input from the stream, dealing with CRLF correctly.

Modified: trunk/libraries/network/koala/sources/koala/utils.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/koala/utils.dylan	(original)
+++ trunk/libraries/network/koala/sources/koala/utils.dylan	Sat Jan 27 03:07:38 2007
@@ -115,16 +115,6 @@
   constant slot attributes :: <table> = make(<table>);
 end;
 
-define method reinitialize-resource
-    (resource :: <attributes-mixin>, #rest init-args, #key)
-  remove-all-keys!(resource.attributes);
-end;
-
-define method resource-size
-    (resource :: <attributes-mixin>) => (size :: <integer>)
-  size(attributes(resource));
-end;
-
 define generic get-attribute (this :: <attributes-mixin>, key :: <object>, #key);
 define generic set-attribute (this :: <attributes-mixin>, key :: <object>, value :: <object>);
 define generic remove-attribute (this :: <attributes-mixin>, key :: <object>);



More information about the chatter mailing list