Squeak 4.6: WebClient-HTTP-cmm.3.mcz

Chris Muller uploaded a new version of WebClient-HTTP to project Squeak 4.6:
http://source.squeak.org/squeak46/WebClient-HTTP-cmm.3.mcz

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

Name: WebClient-HTTP-cmm.3
Author: cmm
Time: 1 July 2015, 4:18:01.916 pm
UUID: 6f6573bd-7d5b-425f-9fcb-632b4a59b792
Ancestors: WebClient-HTTP-topa.2

Recategorize methods so they are no longer overrides.  WebClient is now part of Squeak.

=============== Diff against WebClient-HTTP-topa.2 ===============

Item was changed:
+ ----- Method: HTTPSocket class>>httpGet:args:user:passwd: (in category '*webclient-http') -----
- ----- Method: HTTPSocket class>>httpGet:args:user:passwd: (in category '*WebClient-HTTP-override') -----
  httpGet: url args: args user: user passwd: passwd
  "Upload the contents of the stream to a file on the server.
 
  WARNING: This method will send a basic auth header proactively.
  This is necessary to avoid breaking MC and SqueakSource since SS does not
  return a 401 when accessing a private (global no access) repository."
 
  | urlString xhdrs client resp progress |
 
  "Normalize the url"
  urlString := (Url absoluteFromText: url) asString.
 
  "Some raw extra headers which historically have been added"
  xhdrs := HTTPProxyCredentials,
  HTTPBlabEmail. "may be empty"
 
  client := WebClient new.
  client username: user; password: passwd.
  ^[resp := client httpGet: urlString do:[:req|
 
  "HACK: Proactively send a basic auth header.
  See comment above."
  req headerAt: 'Authorization' put: 'Basic ', (user, ':', passwd) base64Encoded.
 
  "Accept anything"
  req addHeader: 'Accept' value: '*/*'.
  "Add the additional headers"
  (WebUtils readHeadersFrom: xhdrs readStream)
  do:[:assoc| req addHeader: assoc key value: assoc value]].
 
  progress := [:total :amount|
  (HTTPProgress new) total: total; amount: amount; signal: 'Downloading...'
  ].
 
  "Simulate old HTTPSocket return behavior"
  (resp code between: 200 and: 299)
  ifTrue:[^(RWBinaryOrTextStream with: (resp contentWithProgress: progress)) reset]
  ifFalse:[resp asString, resp content].
  ] ensure:[client destroy].
  !

Item was changed:
+ ----- Method: HTTPSocket class>>httpGetDocument:args:accept:request: (in category '*webclient-http') -----
- ----- Method: HTTPSocket class>>httpGetDocument:args:accept:request: (in category '*WebClient-HTTP-override') -----
  httpGetDocument: url args: args accept: mimeType request: requestString
  "Return the exact contents of a web object. Asks for the given MIME type. If mimeType is nil, use 'text/html'. An extra requestString may be submitted and must end with crlf.  The parsed header is saved. Use a proxy server if one has been registered.  tk 7/23/97 17:12"
 
  "Note: To fetch raw data, you can use the MIME type 'application/octet-stream'."
 
  | client xhdrs resp urlString progress |
  "Normalize the url"
  urlString := (Url absoluteFromText: url) asString.
 
  args ifNotNil: [
  urlString := urlString, (self argString: args)
  ].
 
  "Some raw extra headers which historically have been added"
  xhdrs := HTTPProxyCredentials,
  HTTPBlabEmail, "may be empty"
  requestString. "extra user request. Authorization"
 
  client := WebClient new.
  ^[resp := client httpGet: urlString do:[:req|
  "Add ACCEPT header"
  mimeType ifNotNil:[req headerAt: 'Accept' put: mimeType].
 
  "Always accept plain text"
  req addHeader: 'Accept' value: 'text/html'.
 
  "Add the additional headers"
  (WebUtils readHeadersFrom: xhdrs readStream)
  do:[:assoc| req addHeader: assoc key value: assoc value]].
 
  progress := [:total :amount|
  (HTTPProgress new) total: total; amount: amount; signal: 'Downloading...'
  ].
 
  "Simulate old HTTPSocket return behavior"
  (resp code between: 200 and: 299)
  ifTrue:[MIMEDocument contentType: resp contentType
  content: (resp contentWithProgress: progress) url: url]
  ifFalse:[resp asString, resp content].
  ] ensure:[client destroy].
  !

