How to restart an image running a server?

Hello All,

I have an HTTP server, and I want to be able to snapshot the image and
have the server come up again when the image is restarted. I have this
partially working, but aspects of it are puzzling me greatly and I'm
hoping that someone can shed some light on it.

I have created a proxy class ExternalResource which wraps all calls to
the NetServers's Socket (held in the inst var. resource). After image
restart I want to nil resource, and then use createBlock to lazily
recreate it.

Object subclass: #ExternalResource
        instanceVariableNames: 'resource createBlock'
        classVariableNames: 'ExternalProcesses'
        ...

ExternalResource >> ensureValid
        resource isNil ifTrue: [ resource := createBlock value ].
        ^resource

ExternalResource >> anyMethodOfSocket
        "Example of wrapper methods."
        ^self ensureValid anyMethodOfSocket

ExternalResource class update: aspect
        aspect == #returnFromSnapshot ifTrue:
            [ self withAllSubclassesDo:
                [ :class | class allInstancesDo:
                    [ :obj | obj invalidate "resource := nil" ] ] ].

However, I find that that doesn't work - I get a backtrace
(backtrace1.log) on restart and the server is not available.

I changed the code so that it suspends the process accessing the socket
before it loops through doing the invalidate code above. Following this,
the server comes back up. I get one backtrace (backtrace2.log), which I
think is the result of the process that was in the middle of serving the
request that caused the snapshot, but otherwise all is well.

ExternalResource >> anyMethodOfSocket
        "Example of wrapper methods."
        ExternalProcesses add: Processor activeProcess.
        [ ^self ensureValid anyMethodOfSocket ]
                ensure:
                [ ExternalProcesses remove: Processor activeProcess. ].

ExternalResource class >> update: aspect
        | ps |
        #returnFromSnapshot = aspect ifFalse: [ ^self ].
        (ps := ExternalProcesses asSet)
                remove: Processor activeProcess ifAbsent: [].
        ps do: [ :each | each suspend ].
        self withAllSubclassesDo:
                [ :class | class allInstancesDo:
                        [ :obj | obj invalidate ] ].
        ps do: [ :each | each resume ].

Pleased with this, I thought it would be neater to suspend the process
*before* the snapshot, to guarantee the sequence of events. However, I
now get a backtrace when I snapshot the image (backtrace3a.log), even
though the server seems to continue running fine. If I restart this
image, I again get a backtrace immediately (backtrace3b.log), but again,
the server seems to be running fine.

ExternalResource class >> update: aspect
        | ps |
        (#(#aboutToSnapshot #finishedSnapshot #returnFromSnapshot)
                includes: aspect) ifFalse: [ ^self ].
        (ps := ExternalProcesses asSet)
                remove: Processor activeProcess ifAbsent: [].
        aspect = #aboutToSnapshot ifTrue:
                [ ps do: [ :each | each suspend ].
                ^self ].
        aspect == #returnFromSnapshot ifTrue:
                [ self withAllSubclassesDo:
                        [ :class | class allInstancesDo:
                                [ :obj | obj invalidate ] ] ].
        ps do: [ :each | each resume ].

I hope I've posted enough code for all this to make sense. There's quite
a lot of code in total, and I don't know how to bundle it up
conveniently, so I've tried to summarize the key methods.

The things confusing me are:

Why do I need to suspend the process at all? Presumably this means that
the process sending update: #returnFromSnapshot is not a privileged
process and other processes are able to get processor time?

Why does my 'neater' version give me a backtrace when I snapshot? Is
there something about suspending that process that is a no-no?

I'd really like to get to the bottom of this.

Mike



 2006-10-03T21:24:54+00:00 <= nil ?
