The Trunk: Monticello-ul.728.mcz

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

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

Name: Monticello-ul.728
Author: ul
Time: 20 September 2020, 9:32:46.305579 pm
UUID: 8e7d9744-9b5a-4868-b645-2f817295ad7b
Ancestors: Monticello-ul.727, Monticello-eem.727, Monticello-ct.727, Monticello-ul.726

Merged Monticello-ul.727, Monticello-ct.727, Monticello-ul.726.

=============== Diff against Monticello-eem.727 ===============

Item was added:
+ ----- Method: MCDirectoryRepository>>includesVersionNamed: (in category 'versions') -----
+ includesVersionNamed: aString
+
+ | comparable |
+ comparable := ((aString endsWith: '.mcz') and: [ aString size > 4 ])
+ ifTrue: [ aString allButLast: 4 ]
+ ifFalse: [ aString ].
+ allVersionNamesCache ifNil: [
+ "Instead of reading the contents of the entire directory in #allVersionNames, look up a single .mcz file.
+ This is just an optimization. If the file does not exist, the version may still be there as an mcd."
+ (directory fileExists: comparable, '.mcz') ifTrue: [ ^true ] ].
+ ^ self allVersionNames includes: comparable!

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].!

Item was changed:
  ----- Method: MCTool>>buildWith: (in category 'toolbuilder') -----
  buildWith: builder
  |  windowBuilder |
 
  windowBuilder := MCToolWindowBuilder builder: builder tool: self.
  self widgetSpecs do:
  [:spec | | send fractions offsets |
  send := spec first.
  fractions := (spec at: 2 ifAbsent: [#(0 0 1 1)]) copy.
  offsets := (spec at: 3 ifAbsent: [#(0 0 0 0)]) copy.
 
+ fractions withIndexDo: [:numberOrSymbol :index |
- fractions doWithIndex: [:numberOrSymbol :index |
  numberOrSymbol isSymbol
  ifTrue: [fractions at: index put: (self perform: numberOrSymbol)]].
+ offsets withIndexDo: [:numberOrSymbol :index |
- offsets doWithIndex: [:numberOrSymbol :index |
  numberOrSymbol isSymbol
  ifTrue: [offsets at: index put: (self perform: numberOrSymbol)]].
 
  windowBuilder frame: (LayoutFrame
  fractions: (fractions first @ fractions second corner: fractions third @ fractions fourth)
  offsets: (offsets first @ offsets second corner: offsets third @ offsets fourth)).
  windowBuilder perform: send first withArguments: send allButFirst].
 
  ^ windowBuilder build
  !

Item was changed:
  ----- Method: MCVersionName>>versionName (in category 'accessing') -----
  versionName
  "Answer my version name as a ByteString, without the file suffix or any ancestor-attributes."
  | end |
  self isEmpty ifTrue: [^ String empty].
  end := self indexOf: $( ifAbsent: [
+ | size |
+ size := self size.
+ (size > 4
+ and: [ (self at: size - 3) == $.
+ and: [ (self at: size - 2) == $m
+ and: [ (self at: size - 1) == $c ] ] ])
+ ifTrue: [size - 3]
+ ifFalse: [size + 1]].
- (self size > 4
- and: [ (self at: self size - 3) == $.
- and: [ (self at: self size - 2) == $m
- and: [ (self at: self size - 1) == $c ] ] ])
- ifTrue: [self size - 3]
- ifFalse: [self size + 1]].
  ^self first: end - 1!