Item was changed:
+ ----- Method: HTTPSocket class>>httpPost:args:user:passwd: (in category '*webclient-http') -----
- ----- Method: HTTPSocket class>>httpPost:args:user:passwd: (in category '*WebClient-HTTP-override') -----
  httpPost: url args: args user: user passwd: passwd
 
  "WARNING: This method will send a basic auth header proactively.
  This is necessary to avoid breaking MC and SqueakSource since SS does not
  return a 401 when accessing a private (global no access) repository."
 
  | argString xhdrs client resp urlString |
  "Normalize the url"
  urlString := (Url absoluteFromText: url) asString.
 
  args ifNotNil: [
  argString := self argString: args.
  argString first = $? ifTrue: [argString := argString allButFirst].
  ].
 
  "Some raw extra headers which historically have been added"
  xhdrs := HTTPProxyCredentials,
  HTTPBlabEmail. "may be empty"
 
  client := WebClient new.
  client username: (user ifEmpty:[nil]); password: (passwd ifEmpty:[nil]).
  ^[resp := client httpPost: urlString content: (argString ifNil:[''])
  type: 'application/x-www-form-urlencoded'  do:[:req|
  "HACK: Proactively send a basic auth header.
  See comment above."
  req headerAt: 'Authorization' put: 'Basic ', (user, ':', passwd) base64Encoded.
  "Accept anything"
  req addHeader: 'Accept' value: '*/*'.
  "Add the additional headers"
  (WebUtils readHeadersFrom: xhdrs readStream)
  do:[:assoc| req addHeader: assoc key value: assoc value]].
 
  "Simulate old HTTPSocket return behavior"
  (resp code between: 200 and: 299)
  ifTrue:[MIMEDocument
  contentType: resp contentType content: resp content url: url]
  ifFalse:[resp asString, resp content].
  ] ensure:[client destroy].
  !

Item was changed:
+ ----- Method: HTTPSocket class>>httpPost:content:type:accept:request: (in category '*webclient-http') -----
- ----- Method: HTTPSocket class>>httpPost:content:type:accept:request: (in category '*WebClient-HTTP-override') -----
  httpPost: url content: postData type: contentType accept: mimeType request: requestString
  "like httpGET, except it does a POST instead of a GET.  POST allows data to be uploaded"
 
  | urlString xhdrs client resp |
  "Normalize the url"
  urlString := (Url absoluteFromText: url) asString.
 
  "Some raw extra headers which historically have been added"
  xhdrs := HTTPProxyCredentials,
  HTTPBlabEmail, "may be empty"
  requestString. "extra user request. Authorization"
  client := WebClient new.
  ^[resp := client httpPost: urlString content: (postData ifNil:[''])
  type: contentType do:[:req|
  "Add ACCEPT header"
  mimeType ifNotNil:[req headerAt: 'Accept' put: mimeType].
 
  "Always accept plain text"
  req addHeader: 'Accept' value: 'text/html'.
 
  "Add the additional headers"
  (WebUtils readHeadersFrom: xhdrs readStream)
  do:[:assoc| req addHeader: assoc key value: assoc value]].
 
  "Simulate old HTTPSocket return behavior"
  (resp code between: 200 and: 299)
  ifTrue:[MIMEDocument
  contentType: resp contentType content: resp content url: url]
  ifFalse:[resp asString, resp content].
  ] ensure:[client destroy].
  !

Item was changed:
+ ----- Method: HTTPSocket class>>httpPostDocument:args:accept:request: (in category '*webclient-http') -----
- ----- Method: HTTPSocket class>>httpPostDocument:args:accept:request: (in category '*WebClient-HTTP-override') -----
  httpPostDocument: url  args: args accept: mimeType request: requestString
  "like httpGET, except it does a POST instead of a GET.  POST allows data to be uploaded"
 
  | argString  |
  args ifNotNil: [
  argString := self argString: args.
  argString first = $? ifTrue: [argString := argString allButFirst].
  ].
 
  ^self httpPost: url
  content: argString
  type: 'application/x-www-form-urlencoded'
  accept: mimeType
  request: requestString!

