The Trunk: Monticello-ul.727.mcz

Levente Uzonyi uploaded a new version of Monticello to project The Trunk:
http://source.squeak.org/trunk/Monticello-ul.727.mcz

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

Name: Monticello-ul.727
Author: ul
Time: 17 September 2020, 1:54:51.056164 am
UUID: ad776836-42eb-4aa2-b788-f10dd9e07da2
Ancestors: Monticello-cmm.726

MCHttpRepository changes:
- before up- or downloading files, transform the urls using #rewriteUrl:forDownload:. The default rules (see #urlRewriteRules) switch from http to https for source.squeak.org and squeaksource.com, and switch to the the static smalltalkhub site for downloads. The url rewriting is Eliot's idea, but this implementation uses a list of rewrite rules instead of a dictionary-based mapping.
- use WebClient (and the shared webclient instance) for uploads too
- retry down/uploading with WebClient at most 3 times. This should work around the case where the underlying socket was closed but the state of the socket has not been updated in Squeak.
- use https in #creationTemplate

=============== Diff against Monticello-cmm.726 ===============

Item was changed:
  MCFileBasedRepository subclass: #MCHttpRepository
  instanceVariableNames: 'location user password readerCache indexed webClient'
+ classVariableNames: 'URLRewriteRules UseSharedWebClientInstance'
- classVariableNames: 'UseSharedWebClientInstance'
  poolDictionaries: ''
  category: 'Monticello-Repositories'!

Item was changed:
  ----- Method: MCHttpRepository class>>creationTemplate (in category 'ui-support') -----
  creationTemplate
+ ^self creationTemplateLocation: 'https://www.squeaksource.com/ProjectName'
- ^self creationTemplateLocation: 'http://www.squeaksource.com/ProjectName'
  user: 'squeak'
  password: 'squeak'
  !

Item was added:
+ ----- Method: MCHttpRepository class>>rewriteUrl:forDownload: (in category 'url rewrite') -----
+ rewriteUrl: aString forDownload: forDownload
+
+ | result |
+ result := aString.
+ self urlRewriteRules groupsDo: [ :regexString :replacement :downloadOnly |
+ (forDownload or: [ downloadOnly not ]) ifTrue: [
+ result := result copyWithRegex: regexString matchesReplacedWith: replacement ] ].
+ ^result
+
+ "
+ self assert:  'https://squeaksource.com/foo/bar?baz=1' = (self rewriteUrl: 'http://squeaksource.com/foo/bar?baz=1' forDownload: true).
+ self assert:  'https://squeaksource.com/foo/bar?baz=1' = (self rewriteUrl: 'https://squeaksource.com/foo/bar?baz=1' forDownload: true).
+ self assert:  'https://source.squeak.org/foo/bar?baz=1' = (self rewriteUrl: 'http://source.squeak.org/foo/bar?baz=1' forDownload: true).
+ self assert:  'https://source.squeak.org/foo/bar?baz=1' = (self rewriteUrl: 'https://source.squeak.org/foo/bar?baz=1' forDownload: true).
+ self assert:  'http://static.smalltalkhub.com/foo/bar?baz=1' = (self rewriteUrl: 'http://smalltalkhub.com/foo/bar?baz=1' forDownload: true).
+ self assert:  'http://smalltalkhub.com/foo/bar?baz=1' = (self rewriteUrl: 'http://smalltalkhub.com/foo/bar?baz=1' forDownload: false).
+ "!

Item was added:
+ ----- Method: MCHttpRepository class>>urlRewriteRules (in category 'url rewrite') -----
+ urlRewriteRules
+
+ ^URLRewriteRules ifNil: [
+ URLRewriteRules := #(
+ "Regex to be replaced" "static replacement string" "download only"
+ '^http\://source\.squeak\.org/' 'https://source.squeak.org/' false
+ '^http\://squeaksource\.com/' 'https://squeaksource.com/' false
+ '^http\://www.squeaksource\.com/' 'https://www.squeaksource.com/' false
+ '^http\://smalltalkhub.com/' 'http://static.smalltalkhub.com/' true
+ )  asOrderedCollection ]!

Item was changed:
  ----- Method: MCHttpRepository>>httpGet:arguments: (in category 'private') -----
  httpGet: url arguments: arguments
 
+ | urlString |
- | progress urlString client  response result |
- progress := [ :total :amount |
- HTTPProgress new
- total: total;
- amount: amount;
- signal: 'Downloading...' ].
  urlString := arguments
  ifNil: [ url ]
  ifNotNil: [
  | queryString |
  queryString := WebUtils encodeUrlEncodedForm: arguments.
  (url includes: $?)
  ifTrue: [ url, '&', queryString ]
  ifFalse: [ url, '?', queryString ] ].
