The Inbox: WebClient-Core-ul.122.mcz

Levente Uzonyi uploaded a new version of WebClient-Core to project The Inbox:
http://source.squeak.org/inbox/WebClient-Core-ul.122.mcz

==================== Summary ====================

Name: WebClient-Core-ul.122
Author: ul
Time: 21 June 2020, 10:38:13.218064 pm
UUID: bdff4473-51a4-4b1a-9836-70fba261bcaa
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>'.
  !