Object: nil error: did not understand #do:
UndefinedObject(Object)>>#primError:
MessageNotUnderstood(Exception)>>#defaultAction
optimized [] in Exception class>>#coreException
MessageNotUnderstood(Signal)>>#activateHandler:
CoreException>>#activateOuterHandlerFor:
MessageNotUnderstood(Signal)>>#pass
optimized [] in NetClients.NetSession>>#run
MessageNotUnderstood(Signal)>>#activateHandler:
MessageNotUnderstood(Exception)>>#signal
UndefinedObject(Object)>>#doesNotUnderstand:
DLD class>>#primDefineExternFunc:
DLD class>>#defineExternFunc:
CFunctionDescriptor class>>#addressOf:
CFunctionDescriptor>>#isValid
CFunctionDescriptor>>#callFrom:into:
TCP.TCPSocketImpl class(TCP.AbstractSocketImpl class)>>#soError
TCP.TCPSocketImpl(TCP.AbstractSocketImpl)>>#soError
optimized [] in TCP.AbstractSocketImpl>>#ensureWriteable
BlockClosure>>#ensure:
optimized [] in TCP.AbstractSocketImpl>>#ensureWriteable
TCP.TCPSocketImpl(TCP.AbstractSocketImpl)>>#fileOp:with:ifFail:
TCP.TCPSocketImpl(TCP.AbstractSocketImpl)>>#ensureWriteable
optimized [] in TCP.Socket>>#newWriteBuffer:
TCP.WriteBuffer>>#flush
TCP.Socket>>#flush
NetClients.CrLfStream>>#nextPut:
NetClients.CrLfStream(Stream)>>#nl
Hector.RepResultResponse(NetClients.WikiWorks.WebResponse)>>#nl
Hector.RepResultResponse(NetClients.WikiWorks.WebResponse)>>#sendResponseType
Hector.RepResultResponse(NetClients.WikiWorks.WebResponse)>>#sendHeader
Hector.RepResultResponse(NetClients.WikiWorks.WebResponse)>>#respondTo:
Hector.ReadEvalPrintServlet>>#respondTo:
[] in Hector.HectorServlet>>#respondTo:
True>>#ifTrue:
Hector.HectorServlet>>#respondTo:
NetClients.WikiWorks.CompositeServlet>>#respondTo:
NetClients.WikiWorks.WebServer>>#respondTo:
[] in NetClients.WikiWorks.WebSession(NetClients.NetSession)>>#run
Time class>>#millisecondsToRun:
[] in NetClients.WikiWorks.WebSession(NetClients.NetSession)>>#run
BlockClosure>>#on:do:
NetClients.WikiWorks.WebSession(NetClients.NetSession)>>#run
optimized [] in NetClients.NetThread>>#startNewProcess
[] in Process>>#onBlock:at:suspend:
BlockClosure>>#on:do:
[] in Process>>#onBlock:at:suspend:
BlockContext class>>#fromClosure:parent:
ProcessorScheduler>>#terminateActive
ContextPart class>>#unwind:
ContextPart class>>#unwind
UndefinedObject(Object)>>#primError:
MessageNotUnderstood(Exception)>>#defaultAction
optimized [] in Exception class>>#coreException
MessageNotUnderstood(Signal)>>#activateHandler:
CoreException>>#activateOuterHandlerFor:
MessageNotUnderstood(Signal)>>#pass
optimized [] in NetClients.NetSession>>#run
MessageNotUnderstood(Signal)>>#activateHandler:
MessageNotUnderstood(Exception)>>#signal
UndefinedObject(Object)>>#doesNotUnderstand:
DLD class>>#primDefineExternFunc:
DLD class>>#defineExternFunc:
CFunctionDescriptor class>>#addressOf:
CFunctionDescriptor>>#isValid
CFunctionDescriptor>>#callFrom:into:
TCP.TCPSocketImpl class(TCP.AbstractSocketImpl class)>>#soError
TCP.TCPSocketImpl(TCP.AbstractSocketImpl)>>#soError
optimized [] in TCP.AbstractSocketImpl>>#ensureWriteable
BlockClosure>>#ensure:
optimized [] in TCP.AbstractSocketImpl>>#ensureWriteable
TCP.TCPSocketImpl(TCP.AbstractSocketImpl)>>#fileOp:with:ifFail:
TCP.TCPSocketImpl(TCP.AbstractSocketImpl)>>#ensureWriteable
optimized [] in TCP.Socket>>#newWriteBuffer:
TCP.WriteBuffer>>#flush
TCP.Socket>>#flush
NetClients.CrLfStream>>#nextPut:
NetClients.CrLfStream(Stream)>>#nl
Hector.RepResultResponse(NetClients.WikiWorks.WebResponse)>>#nl
Hector.RepResultResponse(NetClients.WikiWorks.WebResponse)>>#sendResponseType
Hector.RepResultResponse(NetClients.WikiWorks.WebResponse)>>#sendHeader
Hector.RepResultResponse(NetClients.WikiWorks.WebResponse)>>#respondTo:
Hector.ReadEvalPrintServlet>>#respondTo:
[] in Hector.HectorServlet>>#respondTo:
True>>#ifTrue:
Hector.HectorServlet>>#respondTo:
NetClients.WikiWorks.CompositeServlet>>#respondTo:
NetClients.WikiWorks.WebServer>>#respondTo:
[] in NetClients.WikiWorks.WebSession(NetClients.NetSession)>>#run
Time class>>#millisecondsToRun:
[] in NetClients.WikiWorks.WebSession(NetClients.NetSession)>>#run
BlockClosure>>#on:do:
NetClients.WikiWorks.WebSession(NetClients.NetSession)>>#run
optimized [] in NetClients.NetThread>>#startNewProcess
[] in Process>>#onBlock:at:suspend:
BlockClosure>>#on:do:
[] in Process>>#onBlock:at:suspend:
BlockContext class>>#fromClosure:parent:
(ip 6)ProcessorScheduler>>#yield
(ip 12)[] in Delay class>>#initialize
(ip 16)[] in Process>>#onBlock:at:suspend:
(ip 10)BlockClosure>>#on:do:
(ip 14)[] in Process>>#onBlock:at:suspend:
(ip 14)BlockContext class>>#fromClosure:parent:

