Hi all,

Since applying this fix to my server image, it has stayed running and  
available for far longer (~17 days) than it ever had previously (2-6  
days).  I, for one, recommend inclusion in Trunk.

A more specific/holistic evaluation of the server image after this fix:

(Process allSubInstances select: [:ea | ea name includesSubstring:  
'WebServer']) size    " => 2 "

Process allSubInstances select: [:proc |
	proc suspendedContext
		ifNil: [ false ]
		ifNotNil: [:context |
			context closure
				ifNil: [ false ]
				ifNotNil: [:closure | | receiver |
					receiver := closure outerContext receiver.
					(receiver respondsTo: #outerContext)
						ifTrue: [ receiver outerContext receiver class == WebServer ]
						ifFalse: [ false ] ] ] ]      " size => 4"

WebServer allInstances first connections size   " => 3"

(Process allSubInstances select: [:p | p isTerminated]) size " => 10"

WASession allSubInstances size "=> 1"

And leftover Sockets seem healthier than they did before this fix:

(Socket allInstances collect: [:ea | ea statusString asSymbol])  
asBag   "=> a Dictionary(#connected->6 #destroyed->1  
#invalidSocketHandle->60 #otherEndClosedButNotThisEnd->6  
#waitingForConnection->2 )"

Maybe WebServer listener sub-processes are still not getting GCed  
until I click somewhere in the image, which is strange (?), but at  
least they're /able/ to go away now.  :)

Thanks,
a Tim


On Jun 23, 2020, at 6:44 AM, commits at source.squeak.org wrote:

> Levente Uzonyi uploaded a new version of WebClient-Core to project  
> The Inbox:
> http://source.squeak.org/inbox/WebClient-Core-ul.123.mcz
>
> ==================== Summary ====================
>
> Name: WebClient-Core-ul.123
> Author: ul
> Time: 23 June 2020, 2:18:02.417391 pm
> UUID: ddad9c69-fa09-4c2e-bb38-156425f9baa0
> Ancestors: WebClient-Core-tobe.121
>
> WebMessage >> #streamDirectlyFrom:to:size:progress:
> - avoid infinite loop when there are fewer bytes available than  
> specified
> - fix progress notifications
> - avoid unnecessary buffer copying
>
> WebMessage:
> - use #contentType: and #contentLength: methods to set the  
> corresponding headers to avoid string duplication
>
> =============== Diff against WebClient-Core-tobe.121 ===============
>
> Item was changed:
>  ----- Method: WebClient>>httpPost:content:type:do: (in category  
> 'methods') -----
>  httpPost: urlString content: postData type: contentType do: aBlock
>  	"POST the data to the given url"
>
>  	| request |
>  	self initializeFromUrl: urlString.
>  	request := self requestWithUrl: urlString.
>  	request method: 'POST'.
> + 	contentType ifNotNil:[request contentType: contentType].
> + 	request contentLength: postData size.
> - 	contentType ifNotNil:[request headerAt: 'Content-Type' put:  
> contentType].
> - 	request headerAt: 'Content-Length' put: postData size.
>  	userAgent ifNotNil:[request headerAt: 'User-Agent' put: userAgent].
>  	aBlock value: request.
>  	^self sendRequest: request content: postData readStream size:  
> postData size!
>
> Item was changed:
>  ----- Method: WebClient>>httpPostChunked:content:type:do: (in  
> category 'methods') -----
>  httpPostChunked: urlString content: chunkBlock type: contentType  
> do: aBlock
>  	"POST the data to the given url using chunked transfer-encoding.
>  	The chunkBlock takes a request and can be fed using #nextChunkPut:
>  	until all the data has been sent.
>
>  	Chunked encoding can be used for long-lasting connections to a  
> server,
>  	but care must be taken to ensure that the client isn't running  
> afoul of
>  	the server expecting to read the full response (i.e., you should  
> use this
>  	only if you have control over both ends).
>
>  	However, it is a great way to send output from commands that take  
> awhile
>  	and other time-consuming operations if authentication has been  
> handled."
>
>  	| request |
>  	self initializeFromUrl: urlString.
>  	request := self requestWithUrl: urlString.
>  	request method: 'POST'.
> + 	contentType ifNotNil:[request contentType: contentType].
> - 	contentType ifNotNil:[request headerAt: 'Content-Type' put:  
> contentType].
>  	request headerAt: 'Transfer-Encoding' put: 'chunked'.
>  	userAgent ifNotNil:[request headerAt: 'User-Agent' put: userAgent].
>  	aBlock value: request.
>  	"Send the chunked data"
>  	^self sendRequest: request contentBlock:[:aStream|
>  		"Set the stream in the request and pass it in the chunk block"
>  		request stream: aStream.
>  		chunkBlock value: request.
>  		"send termination chunk"
>  		aStream nextPutAll: '0'; crlf; crlf; flush.
>  	].
>  !
>
> Item was changed:
>  ----- Method: WebClient>>httpPut:content:type:do: (in category  
> 'methods') -----
>  httpPut: urlString content: postData type: contentType do: aBlock
>  	"PUT the data to the given url"
>
>  	| request |
>  	self initializeFromUrl: urlString.
>  	request := self requestWithUrl: urlString.
>  	request method: 'PUT'.
> + 	contentType ifNotNil:[request contentType: contentType].
> + 	request contentLength: postData size.
> - 	contentType ifNotNil:[request headerAt: 'Content-Type' put:  
> contentType].
> - 	request headerAt: 'Content-Length' put: postData size.
>  	userAgent ifNotNil:[request headerAt: 'User-Agent' put: userAgent].
>  	aBlock value: request.
>  	^self sendRequest: request content: postData readStream size:  
> postData size!
>
> Item was changed:
>  ----- Method: WebMessage>>streamDirectlyFrom:to:size:progress: (in  
> category 'streaming') -----
>  streamDirectlyFrom: srcStream to: dstStream size: sizeOrNil  
> progress: progressBlock
>  	"Stream the content of srcStream to dstStream.
> + 	If a size is given, try to stream that many elements. It's the  
> senders responsibility to verify that enough bytes were read. If no  
> size is given, stream all available data."
> - 	If a size is given, stream that many elements, otherwise stream  
> up to the end."
>
> + 	| buffer bufferSize totalBytesRead bytesInBuffer |
> - 	| buffer remaining size totalRead |
>  	sizeOrNil = 0 ifTrue:[^self].
> + 	bufferSize := 4096.
> + 	buffer := (srcStream isBinary ifTrue:[ByteArray] ifFalse: 
> [String]) new: bufferSize.
> + 	totalBytesRead := 0.
> + 	[
> + 		progressBlock ifNotNil:[ progressBlock value: sizeOrNil value:  
> totalBytesRead ].
> + 		srcStream atEnd or: [ sizeOrNil notNil and: [ totalBytesRead >=  
> sizeOrNil ]] ]
> + 			whileFalse: [
> + 				bytesInBuffer := srcStream
> + 					readInto: buffer
> + 					startingAt: 1
> + 					count: (sizeOrNil
> + 						ifNil: [ bufferSize ]
> + 						ifNotNil: [ sizeOrNil - totalBytesRead min: bufferSize ]).
> + 				dstStream next: bytesInBuffer putAll: buffer startingAt: 1.
> + 				totalBytesRead := totalBytesRead + bytesInBuffer  ].
> + 	dstStream flush!
> -
> - 	buffer := (srcStream isBinary ifTrue:[ByteArray] ifFalse: 
> [String]) new: 4096.
> - 	totalRead := 0.
> - 	size := sizeOrNil ifNil:[0].
> - 	[(sizeOrNil == nil and:[srcStream atEnd not]) or:[totalRead <  
> size]] whileTrue:[
> - 		progressBlock ifNotNil:[progressBlock value: sizeOrNil value:  
> totalRead].
> - 		remaining := sizeOrNil ifNil:[99999] ifNotNil:[sizeOrNil -  
> totalRead].
> - 		remaining > buffer size ifTrue:[remaining := buffer size].
> - 		buffer := srcStream next: remaining into: buffer startingAt: 1.
> - 		dstStream nextPutAll: (remaining < buffer size
> - 			ifTrue:[(buffer copyFrom: 1 to: remaining)]
> - 			ifFalse:[buffer]).
> - 		totalRead := totalRead + buffer size.
> - 	].
> - 	dstStream flush.
> - 	progressBlock ifNotNil:[progressBlock value: sizeOrNil value:  
> totalRead].!
>
> Item was changed:
>  ----- Method: WebRequest>>send200Response:contentType:do: (in  
> category 'responses') -----
>  send200Response: aString contentType: contentType do: aBlock
>  	"Send a 200 OK response"
>
>  	| resp |
>  	resp := self newResponse protocol: 'HTTP/1.1' code: 200.
> + 	resp contentType: contentType.
> - 	resp headerAt: 'Content-Type' put: contentType.
>  	aBlock value: resp.
>  	^self sendResponse: resp content: aString.!
>
> Item was changed:
>  ----- Method: WebRequest>>send404Response: (in category  
> 'responses') -----
>  send404Response: body
>  	"Send a 404 not found response"
>
>  	^self
>  		send404Response: (body convertToWithConverter: UTF8TextConverter  
> new)
> + 		do: [ :resp | resp contentType: 'text/html; charset=utf-8' ]!
> - 		do: [ :resp | resp headerAt: 'Content-Type' put: 'text/html;  
> charset=utf-8' ]!
>
> Item was changed:
>  ----- Method: WebRequest>>send404Response:do: (in category  
> 'responses') -----
>  send404Response: body do: aBlock
>  	"Send a 404 not found response"
>
>  	| resp |
>  	resp := self newResponse protocol: 'HTTP/1.1' code: 404.
> + 	resp contentType: 'text/html; charset=utf-8'.
> - 	resp headerAt: 'Content-Type' put: 'text/html; charset=utf-8'.
>  	aBlock value: resp.
>  	^self sendResponse: resp content: body.
>  !
>
> Item was changed:
>  ----- Method: WebRequest>>send405Response:content: (in category  
> 'responses') -----
>  send405Response: allowed content: body
>  	"Send a 405 method not allowed response"
>  	| resp |
>  	resp := self newResponse protocol: 'HTTP/1.1' code: 405.
> + 	resp contentType: 'text/html; charset=utf-8'.
> - 	resp headerAt: 'Content-Type' put: 'text/html; charset=utf-8'.
>  	resp headerAt: 'allow' put: (String streamContents:[:s|
>  		allowed do:[:m| s nextPutAll: m] separatedBy:[s nextPut: $,]
>  	]).
>  	^self sendResponse: resp content: body.!
>
> Item was changed:
>  ----- Method: WebRequest>>sendResponse:contentStream:size: (in  
> category 'sending') -----
>  sendResponse: resp contentStream: aStream size: streamSize
>  	"Sends a WebResponse, streaming its contents from aStream.
>  	If a size is provided, insert a Content-Length header, otherwise
>  	ensure that the connection is transient."
>
>  	streamSize
>  		ifNil:[self headerAt: 'Connection' put: 'close'] "mark transient"
> + 		ifNotNil:[resp contentLength: streamSize].
> - 		ifNotNil:[resp headerAt: 'Content-Length' put: streamSize].
>
>  	^self sendResponse: resp contentBlock:[:sockStream|
>  		resp streamFrom: aStream to: sockStream size: streamSize  
> progress: nil
>  	]!
>
> Item was changed:
>  ----- Method: WebRequest>>sendResponseCode:content:type:do: (in  
> category 'responses') -----
>  sendResponseCode: code content: aString type: contentType do: aBlock
>  	"Send a 500 Internal server error response"
>
>  	| resp |
>  	resp := self newResponse protocol: 'HTTP/1.1' code: code.
> + 	contentType ifNotNil:[resp contentType: contentType].
> - 	contentType ifNotNil:[resp headerAt: 'Content-Type' put:  
> contentType].
>  	aBlock value: resp.
>  	^self sendResponse: resp content: aString.!
>
> Item was changed:
>  ----- Method: WebRequest>>stream200Response:size:type:do: (in  
> category 'responses') -----
>  stream200Response: aStream size: streamSize type: contentType do:  
> aBlock
>  	"Stream a 200 OK response"
>
>  	| resp |
>  	resp := self newResponse protocol: 'HTTP/1.1' code: 200.
> + 	resp contentType: contentType.
> - 	resp headerAt: 'Content-Type' put: contentType.
>  	aBlock value: resp.
>  	^self sendResponse: resp contentStream: aStream size: streamSize.!
>
> Item was changed:
>  ----- Method: WebServer class>>browseFile:request: (in category  
> 'examples') -----
>  browseFile: file request: request
>  	"Responds with a file back to the original request"
>
>  	| fileSize mimeTypes resp |
>  	file binary.
>  	fileSize := file size.
>  	mimeTypes := file mimeTypes ifNil:[#('application/octet-stream')].
>  	resp := request newResponse protocol: 'HTTP/1.1' code: 200.
> + 	resp contentType: mimeTypes first.
> - 	resp headerAt: 'Content-Type' put: mimeTypes first.
>  	request sendResponse: resp contentStream: file size: fileSize.!
>
> Item was changed:
>  ----- Method: WebServer>>authenticate:realm:methods:do: (in  
> category 'authentication') -----
>  authenticate: request realm: realm methods: accepted do: aBlock
>  	"Authenticates an incoming request using one of the accepted  
> methods.
>
>  	Evaluates aBlock upon successful authentication. Responds with a 401
>  	(Unauthorized) if the authentication fails."
>
>  	| method resp |
>  	request headersAt: 'Authorization' do:[:authHeader|
>  		method := authHeader copyUpTo: Character space.
>  		(accepted anySatisfy:[:auth| auth sameAs: method]) ifTrue:[
>  			(self authAccept: method request: request realm: realm header:  
> authHeader)
>  				ifTrue:[^aBlock value].
>  		].
>  	].
>
>  	"Send a 401 (unauthorized) response"
>  	resp := request newResponse protocol: 'HTTP/1.1' code: 401.
> + 	resp contentType: 'text/html; charset=utf-8'.
> - 	resp headerAt: 'Content-Type' put: 'text/html; charset=utf-8'.
>  	accepted do:[:auth| | hdr |
>  		hdr := self authHeader: auth request: request realm: realm.
>  		hdr ifNotNil:[resp addHeader: 'WWW-Authenticate' value: hdr].
>  	].
>  	request sendResponse: resp content: '<html><head><title>401  
> Unauthorized</title></head><body><h1>401 Unauthorized</h1><p>You are  
> not authorized to access the requested URL</p></body></html>'.
>  !
>
>
>