Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
abstract sockets and servers
  • Loading branch information
bonzini committed Oct 14, 2009
1 parent e86c7db commit eaaee4e
Showing 1 changed file with 138 additions and 53 deletions.
191 changes: 138 additions & 53 deletions packages/swazoo-httpd/HTTP.st
Expand Up @@ -257,23 +257,23 @@ Object subclass: HTTPConnection [



Object subclass: HTTPServer [
| ip port connections sites socket loop isMultiThreading |
Object subclass: AbstractHTTPServer [
| connections sites socket loop isMultiThreading |

<category: 'Swazoo-HTTP'>
<comment: nil>

HTTPServer class >> initialize [
AbstractHTTPServer class >> initialize [
<category: 'intialize-release'>
SpEnvironment addImageShutdownTask: [self shutDown] for: self
]

HTTPServer class >> new [
AbstractHTTPServer class >> new [
<category: 'instance creation'>
^super new initialize
]

HTTPServer class >> shutDown [
AbstractHTTPServer class >> shutDown [
"HTTPServer shutDown"

<category: 'intialize-release'>
Expand Down Expand Up @@ -326,6 +326,11 @@ Object subclass: HTTPServer [
^connections
]

createSocket [
<category: 'abstract-start/stop'>
self subclassResponsibility.
]

hasNoSites [
<category: 'sites'>
^self sites hasNoResources
Expand All @@ -347,23 +352,6 @@ Object subclass: HTTPServer [
self initSites
]

ip [
<category: 'private-initialize'>
^ip
]

ip: anIPString [
<category: 'private-initialize'>
ip := anIPString
]

ipCorrected [
"in case of '*' always return '0.0.0.0'"

<category: 'private-initialize'>
^self ip = '*' ifTrue: ['0.0.0.0'] ifFalse: [self ip]
]

isMultiThreading [
"^a Boolean
I return true if each inbound HTTP connection will be handled in its own thread. See the senders of this message to see where that is important. Note that the default mode is mult-threaded because this is how Swazoo has worked so far. This is tricky for the application programmer, though, as they must ensure that they work in a thread safe way (e.g. avoid the many threads updating the same object). For those deploying to GemStone, you wil find things much easier if you do *not* run multithreaded, but rather run many gems each with a single-threaded Swazoo instance (and your app logic) in each. Also in GemStone, run the main loop in the foreground, c.f. >>mainLoopInForeground"
Expand All @@ -388,16 +376,6 @@ Object subclass: HTTPServer [
loop := aProcess
]

port [
<category: 'private-initialize'>
^port
]

port: aNumber [
<category: 'private-initialize'>
port := aNumber
]

removeConnection: aConnection [
<category: 'private'>
self connections remove: aConnection ifAbsent: [nil]
Expand All @@ -410,12 +388,12 @@ Object subclass: HTTPServer [

requestReaderClass [
<category: 'factories'>
^HTTPReader
self subclassResponsibility
]

responsePrinterClass [
<category: 'factories'>
^HTTPPrinter
self subclassResponsibility
]

restart [
Expand Down Expand Up @@ -460,21 +438,11 @@ Object subclass: HTTPServer [
socket := aSocket
]

socketClass [
"^a Class
I use SwazooSocket to wrap the actual socket. SwazooSocket does some of the byte translation work for me."

<category: 'private'>
^SwazooSocket
]

start [
<category: 'start/stop'>
self loop isNil
ifTrue:
[self
socket: (self socketClass serverOnIP: self ipCorrected port: self port).
self socket listenFor: 50.
[self socket: self createSocket.
self loop: ([[self acceptConnection] repeat]
forkAt: Processor userBackgroundPriority)]
]
Expand All @@ -492,6 +460,68 @@ Object subclass: HTTPServer [
]



AbstractHTTPServer subclass: HTTPServer [

| ip port |

<category: 'Swazoo-HTTP'>
<comment: nil>

createSocket [
<category: 'private-initialize'>
^(self socketClass serverOnIP: self ipCorrected port: self port)
listenFor: 50;
yourself
]

ip [
<category: 'private-initialize'>
^ip
]

ip: anIPString [
<category: 'private-initialize'>
ip := anIPString
]

ipCorrected [
"in case of '*' always return '0.0.0.0'"

<category: 'private-initialize'>
^self ip = '*' ifTrue: ['0.0.0.0'] ifFalse: [self ip]
]

port [
<category: 'private-initialize'>
^port
]

port: aNumber [
<category: 'private-initialize'>
port := aNumber
]

requestReaderClass [
<category: 'factories'>
^HTTPReader
]

responsePrinterClass [
<category: 'factories'>
^HTTPPrinter
]

socketClass [
"^a Class
I use SwazooSocket to wrap the actual socket. SwazooSocket does some of the byte translation work for me."

<category: 'private'>
^SwazooSocket
]
]



Object subclass: HTTPString [

Expand Down Expand Up @@ -636,7 +666,69 @@ CompositeResource subclass: ServerRootComposite [



Object subclass: SwazooSocket [
Object subclass: AbstractSwazooSocket [
<category: 'Swazoo-HTTP'>
<comment: nil>

accept [
<category: 'server accessing'>
self subclassResponsibility
]

close [
<category: 'accessing'>
self subclassRespnsibility
]

isActive [
<category: 'testing'>
self subclassResponsibility
]

listenFor: anInteger [
<category: 'server accessing'>
self subclassResponsibility
]

localAddress [
<category: 'accessing'>
self subclassResponsibility
]

read: anInteger [
<category: 'accessing'>
self subclassResponsibility
]

readInto: aByteArray startingAt: start for: length [
<category: 'accessing'>
self subclassResponsibility
]

remoteAddress [
<category: 'accessing'>
self subclassResponsibility
]

stream [
<category: 'private'>
self subclassResponsibility
]

write: aByteArray [
<category: 'accessing'>
self subclassResponsibility
]

writeFrom: aByteArray startingAt: start for: length [
<category: 'accessing'>
self subclassResponsibility
]
]



AbstractSwazooSocket subclass: SwazooSocket [
| accessor |

<category: 'Swazoo-HTTP'>
Expand Down Expand Up @@ -710,13 +802,6 @@ Object subclass: SwazooSocket [
^self accessor read: anInteger
]

read: anInteger timeout: aNumberOfMilliseconds [
<category: 'accessing'>
^(self accessor waitForReadDataUpToMs: aNumberOfMilliseconds)
ifTrue: [self read: anInteger]
ifFalse: [ByteArray new]
]

readInto: aByteArray startingAt: start for: length [
<category: 'accessing'>
^self accessor
Expand Down

0 comments on commit eaaee4e

Please sign in to comment.