Processing package file: hector.xml
Hector Processing package file: hector.xml
Hector Processing package file: /home/mike/smalltalk/packages/packages.xml
MUtility ExternalResources NaiveXML PackageUtils PackageInstaller CLibraries XLib Imlib2 Cairo Applets DBI DBD-libmysqlclient DBD-libpq Loading package ExternalResources
Loading package Hector
Loading package NaiveXML
 2006-10-03T21:15:55+00:00 <=  2006-10-03T21:15:37+00:00 ?
7 GET OrderedCollection ('Hector' 'ReadEvalPrint' )
 2006-08-28T14:42:22+00:00 <=  2006-08-28T14:42:22+00:00 ?
4 GET OrderedCollection ('res' 'hector.css' )
 2006-06-10T18:40:04+00:00 <=  2006-06-10T18:40:04+00:00 ?
4 GET OrderedCollection ('res' 'sarissa' 'sarissa.js' )
 2006-08-31T00:38:54+00:00 <=  2006-08-31T00:38:54+00:00 ?
3 GET OrderedCollection ('res' 'hector.js' )
Object: nil error: did not understand #isPeerAlive
UndefinedObject(Object)>>#primError:
MessageNotUnderstood(Exception)>>#defaultAction
optimized [] in Exception class>>#coreException
MessageNotUnderstood(Signal)>>#activateHandler:
MessageNotUnderstood(Exception)>>#signal
UndefinedObject(Object)>>#doesNotUnderstand:
optimized [] in NetClients.NetSession>>#run
MessageNotUnderstood(Signal)>>#activateHandler:
MessageNotUnderstood(Exception)>>#signal
UndefinedObject(Object)>>#doesNotUnderstand:
NetClients.WikiWorks.WebRequest>>#stream:
NetClients.WikiWorks.WebRequest>>#initConnection:
NetClients.WikiWorks.WebRequest class>>#for:
NetClients.WikiWorks.WebSession>>#next
[] in NetClients.WikiWorks.WebSession(NetClients.NetSession)>>#run
BlockClosure>>#on:do:
NetClients.WikiWorks.WebSession(NetClients.NetSession)>>#run
optimized [] in NetClients.NetThread>>#startNewProcess
[] in Process>>#onBlock:at:suspend:
BlockClosure>>#on:do:
[] in Process>>#onBlock:at:suspend:
BlockContext class>>#fromClosure:parent:
ProcessorScheduler>>#terminateActive
ContextPart class>>#unwind:
ContextPart class>>#unwind
UndefinedObject(Object)>>#primError:
MessageNotUnderstood(Exception)>>#defaultAction
optimized [] in Exception class>>#coreException
MessageNotUnderstood(Signal)>>#activateHandler:
MessageNotUnderstood(Exception)>>#signal
UndefinedObject(Object)>>#doesNotUnderstand:
optimized [] in NetClients.NetSession>>#run
MessageNotUnderstood(Signal)>>#activateHandler:
MessageNotUnderstood(Exception)>>#signal
UndefinedObject(Object)>>#doesNotUnderstand:
NetClients.WikiWorks.WebRequest>>#stream:
NetClients.WikiWorks.WebRequest>>#initConnection:
NetClients.WikiWorks.WebRequest class>>#for:
NetClients.WikiWorks.WebSession>>#next
[] in NetClients.WikiWorks.WebSession(NetClients.NetSession)>>#run
BlockClosure>>#on:do:
NetClients.WikiWorks.WebSession(NetClients.NetSession)>>#run
optimized [] in NetClients.NetThread>>#startNewProcess
[] in Process>>#onBlock:at:suspend:
BlockClosure>>#on:do:
[] in Process>>#onBlock:at:suspend:
BlockContext class>>#fromClosure:parent:
 2006-10-03T21:16:00+00:00 <= nil ?