Item was changed:
+ ----- Method: HTTPSocket class>>httpPostMultipart:args:accept:request: (in category '*webclient-http') -----
- ----- Method: HTTPSocket class>>httpPostMultipart:args:accept:request: (in category '*WebClient-HTTP-override') -----
  httpPostMultipart: url args: argsDict accept: mimeType request: requestString
  " do multipart/form-data encoding rather than x-www-urlencoded "
 
  | mimeBorder argsStream |
  mimeBorder := '----squeak-georgia-tech-', Time millisecondClockValue printString, '-csl-cool-stuff-----'.
  "encode the arguments dictionary"
  argsStream := WriteStream on: String new.
  argsDict associationsDo: [:assoc |
  assoc value do: [ :value | | fieldValue |
  "print the boundary"
  argsStream nextPutAll: '--', mimeBorder; crlf.
  " check if it's a non-text field "
  argsStream nextPutAll: 'Content-disposition: multipart/form-data; name="', assoc key, '"'.
  (value isKindOf: MIMEDocument)
  ifFalse: [fieldValue := value]
  ifTrue: [
  argsStream
  nextPutAll: ' filename="'; nextPutAll: value url pathForFile; nextPut: $"; crlf;
  nextPutAll: 'Content-Type: '; nextPutAll: value contentType.
  fieldValue := (value content
  ifNil: [(FileStream fileNamed: value url pathForFile) contentsOfEntireFile]
  ifNotNil: [value content]) asString].
  " Transcript show: 'field=', key, '; value=', fieldValue; cr. "
  argsStream crlf; crlf; nextPutAll: fieldValue; crlf
  ]].
  argsStream nextPutAll: '--', mimeBorder, '--'.
 
  ^self httpPost: url
  content: argsStream contents
  type:  'multipart/form-data; boundary=', mimeBorder
  accept: mimeType
  request: requestString
  !

Item was changed:
+ ----- Method: HTTPSocket class>>httpPostToSuperSwiki:args:accept:request: (in category '*webclient-http') -----
- ----- Method: HTTPSocket class>>httpPostToSuperSwiki:args:accept:request: (in category '*WebClient-HTTP-override') -----
  httpPostToSuperSwiki: url args: argsDict accept: mimeType request: requestString
 
  | mimeBorder argString |
  mimeBorder := '---------SuperSwiki',Time millisecondClockValue printString,'-----'.
  argString := String streamContents: [ :strm |
  strm nextPutAll: mimeBorder; crlf.
  argsDict associationsDo: [:assoc |
  assoc value do: [ :value |
  strm
  nextPutAll: 'Content-disposition: form-data; name="', assoc key, '"'; crlf; crlf;
  nextPutAll: value; crlf; crlf;
  nextPutAll: mimeBorder; crlf.
  ]
  ].
  ].
 
  ^self httpPost: url
  content: argString
  type:  'multipart/form-data; boundary=', mimeBorder
  accept: mimeType
  request: requestString
  !

Item was changed:
+ ----- Method: HTTPSocket class>>httpPut:to:user:passwd: (in category '*webclient-http') -----
- ----- Method: HTTPSocket class>>httpPut:to:user:passwd: (in category '*WebClient-HTTP-override') -----
  httpPut: contents to: url user: user passwd: passwd
  "Upload the contents of the stream to a file on the server
 
  WARNING: This method will send a basic auth header proactively.
  This is necessary to avoid breaking MC and SqueakSource since SS does not
  return a 401 when accessing a private (global no access) repository."
 
  | urlString xhdrs client resp |
 
  "Normalize the url"
  urlString := (Url absoluteFromText: url) asString.
 
  "Some raw extra headers which historically have been added"
  xhdrs := HTTPProxyCredentials,
  HTTPBlabEmail. "may be empty"
 
  client := WebClient new.
  client username: (user ifEmpty:[nil]); password: (passwd ifEmpty:[nil]).
  ^[resp := client httpPut: urlString content: contents type: nil  do:[:req|
  "HACK: Proactively send a basic auth header.
  See comment above."
  req headerAt: 'Authorization' put: 'Basic ', (user, ':', passwd) base64Encoded.
  "Accept anything"
  req addHeader: 'Accept' value: '*/*'.
  "Add the additional headers"
  (WebUtils readHeadersFrom: xhdrs readStream)
  do:[:assoc| req addHeader: assoc key value: assoc value]].
 
  "Simulate old HTTPSocket return behavior"
  resp asString, resp content
  ] ensure:[client destroy].
  !