+ urlString := self class rewriteUrl: urlString forDownload: true.
+ ^self webClientDo: [ :client |
+ client
+ username: self user;
+ password: self password;
+ httpGet: urlString do: [ :request |
+ request
+ headerAt: 'Authorization' put: 'Basic ', (self user, ':', self password) base64Encoded;
+ headerAt: 'Connection' put: 'Keep-Alive';
+ headerAt: 'Accept' put: '*/*' ] ]!
- self class useSharedWebClientInstance ifTrue: [
- "Acquire webClient by atomically storing it in the client variable and setting its value to nil."
- client := webClient.
- webClient := nil ].
- client
- ifNil: [ client := WebClient new ]
- ifNotNil: [
- "Attempt to avoid an error on windows by recreating the underlying stream."
- client isConnected ifFalse: [ client close ] ].
- response := client
- username: self user;
- password: self password;
- httpGet: urlString do: [ :request |
- request
- headerAt: 'Authorization' put: 'Basic ', (self user, ':', self password) base64Encoded;
- headerAt: 'Connection' put: 'Keep-Alive';
- headerAt: 'Accept' put: '*/*' ].
- result := (response code between: 200 and: 299)
- ifFalse: [
- response content. "Make sure content is read."
- nil ]
- ifTrue: [ (RWBinaryOrTextStream with: (response contentWithProgress: progress)) reset ].
- self class useSharedWebClientInstance
- ifTrue: [
- "Save the WebClient instance for reuse, but only if there is no client cached."
- webClient  
- ifNil: [ webClient := client ]
- ifNotNil: [ client close ] ]
- ifFalse: [ client close ].
- result ifNil: [ NetworkError signal: 'Could not access ', location ].
- ^result!

Item was added:
+ ----- Method: MCHttpRepository>>webClientDo: (in category 'private') -----
+ webClientDo: aBlock
+
+ | client attemptsLeft response result |
+ self class useSharedWebClientInstance ifTrue: [
+ "Acquire webClient by atomically storing it in the client variable and setting its value to nil."
+ client := webClient.
+ webClient := nil ].
+
+ client
+ ifNil: [ client := WebClient new ]
+ ifNotNil: [
+ "Attempt to avoid an error by recreating the underlying stream."
+ client isConnected ifFalse: [ client close ] ].
+
+ attemptsLeft := 3.
+ response := nil.
+ [ response isNil and: [ attemptsLeft > 0 ] ] whileTrue: [
+ response := [ aBlock value: client ]
+ on: NetworkError
+ do: [ :error |
+ attemptsLeft = 0 ifTrue: [ error pass ].
+ (3 - attemptsLeft) seconds asDelay wait.
+ attemptsLeft := attemptsLeft - 1.
+ nil "The response" ] ].
+
+ result := (response code between: 200 and: 299)
+ ifFalse: [
+ response content. "Make sure content is read."
+ nil ]
+ ifTrue: [
+ (RWBinaryOrTextStream with: (
+ response contentWithProgress:  [ :total :amount |
+ HTTPProgress new
+ total: total;
+ amount: amount;
+ signal ])) reset ].
+
+ self class useSharedWebClientInstance
+ ifTrue: [
+ "Save the WebClient instance for reuse, but only if there is no client cached."
+ webClient  
+ ifNil: [ webClient := client ]
+ ifNotNil: [ client close ] ]
+ ifFalse: [ client close ].
+
+ result ifNil: [ NetworkError signal: 'Could not access ', location ].
+ ^result!

Item was changed:
  ----- Method: MCHttpRepository>>writeStreamForFileNamed:replace:do: (in category 'private') -----
  writeStreamForFileNamed: aString replace: ignoreBoolean do: aBlock
+
+ | stream urlString |
- | stream response statusLine code |
  stream := RWBinaryOrTextStream on: String new.
  aBlock value: stream.
+ urlString := self urlForFileNamed: aString.
+ urlString := self class rewriteUrl: urlString forDownload: false.
+ ^self displayProgress: 'Uploading ', aString during: [
+ self webClientDo: [ :client |
+ client
+ username: self user;
+ password: self password;
+ httpPut: urlString
+ content: stream contents
+ type: nil
+ do: [ :request |
+ request
+ headerAt: 'Authorization' put: 'Basic ', (self user, ':', self password) base64Encoded;
+ headerAt: 'Connection' put: 'Keep-Alive';
+ headerAt: 'Accept' put: '*/*'  ] ] ]!
- self displayProgress: 'Uploading ', aString during:[
- response := HTTPSocket
- httpPut: stream contents
- to: (self urlForFileNamed: aString)
- user: self user
- passwd: self password.
- ].
- "More robust handling of HTTP responses. Instead of enumerating
- all possible return codes and http versions, do a quick parse"
- (response beginsWith: 'HTTP/') ifTrue:[
- "Looks like an HTTP header, not some error message"
- statusLine := response copyUpTo: Character cr.
- code := [(statusLine findTokens: ' ') second asInteger] on: Error do:[].
- ].
- (code isInteger and:[code between: 200 and: 299])
- ifFalse:[self error: response].!