129 POST OrderedCollection ('Hector' 'ReadEvalPrint' )
(ip 6)ProcessorScheduler>>#yield
(ip 12)[] in Delay class>>#initialize
(ip 16)[] in Process>>#onBlock:at:suspend:
(ip 10)BlockClosure>>#on:do:
(ip 14)[] in Process>>#onBlock:at:suspend:
(ip 14)BlockContext class>>#fromClosure:parent:

Object: nil error: did not understand #isPeerAlive
UndefinedObject(Object)>>#primError:
MessageNotUnderstood(Exception)>>#defaultAction
optimized [] in Exception class>>#coreException
MessageNotUnderstood(Signal)>>#activateHandler:
MessageNotUnderstood(Exception)>>#signal
UndefinedObject(Object)>>#doesNotUnderstand:
optimized [] in NetClients.NetSession>>#run
MessageNotUnderstood(Signal)>>#activateHandler:
MessageNotUnderstood(Exception)>>#signal
UndefinedObject(Object)>>#doesNotUnderstand:
NetClients.WikiWorks.WebRequest>>#stream:
NetClients.WikiWorks.WebRequest>>#initConnection:
NetClients.WikiWorks.WebRequest class>>#for:
NetClients.WikiWorks.WebSession>>#next
[] in NetClients.WikiWorks.WebSession(NetClients.NetSession)>>#run
BlockClosure>>#on:do:
NetClients.WikiWorks.WebSession(NetClients.NetSession)>>#run
optimized [] in NetClients.NetThread>>#startNewProcess
[] in Process>>#onBlock:at:suspend:
BlockClosure>>#on:do:
[] in Process>>#onBlock:at:suspend:
BlockContext class>>#fromClosure:parent:
ProcessorScheduler>>#terminateActive
ContextPart class>>#unwind:
ContextPart class>>#unwind
UndefinedObject(Object)>>#primError:
MessageNotUnderstood(Exception)>>#defaultAction
optimized [] in Exception class>>#coreException
MessageNotUnderstood(Signal)>>#activateHandler:
MessageNotUnderstood(Exception)>>#signal
UndefinedObject(Object)>>#doesNotUnderstand:
optimized [] in NetClients.NetSession>>#run
MessageNotUnderstood(Signal)>>#activateHandler:
MessageNotUnderstood(Exception)>>#signal
UndefinedObject(Object)>>#doesNotUnderstand:
NetClients.WikiWorks.WebRequest>>#stream:
NetClients.WikiWorks.WebRequest>>#initConnection:
NetClients.WikiWorks.WebRequest class>>#for:
NetClients.WikiWorks.WebSession>>#next
[] in NetClients.WikiWorks.WebSession(NetClients.NetSession)>>#run
BlockClosure>>#on:do:
NetClients.WikiWorks.WebSession(NetClients.NetSession)>>#run
optimized [] in NetClients.NetThread>>#startNewProcess
[] in Process>>#onBlock:at:suspend:
BlockClosure>>#on:do:
[] in Process>>#onBlock:at:suspend:
BlockContext class>>#fromClosure:parent:
 2006-10-03T21:18:51+00:00 <= nil ?
