Re: [Help-smalltalk] How to restart an image running a server?

[Mike Anderson]

Paolo Bonzini wrote:
> The short answer is: I don't have a clue, but I have a feeling that the
> attached patch might fix it (just by grepping the sources for senders of
> isPeerAlive) -- or a similar patch for your classes.

Well, I still have a backtrace, but it's not as nasty-looking as the
last one, so thank you!

> Looks like you have something to contribute, haven't you?
> *cat-from-shrek2-look*

Well, if you put it like that :)

I don't really have much, though. I have a little web server evaluating
expressions submitted from an HTML form, which is nothing that you
couldn't code yourself. Attached is a couple of patches for the
WebServer which I worked out along the way, though. (Looking at them, I
notice there's a FIXME in there, which I know you dislike - sorry)

I was working on an SVG browser initially, inspired by the class
diagrams in "Smalltalk, Objects and Design" - screenshots here:
http://www.friendofthepigeon.co.uk/wordpress/?p=41.

Unfortunately, although Firefox renders them fine (as you can see),
something about rotated text seems to make it ramp up the processor,
which reduces the usability hugely. I thought I'd work on some other
aspects of the system, like getting the server's image to restart.

I suppose I could use horizontal text. Chamond Liu does...

Regards,

Mike

--- old/ContentHandler.st       2006-10-04 20:26:05.000000000 +0000
+++ new/ContentHandler.st       2006-10-04 20:27:42.000000000 +0000
@@ -176,6 +176,7 @@
        ('spl' 'application/futuresplash')
        ('st' 'text/plain')                     "Of course!"
        ('swf' 'application/x-shockwave-flash')
+       ('svg' 'image/svg+xml')
        ('tar' 'application/x-tar')
        ('tgz' 'application/x-compressed')
        ('tif' 'image/tiff')

--- old/NetServer.st    2006-10-04 19:13:16.000000000 +0000
+++ new/NetServer.st    2006-10-04 19:14:39.000000000 +0000
@@ -134,7 +134,7 @@
 at: port
     | server |
     Servers isNil ifTrue: [ Servers := Dictionary new ].
-    ^Servers at: port ifAbsentPut: [ self new ].
+    ^Servers at: port ifAbsentPut: [ (self new) port: port; yourself ].
 !
 
 initializeServer: port

--- old/WebServer.st    2006-03-26 01:49:09.000000000 +0000
+++ new/WebServer.st    2006-10-04 19:24:39.000000000 +0000
@@ -229,6 +229,12 @@
     self server log: req action uri: req location time: time.
 ! !
 
+Servlet class methodsFor: 'instance creation'!
+
+named: aString
+    ^(self new) name: aString; yourself
+! !
+
 
 !Servlet methodsFor: 'accessing'!
 
@@ -370,7 +376,12 @@
 notModified
     | ifModSince modTime |
     ifModSince := request at: #'IF-MODIFIED-SINCE' ifAbsent: [ nil ].
-    ^ifModSince notNil and: [ self modifiedTime <= ifModSince ]!
+       modTime := self modifiedTime.
+       ifModSince notNil ifTrue:
+               [ "Need equivalent of WebRequest >> #parseTimestamp:"
+               ifModSince := DateTime readFrom: 
+                       ((ifModSince readStream) skip: 5; yourself).    ].
+    ^ifModSince notNil and: [ modTime <= ifModSince ]!
 
 request
     ^request!
@@ -603,10 +614,20 @@
     stream next.                               "Get nl"
 
     self extractClientData: version.
-    (action sameAs: 'POST') ifTrue: [ self extractPostData: version ].
-    
-    "Get back to binary mode"
-    stream := saveStream!
+               
+       (action sameAs: 'POST') ifTrue: 
+               [ self 
+                       extractPostData: version 
+                       contentLength: (clientData at: #'CONTENT-LENGTH' 
ifAbsent: [ nil ])].
+
+       "Get back to binary mode"
+    stream := saveStream.!
+
+hasPostData
+    ^postData notEmpty!
+
+postDataAt: aSymbol ifPresent: aBlock
+    ^postData at: aSymbol ifPresent: aBlock!
 
 location
     ^location!
@@ -734,28 +755,39 @@
 
 extractLocation
     uri := (stream upToAll: 'HTTP/') trimSeparators.
-    location := uri substrings: $?.
+    location := uri subStrings: $?.
+       location isEmpty ifTrue:
+               [ self error: 'Empty uri: ', uri, '.' ].
     location size = 2 ifTrue: [ self extractQueryData: (location at: 2) ].
     location := (location at: 1) substrings: $/.
     location := location collect: [:each | (URL decode: each) ].
     location := location reject: [:each | each isEmpty ]!
 
-extractPostData: clientVersion
+extractPostData: clientVersion contentLength: contentLength
+       | s |
     clientVersion ~= '1.0'
-       ifTrue: [ stream nextPut: 'HTTP/1.1 100 Continue'; nl; nl ].
+               ifTrue: [ stream nextPutAll: 'HTTP/1.1 100 Continue'; nl; nl ].
 
     (self at: #'CONTENT-TYPE' ifAbsent: [ nil ]) ~=
-       'application/x-www-form-urlencoded' ifTrue: [ ^self ].
-
-    ^self extractQueryData: (stream upTo: Character cr)!
+               'application/x-www-form-urlencoded' ifTrue: [ ^self ].
+       
+       "FIXME: Parse the stream directly, rather than loading it all into 
+       memory, because it could be large."
+       s := contentLength notNil 
+               ifTrue:
+                       [ stream next: contentLength asInteger ]
+               ifFalse:
+                       [ stream upTo: Character cr ].
+       
+       ^self extractQueryData: s.!
 
 extractQueryData: query
-    (query substrings: $&) do: [ :each || pair |
-       pair := each substrings: $=.
-       self
-           postDataAt: (URL decode: pair first) asSymbol
-           put: (URL decode: pair last)
-    ]!
+    (query substrings: $&) do: 
+               [ :each || pair |
+               pair := each substrings: $=.
+               self
+                       postDataAt: (URL decode: pair first) asSymbol
+                       put: (URL decode: (pair at: 2 ifAbsent: [ '' ])) ].!
 
 postDataAt: aSymbol put: aValue
     ^postData at: aSymbol put: aValue! !