-2938 POST OrderedCollection ('Hector' 'ReadEvalPrint' )
(ip 6)ProcessorScheduler>>#yield
(ip 12)[] in Delay class>>#initialize
(ip 16)[] in Process>>#onBlock:at:suspend:
(ip 10)BlockClosure>>#on:do:
(ip 14)[] in Process>>#onBlock:at:suspend:
(ip 14)BlockContext class>>#fromClosure:parent:

 2006-10-03T21:01:26+00:00 <= nil ?
Object: nil error: did not understand #do:
UndefinedObject(Object)>>#primError:
MessageNotUnderstood(Exception)>>#defaultAction
optimized [] in Exception class>>#coreException
MessageNotUnderstood(Signal)>>#activateHandler:
CoreException>>#activateOuterHandlerFor:
MessageNotUnderstood(Signal)>>#pass
optimized [] in NetClients.NetSession>>#run
MessageNotUnderstood(Signal)>>#activateHandler:
MessageNotUnderstood(Exception)>>#signal
UndefinedObject(Object)>>#doesNotUnderstand:
DLD class>>#primDefineExternFunc:
DLD class>>#defineExternFunc:
CFunctionDescriptor class>>#addressOf:
CFunctionDescriptor>>#isValid
CFunctionDescriptor>>#callFrom:into:
TCP.TCPSocketImpl class(TCP.AbstractSocketImpl class)>>#soError
TCP.TCPSocketImpl(TCP.AbstractSocketImpl)>>#soError
optimized [] in TCP.AbstractSocketImpl>>#ensureWriteable
BlockClosure>>#ensure:
optimized [] in TCP.AbstractSocketImpl>>#ensureWriteable
TCP.TCPSocketImpl(TCP.AbstractSocketImpl)>>#fileOp:with:ifFail:
TCP.TCPSocketImpl(TCP.AbstractSocketImpl)>>#ensureWriteable
optimized [] in TCP.Socket>>#newWriteBuffer:
TCP.WriteBuffer>>#flush
TCP.Socket>>#flush
NetClients.CrLfStream>>#nextPut:
NetClients.CrLfStream(Stream)>>#nl
Hector.RepResultResponse(NetClients.WikiWorks.WebResponse)>>#nl
Hector.RepResultResponse(NetClients.WikiWorks.WebResponse)>>#sendResponseType
Hector.RepResultResponse(NetClients.WikiWorks.WebResponse)>>#sendHeader
Hector.RepResultResponse(NetClients.WikiWorks.WebResponse)>>#respondTo:
Hector.ReadEvalPrintServlet>>#respondTo:
[] in Hector.HectorServlet>>#respondTo:
True>>#ifTrue:
Hector.HectorServlet>>#respondTo:
NetClients.WikiWorks.CompositeServlet>>#respondTo:
NetClients.WikiWorks.WebServer>>#respondTo:
[] in NetClients.WikiWorks.WebSession(NetClients.NetSession)>>#run
Time class>>#millisecondsToRun:
[] in NetClients.WikiWorks.WebSession(NetClients.NetSession)>>#run
BlockClosure>>#on:do:
NetClients.WikiWorks.WebSession(NetClients.NetSession)>>#run
optimized [] in NetClients.NetThread>>#startNewProcess
[] in Process>>#onBlock:at:suspend:
BlockClosure>>#on:do:
[] in Process>>#onBlock:at:suspend:
BlockContext class>>#fromClosure:parent:
ProcessorScheduler>>#terminateActive
ContextPart class>>#unwind:
ContextPart class>>#unwind
UndefinedObject(Object)>>#primError:
MessageNotUnderstood(Exception)>>#defaultAction
optimized [] in Exception class>>#coreException
MessageNotUnderstood(Signal)>>#activateHandler:
CoreException>>#activateOuterHandlerFor:
MessageNotUnderstood(Signal)>>#pass
optimized [] in NetClients.NetSession>>#run
MessageNotUnderstood(Signal)>>#activateHandler:
MessageNotUnderstood(Exception)>>#signal
UndefinedObject(Object)>>#doesNotUnderstand:
DLD class>>#primDefineExternFunc:
DLD class>>#defineExternFunc:
CFunctionDescriptor class>>#addressOf:
CFunctionDescriptor>>#isValid
CFunctionDescriptor>>#callFrom:into:
TCP.TCPSocketImpl class(TCP.AbstractSocketImpl class)>>#soError
TCP.TCPSocketImpl(TCP.AbstractSocketImpl)>>#soError
optimized [] in TCP.AbstractSocketImpl>>#ensureWriteable
BlockClosure>>#ensure:
optimized [] in TCP.AbstractSocketImpl>>#ensureWriteable
TCP.TCPSocketImpl(TCP.AbstractSocketImpl)>>#fileOp:with:ifFail:
TCP.TCPSocketImpl(TCP.AbstractSocketImpl)>>#ensureWriteable
optimized [] in TCP.Socket>>#newWriteBuffer:
TCP.WriteBuffer>>#flush
TCP.Socket>>#flush
NetClients.CrLfStream>>#nextPut:
NetClients.CrLfStream(Stream)>>#nl
Hector.RepResultResponse(NetClients.WikiWorks.WebResponse)>>#nl
Hector.RepResultResponse(NetClients.WikiWorks.WebResponse)>>#sendResponseType
Hector.RepResultResponse(NetClients.WikiWorks.WebResponse)>>#sendHeader
Hector.RepResultResponse(NetClients.WikiWorks.WebResponse)>>#respondTo:
Hector.ReadEvalPrintServlet>>#respondTo:
[] in Hector.HectorServlet>>#respondTo:
True>>#ifTrue:
Hector.HectorServlet>>#respondTo:
NetClients.WikiWorks.CompositeServlet>>#respondTo:
NetClients.WikiWorks.WebServer>>#respondTo:
[] in NetClients.WikiWorks.WebSession(NetClients.NetSession)>>#run
Time class>>#millisecondsToRun:
[] in NetClients.WikiWorks.WebSession(NetClients.NetSession)>>#run
BlockClosure>>#on:do:
NetClients.WikiWorks.WebSession(NetClients.NetSession)>>#run
optimized [] in NetClients.NetThread>>#startNewProcess
[] in Process>>#onBlock:at:suspend:
BlockClosure>>#on:do:
[] in Process>>#onBlock:at:suspend:
BlockContext class>>#fromClosure:parent:
run-hector.st:3: Interrupt
(ip 6)ProcessorScheduler>>#yield
(ip 12)[] in Delay class>>#initialize
(ip 16)[] in Process>>#onBlock:at:suspend:
(ip 10)BlockClosure>>#on:do:
(ip 14)[] in Process>>#onBlock:at:suspend:
(ip 14)BlockContext class>>#fromClosure:parent:

_______________________________________________
help-smalltalk mailing list
[hidden email]
http://lists.gnu.org/mailman/listinfo/help-smalltalk

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.

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

Paolo

--- orig/net/NetServer.st
+++ mod/net/NetServer.st
@@ -100,6 +100,10 @@ startNewProcess
 
     process resume!
 
+isPeerAlive
+    ^socket notNil and: [ socket isPeerAlive ]
+!
+
 socket
     ^socket
 ! !
@@ -240,13 +244,13 @@ run
  ]   on: ExAll
     do: [ :ex |
  "Ignore errors due to bad communication lines."
- self socket isPeerAlive ifFalse: [ ex return ].
+ self isPeerAlive ifFalse: [ ex return ].
  ex pass
     ].
 
  self log: req time: time.
 
- self socket isPeerAlive
+ self isPeerAlive
     ] whileTrue
 !
 

_______________________________________________
help-smalltalk mailing list
[hidden email]
http://lists.gnu.org/mailman/listinfo/help-smalltalk

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! !

_______________________________________________
help-smalltalk mailing list
[hidden email]
http://lists.gnu.org/mailman/listinfo/help-smalltalk

>> 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!
>  
Can you send it?
> 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)
>  
Nah, let's make it a TODO and I am happy :-)

Paolo



_______________________________________________
help-smalltalk mailing list
[hidden email]
http://lists.gnu.org/mailman/listinfo/help-smalltalk

> Nah, let's make it a TODO and I am happy :-)
The real FIXME was the comment on using #parseTimestamp: (a method which
is in fact unused and was *calling* for a wrapper).  So, here is my take
on your patch (only the WebServer.st hunks), which adds and uses a
#dateTimeAt:ifAbsent: method.

Thanks, it was cool to see again a WebServer up and running on Darwin.

Paolo

--- orig/net/httpd/WebServer.st
+++ mod/net/httpd/WebServer.st
@@ -148,7 +148,7 @@ HTTP request using the Basic authenticat
 version
     | number |
     Version isNil ifFalse: [ ^Version ].
-    number := Smalltalk version substrings
+    number := Smalltalk version subStrings
  detect: [ :each | (each at: 1) isDigit ]
  ifNone: [ '0.0' "???" ].
 
@@ -229,6 +229,12 @@ log: req time: time
     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'!
 
@@ -369,8 +375,9 @@ respondTo: aRequest
 
 notModified
     | ifModSince modTime |
-    ifModSince := request at: #'IF-MODIFIED-SINCE' ifAbsent: [ nil ].
-    ^ifModSince notNil and: [ self modifiedTime <= ifModSince ]!
+    ifModSince := request dateTimeAt: #'IF-MODIFIED-SINCE' ifAbsent: [ nil ].
+    modTime := self modifiedTime.
+    ^ifModSince notNil and: [ modTime <= ifModSince ]!
 
 request
     ^request!
@@ -589,6 +596,19 @@ at: aSymbol
 at: aSymbol ifAbsent: aBlock
     ^clientData at: aSymbol ifAbsent: aBlock!
 
+at: aSymbol ifPresent: aBlock
+    ^clientData at: aSymbol ifPresent: aBlock!
+
+dateTimeAt: aSymbol
+    ^self parseTimestamp: (clientData at: aSymbol)!
+
+dateTimeAt: aSymbol ifAbsent: aBlock
+    ^self parseTimestamp: (clientData at: aSymbol ifAbsent: [ ^aBlock value ])!
+
+dateTimeAt: aSymbol ifPresent: aBlock
+    ^clientData at: aSymbol ifPresent: [ :value |
+ aBlock value: (self parseTimestamp: value) ]!
+
 enumeratePostData: aBlock
     postData keysAndValuesDo: aBlock!
 
@@ -603,10 +623,21 @@ getRequest
     stream next. "Get nl"
 
     self extractClientData: version.
-    (action sameAs: 'POST') ifTrue: [ self extractPostData: version ].
-    
+
+    (action sameAs: 'POST') ifTrue: [
+ self
+    extractPostData: version
+    contentLength: (clientData at: #'CONTENT-LENGTH' ifAbsent: [ nil ])
+    ].
+
     "Get back to binary mode"
-    stream := saveStream!
+    stream := saveStream.!
+
+hasPostData
+    ^postData notEmpty!
+
+postDataAt: aSymbol ifPresent: aBlock
+    ^postData at: aSymbol ifPresent: aBlock!
 
 location
     ^location!
@@ -620,35 +651,6 @@ originator
 pageFollows
     WebResponse new respondTo: self!
 
-parseTimestamp: ts
-    | tok d m y time |
-    tok := ts substrings.
-    (tok at: 1) last = $, ifFalse: [ "asctime:  Sun Nov  6 08:49:37 1994"
-         ts size = 5 ifFalse: [ ^nil ].
-         m := (ts at: 2) asSymbol.
-         d := (ts at: 3) asInteger.
-         y := (ts at: 5) asInteger.
-         time := ts at: 4.
-         ^self makeTimestamp: d month: m year: y time: time
-    ].
-    (tok at: 1) size = 4 ifTrue: [ "RFC 822:  Sun, 06 Nov 1994 08:49:37 GMT"
-         ts size = 6 ifFalse: [ ^nil ].
-         d := (ts at: 2) asInteger.
-         m := (ts at: 3) asSymbol.
-         y := (ts at: 4) asInteger.
-         time := ts at: 5.
-         ^self makeTimestamp: d month: m year: y time: time
-    ].
-    "RFC 850 (obsolete):  Sunday, 06-Nov-94 08:49:37 GMT"
-    ts size = 4 ifFalse: [ ^nil ].
-    d := ts at: 2.
-    time := ts at: 3.
-    d size = 9 ifFalse: [ ^nil ].
-    y := (d at: 8) base10DigitValue * 10 + (d at: 9) base10DigitValue + 1900.
-    m := (d copyFrom: 4 to: 6) asSymbol.
-    d := (d at: 1) base10DigitValue * 10 + (d at: 2) base10DigitValue.
-    ^self makeTimestamp: d month: m year: y time: time!
-
 moreRequests
     ^(self at: #Connection) sameAs: 'keep-alive'
 !
@@ -694,20 +696,51 @@ release
 
 !WebRequest methodsFor: 'private'!
 
-at: aSymbol put: aValue
-    ^clientData at: aSymbol put: aValue!
+parseTimestamp: ts
+    | tok d m y time |
+    tok := ts subStrings.
+    (tok at: 1) last = $, ifFalse: [ "asctime:  Sun Nov  6 08:49:37 1994"
+         ts size = 5 ifFalse: [ ^nil ].
+         m := (ts at: 2) asSymbol.
+         d := (ts at: 3) asInteger.
+         y := (ts at: 5) asInteger.
+         time := ts at: 4.
+         ^self makeTimestamp: d month: m year: y time: time
+    ].
+    (tok at: 1) size = 4 ifTrue: [ "RFC 822:  Sun, 06 Nov 1994 08:49:37 GMT"
+         ts size = 6 ifFalse: [ ^nil ].
+         d := (ts at: 2) asInteger.
+         m := (ts at: 3) asSymbol.
+         y := (ts at: 4) asInteger.
+         time := ts at: 5.
+         ^self makeTimestamp: d month: m year: y time: time
+    ].
+    "RFC 850 (obsolete):  Sunday, 06-Nov-94 08:49:37 GMT"
+    ts size = 4 ifFalse: [ ^nil ].
+    d := ts at: 2.
+    time := ts at: 3.
+    d size = 9 ifFalse: [ ^nil ].
+    y := (d at: 8) base10DigitValue * 10 + (d at: 9) base10DigitValue + 1900.
+    m := (d copyFrom: 4 to: 6) asSymbol.
+    d := (d at: 1) base10DigitValue * 10 + (d at: 2) base10DigitValue.
+    ^self makeTimestamp: d month: m year: y time: time!
 
 makeTimestamp: d month: m year: y time: t
-    | month |
+    | month sec |
     t size = 8 ifFalse: [ ^nil ].
 
     month := #(#Jan #Feb #Mar #Apr #May #Jun #Jul #Aug #Sep #Oct #Nov #Dec)
  indexOf: m ifAbsent: [ ^nil ].
 
-    ^(((t at: 1) base10DigitValue * 10 + (t at: 2) base10DigitValue) * 3600)
-     + (((t at: 4) base10DigitValue * 10 + (t at: 5) base10DigitValue) * 60)
-     + (((t at: 7) base10DigitValue * 10 + (t at: 8) base10DigitValue))
-     + (Date newDay: d monthIndex: month year: y) asSeconds!
+    sec :=
+ (((t at: 1) base10DigitValue * 10 + (t at: 2) base10DigitValue) * 3600)
+      + (((t at: 4) base10DigitValue * 10 + (t at: 5) base10DigitValue) * 60)
+      + (((t at: 7) base10DigitValue * 10 + (t at: 8) base10DigitValue)).
+
+    ^(DateTime newDay: d monthIndex: month year: y) addSeconds: sec!
+
+at: aSymbol put: aValue
+    ^clientData at: aSymbol put: aValue!
 
 endOfLine
     ^EndOfLine!
@@ -734,28 +767,36 @@ extractClientData: clientVersion
 
 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 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 ].
+
+    "TODO: 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: $=.
+    (query subStrings: $&) do: [ :each || pair |
+ pair := each subStrings: $=.
  self
     postDataAt: (URL decode: pair first) asSymbol
-    put: (URL decode: pair last)
-    ]!
+    put: (URL decode: (pair at: 2 ifAbsent: [ '' ])) ]!
 
 postDataAt: aSymbol put: aValue
     ^postData at: aSymbol put: aValue! !

_______________________________________________
help-smalltalk mailing list
[hidden email]
http://lists.gnu.org/mailman/listinfo/help-smalltalk