Packages May 2023

packages@lists.squeakfoundation.org

1 participants
55 discussions

The Trunk: Network-ct.269.mcz
by commits＠source.squeak.org 19 May '23

19 May '23

Christoph Thiede uploaded a new version of Network to project The Trunk: http://source.squeak.org/trunk/Network-ct.269.mcz ==================== Summary ==================== Name: Network-ct.269 Author: ct Time: 19 May 2023, 1:50:14.181195 pm UUID: f57a07c4-63dc-7442-8bfe-57aeb8de3682 Ancestors: Network-ct.268 Adds support for ascdate/cdate format in MailMessage headers. While this is not covered by RFC822, some mboxes do contain this format, such as the older years of http://lists.squeakfoundation.org/pipermail/squeak-dev/. Also fixes offset of fallback time. =============== Diff against Network-ct.268 =============== Item was changed: ----- Method: MailMessage>>time (in category 'accessing') ----- time | dateField | dateField := (self fieldNamed: 'date' ifAbsent: [ ^0 ]) mainValue. + ^ [self timeFrom: dateField] ifError: [:err :rcvr | (Date today - (Date newDay: 1 year: 1980)) asSeconds].! - ^ [self timeFrom: dateField] ifError: [:err :rcvr | Date today asSeconds]. - ! Item was changed: ----- Method: MailMessage>>timeFrom: (in category 'parsing') ----- timeFrom: aString "Parse the date and time (rfc822) and answer the result as the number of seconds since the start of 1980." | s t rawDelta delta plusOrMinus | s := ReadStream on: aString. "date part" + t := ((self readDateFrom: s) ifNil: [Date today]). + + (aString size > 5 and: [(aString atLast: 5) = $ and: [aString last isDigit and: [(aString atLast: 2) isDigit] and: [(aString atLast: 3) isDigit] and: [(aString atLast: 4) isDigit]]]) ifTrue: [ + "ctime format - not covered by rfc822, but used in mboxes, such as the older years of http://lists.squeakfoundation.org/pipermail/squeak-dev/" + | year | + year := Integer readFrom: (aString last: 4) readStream. + year >= 1900 "not just a timezone without trailing +" ifTrue: + [t := t dayMonthYearDo: [:d :m :y | Date year: year month: m day: d]. + [s peekBack isDigit] whileTrue: [s skip: -1]. + s := (aString allButLast: 5) readStream position: s position; yourself]]. + + t := t asSeconds. + - t := ((self readDateFrom: s) ifNil: [Date today]) asSeconds. - [s atEnd or: [s peek isAlphaNumeric]] whileFalse: [s next]. "time part" s atEnd ifFalse: ["read time part (interpreted as local, regardless of sender's timezone)" (s peek isDigit) ifTrue: [t := t + (Time readFrom: s) asSeconds]. ]. s skipSeparators. "Check for a numeric time zone offset" ('+-' includes: s peek) ifTrue: [plusOrMinus := s next. rawDelta := (s peek isDigit) ifTrue: [Integer readFrom: s] ifFalse: [0]. delta := (rawDelta // 100 * 60 + (rawDelta \\ 100)) * 60. t := plusOrMinus = $+ ifTrue: [t - delta] ifFalse: [t + delta]]. "We ignore text time zone offsets like EST, GMT, etc..." ^ t - (Date newDay: 1 year: 1980) asSeconds "MailMessage new timeFrom: 'Thu, 22 Jun 2000 14:17:47 -500'" "MailMessage new timeFrom: 'Thu, 22 Jun 2000 14:17:47 --500'" "MailMessage new timeFrom: 'on, 04 apr 2001 14:57:32'"!

1 0

The Trunk: NetworkTests-ct.65.mcz
by commits＠source.squeak.org 19 May '23

19 May '23

Christoph Thiede uploaded a new version of NetworkTests to project The Trunk: http://source.squeak.org/trunk/NetworkTests-ct.65.mcz ==================== Summary ==================== Name: NetworkTests-ct.65 Author: ct Time: 19 May 2023, 1:41:20.836195 pm UUID: 36d608e2-8684-9a4a-90aa-fe7f209f3627 Ancestors: NetworkTests-mt.64 Complements Network-ct.268 (fixes parsing of multipart documents). =============== Diff against NetworkTests-mt.64 =============== Item was added: + ----- Method: MIMEDocumentTest>>testParseMultipart (in category 'tests') ----- + testParseMultipart + + | document | + document := MIMEDocument fromPartString: 'Content-Type: multipart/mixed; boundary="example_boundary" + + --example_boundary + Content-Type: text/plain + + first part + --example_boundary + Content-Type: text/plain + + second part + --example_boundary--'. + + self assert: document isMultipart. + self assert: #('text/plain' 'text/plain') equals: (document parts collect: #contentType) asArray. + self assert: #('first part + + ' 'second part + + ') equals: (document parts collect: #content) asArray.!

1 0

The Trunk: Network-ct.268.mcz
by commits＠source.squeak.org 19 May '23

19 May '23

Christoph Thiede uploaded a new version of Network to project The Trunk: http://source.squeak.org/trunk/Network-ct.268.mcz ==================== Summary ==================== Name: Network-ct.268 Author: ct Time: 19 May 2023, 1:40:42.341195 pm UUID: 63ac44a4-d515-6742-bc5e-00724d671c09 Ancestors: Network-tpr.267 Fixes parsing of multipart documents. As per RFC1341, the final separator can - or even should - be extended by two dashes. Note that we do not properly ignore preamble and epilogue for now, simply because of lack of need. =============== Diff against Network-tpr.267 =============== Item was changed: ----- Method: MIMEDocument class>>parseParts:withSeparator: (in category 'instance creation') ----- parseParts: bodyText withSeparator: separator "private -- parse the parts of the message and store them into a collection" | parseStream msgStream messages normalizedSeparator | parseStream := ReadStream on: bodyText. msgStream := LimitingLineStreamWrapper on: parseStream delimiter: separator. normalizedSeparator := separator asLowercase. msgStream limitingBlock: [:aLine | | normalizedLine | normalizedLine := aLine withoutTrailingBlanks asLowercase. normalizedLine = normalizedSeparator or: "Match the separator" + [normalizedLine = ('--',normalizedSeparator)] or: "or the separator after --" + [normalizedLine = (normalizedSeparator, '--')] or: "or the final separator before --" + [normalizedLine = ('--',normalizedSeparator, '--')]]. "or the final separator before and after --" - [normalizedLine = ('--',normalizedSeparator)] or: "or -- and the separator" - [normalizedLine = (normalizedSeparator, '--')]]. "or the final separator with --" "Throw away everything up to and including the first separator" msgStream upToEnd. msgStream skipThisLine. "Extract each of the multi-parts as strings" messages := OrderedCollection new. [parseStream atEnd] whileFalse: [messages add: msgStream upToEnd. msgStream skipThisLine]. ^ messages collect: [:e | MIMEDocument fromPartString: e]!

1 0

The Trunk: System-ct.1413.mcz
by commits＠source.squeak.org 17 May '23

17 May '23

Christoph Thiede uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-ct.1413.mcz ==================== Summary ==================== Name: System-ct.1413 Author: ct Time: 17 May 2023, 9:08:47.042764 pm UUID: 91cf1af6-3f19-9c4b-98e9-0c45f6736c83 Ancestors: System-eem.1412 Minor refactoring: Adds lazy accessors for text attribute constants on TextDiffBuilder and exposes them to other objects. =============== Diff against System-eem.1412 =============== Item was changed: ----- Method: TextDiffBuilder>>buildDisplayPatch (in category 'creating patches') ----- buildDisplayPatch | stream result | stream := AttributedTextStream new. - "Lazy initialize the text attributes cache." - NormalTextAttributes ifNil: [NormalTextAttributes := self userInterfaceTheme normalTextAttributes - ifNil: [{TextEmphasis normal}]]. - InsertTextAttributes ifNil: [InsertTextAttributes := self userInterfaceTheme insertTextAttributes - ifNil: [{TextColor red}]]. - RemoveTextAttributes ifNil: [RemoveTextAttributes := self userInterfaceTheme removeTextAttributes - ifNil: [{TextEmphasis struckOut. TextColor blue}]]. - self patchSequenceDoIfMatch: [ :string | + self print: string withAttributes: self normalTextAttributes on: stream ] - self print: string withAttributes: NormalTextAttributes on: stream ] ifInsert: [ :string | + self print: string withAttributes: self insertTextAttributes on: stream ] - self print: string withAttributes: InsertTextAttributes on: stream ] ifRemove: [ :string | + self print: string withAttributes: self removeTextAttributes on: stream ]. - self print: string withAttributes: RemoveTextAttributes on: stream ]. result := stream contents. (result notEmpty and: [result last = Character cr and: [(self lastIsCR: xLines) not and: [(self lastIsCR: yLines) not]]]) ifTrue: [result := result allButLast]. ^result! Item was added: + ----- Method: TextDiffBuilder>>insertTextAttributes (in category 'accessing') ----- + insertTextAttributes + + ^ InsertTextAttributes ifNil: [InsertTextAttributes := + self userInterfaceTheme insertTextAttributes + ifNil: [{TextColor red}]]! Item was added: + ----- Method: TextDiffBuilder>>normalTextAttributes (in category 'accessing') ----- + normalTextAttributes + + ^ NormalTextAttributes ifNil: [NormalTextAttributes := + self userInterfaceTheme normalTextAttributes + ifNil: [{TextEmphasis normal}]]! Item was added: + ----- Method: TextDiffBuilder>>removeTextAttributes (in category 'accessing') ----- + removeTextAttributes + + ^ RemoveTextAttributes ifNil: [RemoveTextAttributes := + self userInterfaceTheme removeTextAttributes + ifNil: [{TextEmphasis struckOut. TextColor blue}]]!

1 0

The Trunk: CommandLine-ct.23.mcz
by commits＠source.squeak.org 17 May '23

17 May '23

Christoph Thiede uploaded a new version of CommandLine to project The Trunk: http://source.squeak.org/trunk/CommandLine-ct.23.mcz ==================== Summary ==================== Name: CommandLine-ct.23 Author: ct Time: 17 May 2023, 8:58:20.218764 pm UUID: c5a67244-b81f-5e41-baae-cb17152bdaa8 Ancestors: CommandLine-mt.22 To DummyUIManager, adds missing selectors from super. (Note that #openPluggableFileList:label:in: is only available when 60Deprecated is loaded. We seem to want to deprecate that anyway, see https://lists.squeakfoundation.org/archives/list/squeak-dev@lists.squeakfou….) =============== Diff against CommandLine-mt.22 =============== Item was added: + ----- Method: DummyUIManager>>chooseFileMatching:label: (in category 'ui requests') ----- + chooseFileMatching: patterns label: labelString + self askForProvidedAnswerTo: labelString ifSupplied: [:answer | + ^ answer]. + + ^ nil! Item was added: + ----- Method: DummyUIManager>>chooseFileMatchingSuffixes:label: (in category 'ui requests') ----- + chooseFileMatchingSuffixes: suffixList label: labelString + self askForProvidedAnswerTo: labelString ifSupplied: [:answer | + ^ answer]. + + ^ nil! Item was added: + ----- Method: DummyUIManager>>chooseFont:for:setSelector:getSelector: (in category 'ui requests') ----- + chooseFont: titleString for: aModel setSelector: setSelector getSelector: getSelector + self askForProvidedAnswerTo: titleString ifSupplied: [:answer | + ^ answer]. + + ^ nil! Item was added: + ----- Method: DummyUIManager>>confirm:orCancel:title: (in category 'ui requests') ----- + confirm: aString orCancel: cancelBlock title: titleString + + ^ self confirm: aString orCancel: cancelBlock! Item was added: + ----- Method: DummyUIManager>>confirm:title: (in category 'ui requests') ----- + confirm: aString title: titleString + + ^ self confirm: aString! Item was added: + ----- Method: DummyUIManager>>confirm:title:trueChoice:falseChoice: (in category 'ui requests') ----- + confirm: queryString title: titleString trueChoice: trueChoice falseChoice: falseChoice + + ^ self confirm: queryString title: titleString! Item was added: + ----- Method: DummyUIManager>>confirm:trueChoice:falseChoice: (in category 'ui requests') ----- + confirm: queryString trueChoice: trueChoice falseChoice: falseChoice + + ^ self confirm: queryString! Item was added: + ----- Method: DummyUIManager>>multiLineRequest:centerAt:initialAnswer:answerHeight: (in category 'ui requests') ----- + multiLineRequest: queryString centerAt: aPoint initialAnswer: defaultAnswer answerHeight: answerHeight + + ^ self request: queryString initialAnswer: defaultAnswer!

1 0

The Trunk: Tools-ct.1205.mcz
by commits＠source.squeak.org 16 May '23

16 May '23

Christoph Thiede uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-ct.1205.mcz ==================== Summary ==================== Name: Tools-ct.1205 Author: ct Time: 16 May 2023, 3:08:40.675819 pm UUID: 395ea534-e351-d84f-a1a4-4adeea3bb135 Ancestors: Tools-mt.1204 Fixes inheritance button color in browsers when selecting the first message (regression from Tools-mt.1193). #inheritanceButtonColor depends on currentCompiledMethod which is updated in #contentsChanged. =============== Diff against Tools-mt.1204 =============== Item was changed: ----- Method: Browser>>selectClassNamed: (in category 'class list') ----- selectClassNamed: aSymbolOrString | className currentMessageCategoryName currentMessageName | currentMessageCategoryName := [self selectedMessageCategoryName] on: Error do: [:ex| ex return: nil]. currentMessageName := [self selectedMessageName] on: Error do: [:ex| ex return: nil]. selectedClassName := aSymbolOrString ifNotNil: [ aSymbolOrString asSymbol ]. self setClassOrganizer. self setClassDefinition. "Try to reselect the category and/or selector if the new class has them." selectedMessageCategoryName :=(self messageCategoryList includes: currentMessageCategoryName) ifTrue: [currentMessageCategoryName] ifFalse: [nil]. selectedMessageName := (self messageList includes: currentMessageName) ifTrue: [currentMessageName] ifFalse: [nil]. self hasMessageSelected ifTrue: [self editSelection: #editMessage] ifFalse: [self hasMessageCategorySelected ifTrue: [self editSelection: #newMessage] ifFalse: [self classCommentIndicated ifTrue: [self editSelection: #editComment] ifFalse: [self editSelection: (self hasClassSelected not ifTrue: [(metaClassIndicated or: [ self hasSystemCategorySelected not ]) ifTrue: [#none] ifFalse: [#newClass]] ifFalse: [#editClass])]]]. contents := nil. self selectedClass isNil ifFalse: [className := self selectedClass name. (RecentClasses includes: className) ifTrue: [RecentClasses remove: className]. RecentClasses addFirst: className. RecentClasses size > 16 ifTrue: [RecentClasses removeLast]]. self changed: #classSelectionChanged. self changed: #classCommentText. self changed: #classListIndex. "update my selection" self changed: #messageCategoryList. self changed: #messageList. self changed: #relabel. self changed: #selectedSystemCategoryName. + self contentsChanged; decorateButtons.! - self decorateButtons; contentsChanged! Item was changed: ----- Method: Browser>>selectMessageNamed: (in category 'message list') ----- selectMessageNamed: aSymbolOrString | name | name := aSymbolOrString ifNotNil: [ aSymbolOrString asSymbol ]. selectedMessageName := name. self editSelection: (name notNil ifTrue: [#editMessage] ifFalse: [self messageCategoryListIndex > 0 ifTrue: [#newMessage] ifFalse: [self hasClassSelected ifTrue: [#editClass] ifFalse: [#newClass]]]). contents := nil. self changed: #messageListIndex. "update my selection" + self contentsChanged; decorateButtons.! - self decorateButtons; contentsChanged.!

1 0

The Trunk: Tools-mt.1204.mcz
by commits＠source.squeak.org 16 May '23

16 May '23

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.1204.mcz ==================== Summary ==================== Name: Tools-mt.1204 Author: mt Time: 16 May 2023, 10:52:20.408174 am UUID: 2cd6d83a-7746-5942-b1e3-616b0ae9fc2d Ancestors: Tools-mt.1203 In TreeBrowser, fixes performance bug in #expandClassTree. Also expand all non-extension protocols automatically. =============== Diff against Tools-mt.1203 =============== Item was changed: ----- Method: TreeBrowser>>expandClassTree (in category 'class tree - support') ----- expandClassTree "Expand full class hierarchy for specific categories, top-level only for the '-- all --' category." self isShowingAllClasses ifTrue: [self changed: #expandNodeRequested with: {#classChildren:. ProtoObject}] ifFalse: [(self classTreeExpanded not and: [lastClassList size <= self class classTreeAutoExpandLimit]) + ifTrue: [self changed: #expandAllNodesRequested with: #classChildren:]]! - ifTrue: [self classRoots do: [:ea | self changed: #expandAllNodesRequested with: #classChildren:]]]! Item was added: + ----- Method: TreeBrowser>>expandMessageCategoryTree (in category 'message category tree - support') ----- + expandMessageCategoryTree + "Expand all non-extension groups. Typically, there are only a few groups so browsing should be possible without having to filter or manually expand non-extension groups." + + self messageCategoryRoots do: [:ea | + ea first ~= $- "not -- all --, -- core --, -- extensions --" + ifTrue: [self changed: #expandAllNodesRequested with: {#messageCategoryChildren:. ea}]]! Item was changed: ----- Method: TreeBrowser>>updateMessageCategoryTree: (in category 'updating') ----- updateMessageCategoryTree: newList lastMessageCategoryList := newList. + self changed: #messageCategoryRoots. + self expandMessageCategoryTree.! - self changed: #messageCategoryRoots.!

1 0

The Trunk: Tools-mt.1203.mcz
by commits＠source.squeak.org 16 May '23

16 May '23

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.1203.mcz ==================== Summary ==================== Name: Tools-mt.1203 Author: mt Time: 16 May 2023, 10:11:05.470174 am UUID: c4f5d92e-3df6-374e-8bd0-f52038816bb7 Ancestors: Tools-mt.1202 In TreeBrowser, tweak the behavior of class-tree auto-expansion and whether to show collapse/expand arrows or not. Compact hierarchies benefit from not showing the arrows for less clutter. Note that you can expand all children via SHIFT+RightArrow or SHIFT+RedClick. =============== Diff against Tools-mt.1202 =============== Item was added: + ----- Method: TreeBrowser class>>classTreeAutoExpandLimit (in category 'defaults') ----- + classTreeAutoExpandLimit + "Answer the maximum number of classes where the class tree should be expanded automatically." + + ^ 750! Item was added: + ----- Method: TreeBrowser class>>classTreeAutoExpandLockLimit (in category 'defaults') ----- + classTreeAutoExpandLockLimit + "Answer the maximum number of classes where the class tree should be expanded automatically and the user should not be able to collapse the tree but just use the type-in filter. This number should be smaller than #classTreeAutoExpandLimit." + + ^ 50! Item was changed: ----- Method: TreeBrowser>>classTreeExpanded (in category 'class tree') ----- classTreeExpanded "For reasons of usability and performance, we do not expand the entire class tree when potentially all classes in the system would be shown." + ^ (self isShowingAllClasses or: [lastClassList size > self class classTreeAutoExpandLockLimit]) not! - ^ self isShowingAllClasses not! Item was changed: ----- Method: TreeBrowser>>expandClassTree (in category 'class tree - support') ----- expandClassTree "Expand full class hierarchy for specific categories, top-level only for the '-- all --' category." self isShowingAllClasses + ifTrue: [self changed: #expandNodeRequested with: {#classChildren:. ProtoObject}] + ifFalse: [(self classTreeExpanded not and: [lastClassList size <= self class classTreeAutoExpandLimit]) + ifTrue: [self classRoots do: [:ea | self changed: #expandAllNodesRequested with: #classChildren:]]]! - " ifFalse: [self classRoots do: [:ea | self changed: #expandAllNodesRequested with: #classChildren:]]" - ifTrue: [self changed: #expandNodeRequested with: {#classChildren:. ProtoObject}].!

1 0

The Trunk: Tools-mt.1202.mcz
by commits＠source.squeak.org 15 May '23

15 May '23

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.1202.mcz ==================== Summary ==================== Name: Tools-mt.1202 Author: mt Time: 15 May 2023, 12:54:53.997855 pm UUID: 0343153d-f5dc-d947-94b0-d3ebed3da962 Ancestors: Tools-mt.1201 Some tweaks for the TreeBrowser: - generic icon for classes help retain the visible hierarchy without a blank gap, making it possible to mix classes that have special icons (e.g., collection or morph) with ones that have not - both '-- all --' and '-- core --' can now be switched off to get two more rows in message-category pane; no selection still means '-- all --' - now, no selection in system-category pane also means 'all classes' - fixes #findMethod when browsing the entire class tree via '-- all --' =============== Diff against Tools-mt.1201 =============== Item was changed: ----- Method: Browser>>findMethod (in category 'class functions') ----- findMethod "Pop up a list of the current class's methods, and select the one chosen by the user" | aClass selectors reply cat messageCatIndex messageIndex | + self hasClassSelected ifFalse: [^ self]. - self classListIndex = 0 ifTrue: [^ self]. self okToChange ifFalse: [^ self]. aClass := self selectedClassOrMetaClass. selectors := aClass selectors sorted. selectors isEmpty ifTrue: [self inform: aClass name, ' has no methods.'. ^ self]. reply := UIManager default chooseFrom: selectors values: selectors lines: #(1). reply ifNil: [^ self]. cat := aClass whichCategoryIncludesSelector: reply. messageCatIndex := self messageCategoryList indexOf: cat. self messageCategoryListIndex: messageCatIndex. messageIndex := (self messageList indexOf: reply). self messageListIndex: messageIndex! Item was added: + ----- Method: ToolIcons class>>genericClass (in category 'private') ----- + genericClass + "© 2023 Marcel Taeumel" + + ^ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: 'iVBORw0KGgoAAAANSUhEUgAAAAwAAAAMCAYAAABWdVznAAAFEGlUWHRYTUw6Y29tLmFkb2Jl + LnhtcAAAAAAAPD94cGFja2V0IGJlZ2luPSLvu78iIGlkPSJXNU0wTXBDZWhpSHpyZVN6TlRj + emtjOWQiPz4KPHg6eG1wbWV0YSB4bWxuczp4PSJhZG9iZTpuczptZXRhLyIgeDp4bXB0az0i + WE1QIENvcmUgNS41LjAiPgogPHJkZjpSREYgeG1sbnM6cmRmPSJodHRwOi8vd3d3LnczLm9y + Zy8xOTk5LzAyLzIyLXJkZi1zeW50YXgtbnMjIj4KICA8cmRmOkRlc2NyaXB0aW9uIHJkZjph + Ym91dD0iIgogICAgeG1sbnM6eG1wPSJodHRwOi8vbnMuYWRvYmUuY29tL3hhcC8xLjAvIgog + ICAgeG1sbnM6cGhvdG9zaG9wPSJodHRwOi8vbnMuYWRvYmUuY29tL3Bob3Rvc2hvcC8xLjAv + IgogICAgeG1sbnM6ZXhpZj0iaHR0cDovL25zLmFkb2JlLmNvbS9leGlmLzEuMC8iCiAgICB4 + bWxuczp0aWZmPSJodHRwOi8vbnMuYWRvYmUuY29tL3RpZmYvMS4wLyIKICAgIHhtbG5zOnht + cE1NPSJodHRwOi8vbnMuYWRvYmUuY29tL3hhcC8xLjAvbW0vIgogICAgeG1sbnM6c3RFdnQ9 + Imh0dHA6Ly9ucy5hZG9iZS5jb20veGFwLzEuMC9zVHlwZS9SZXNvdXJjZUV2ZW50IyIKICAg + eG1wOkNyZWF0ZURhdGU9IjIwMjMtMDUtMTVUMTE6Mzc6NTUrMDIwMCIKICAgeG1wOk1vZGlm + eURhdGU9IjIwMjMtMDUtMTVUMTI6NDU6MzMrMDI6MDAiCiAgIHhtcDpNZXRhZGF0YURhdGU9 + IjIwMjMtMDUtMTVUMTI6NDU6MzMrMDI6MDAiCiAgIHBob3Rvc2hvcDpEYXRlQ3JlYXRlZD0i + MjAyMy0wNS0xNVQxMTozNzo1NSswMjAwIgogICBwaG90b3Nob3A6Q29sb3JNb2RlPSIzIgog + ICBwaG90b3Nob3A6SUNDUHJvZmlsZT0ic1JHQiBJRUM2MTk2Ni0yLjEiCiAgIGV4aWY6UGl4 + ZWxYRGltZW5zaW9uPSIxMiIKICAgZXhpZjpQaXhlbFlEaW1lbnNpb249IjEyIgogICBleGlm + OkNvbG9yU3BhY2U9IjEiCiAgIHRpZmY6SW1hZ2VXaWR0aD0iMTIiCiAgIHRpZmY6SW1hZ2VM + ZW5ndGg9IjEyIgogICB0aWZmOlJlc29sdXRpb25Vbml0PSIyIgogICB0aWZmOlhSZXNvbHV0 + aW9uPSI3Mi8xIgogICB0aWZmOllSZXNvbHV0aW9uPSI3Mi8xIj4KICAgPHhtcE1NOkhpc3Rv + cnk+CiAgICA8cmRmOlNlcT4KICAgICA8cmRmOmxpCiAgICAgIHN0RXZ0OmFjdGlvbj0icHJv + ZHVjZWQiCiAgICAgIHN0RXZ0OnNvZnR3YXJlQWdlbnQ9IkFmZmluaXR5IFBob3RvIDIuMC4z + IgogICAgICBzdEV2dDp3aGVuPSIyMDIzLTA1LTE1VDEyOjQ1OjMzKzAyOjAwIi8+CiAgICA8 + L3JkZjpTZXE+CiAgIDwveG1wTU06SGlzdG9yeT4KICA8L3JkZjpEZXNjcmlwdGlvbj4KIDwv + cmRmOlJERj4KPC94OnhtcG1ldGE+Cjw/eHBhY2tldCBlbmQ9InIiPz7/kf7jAAABgGlDQ1Bz + UkdCIElFQzYxOTY2LTIuMQAAKJF1kbtLA0EQh79Eg28iaGFhEUStVHxA0MYiwReoRXKCryY5 + 7xIhj+PuggRbwVZQEG18FfoXaCtYC4KiCGKrtaKNhnPOCBExs8zOt7/dGXZnwauk1LRV2Qvp + jG1GxkKB2bn5QNUTPvzU0EZrTLWMqeioQll7v8Xjxutut1b5c/9a3ZJmqeCpFh5WDdMWHhee + XLENl7eEm9VkbEn4RLjLlAsK37h6vMjPLieK/OmyqUTC4G0UDiR+cfwXq0kzLSwvpz2dyqk/ + 93FfUq9lZqIS28RbsYgwRogAE4wQJkgfQzIH6aafHllRJr/3O3+arOSqMhvkMVkmQRKbLlFz + Ul2TqIuuyUiRd/v/t6+WPtBfrF4fAt+j47x2QNUmFDYc5+PAcQqHUPEA55lSfnYfBt9E3yhp + 7XvgX4PTi5IW34azdWi5N2Jm7FuqEPfqOrwcQ8McNF1B7UKxZz/7HN2BsipfdQk7u9Ap5/2L + X15rZ+IS+wnUAAAACXBIWXMAAAsTAAALEwEAmpwYAAAAd0lEQVQokZWR0Q3AIAhEoXGwm8Np + mcMBcAz7BQFKm/S+RN+FA5mKzjkn1szMsR4VXmsREZGq+l00cYUNjALgnbiDATgsIsnkkSw6 + AIc6XXbYe79CreFLca5RH0WkncGUttRlV1Wac+YtdSaLEeGHwUwpQvnp37oBWg9Q90fgLz4A + AAAASUVORK5CYII=' readStream)! Item was changed: Browser subclass: #TreeBrowser instanceVariableNames: 'parentCategories lastSystemCategoryList lastClassList lastMessageCategoryList isHierarchyMode classForHierarchy lastClassListIndentForHierarchy' + classVariableNames: 'ShowAllClassesInPackage ShowAllMethodsCategory ShowBlankClassIcons ShowCoreMethodsCategory ShowEmptyPackages' - classVariableNames: 'ShowAllClassesInPackage ShowBlankClassIcons ShowEmptyPackages' poolDictionaries: '' category: 'Tools-Browser'! !TreeBrowser commentStamp: 'mt 4/13/2023 14:31' prior: 0! Like a regular Smalltalk System Browser, I am a tool that helps explore and modify source code in the system. I am able to detect and show hierarchical structure in class (or system) categories, classes, and message categories (aka. protocols). The class hierarchy is formed by Smalltalk's single inheritance (i.e., #superclass and #subclasses). A hierarchy from any list of categories is derived by splitting dashes ("-") to reveal groups. Type-in filters are expected to work as in regular lists. Class (or system) categories, left-most pane: - Synthetic groups have (parentheses) and are empty - Groups that represent modified Monticello packages have an *asterisk - Groups that represent packages can list all classes in it, see class-side preference - Groups (or entries) that are just categories (i.e. no packages), are set in italic - Type-in filter searches complete hierarchy, including collapsed items Class tree, second-from-left pane: - Complete hierarchy expanded when selecting a different class category, except for "-- all --" category - Type-in filter only searches visible items, not complete hierarchy, for better performance in "-- all --" category - Blank icons disabled by default for better overview, see class-side preference Message categories (or protocols), third-from-left pane: - Synthetic groups have (parentheses) and are empty - All extensions grouped in "-- extensions --" category, which also aggregates all extension methods - Type-in filter searches complete hierarchy, including collapsed items Note that a useful metaphor for category-hierarchies is the file system with its hierarchy of directories. Directories can be empty. Selecting a parent directory does not list the files of all sub-directories. While single-child paths are condensed for clarity, they can still occur when intermediate items are valid categories with content. I also have built-in support for showing a class hierarchy around a specific class, just like the HierarchyBrowser does. I also have built-in support for traits, especially when in hierarchy-mode.! Item was added: + ----- Method: TreeBrowser class>>showAllMethodsCategory (in category 'preferences') ----- + showAllMethodsCategory + <preference: 'Show ''-- all --'' entry in message-category list in Tree Browser' + categoryList: #(Morphic Tools Browsing) + description: 'When true, an ''-- all --'' category can be selected to show selectors of all methods in the selected class. Note that having no selection will also show all methods in that class.' + type: #Boolean> + + ^ ShowAllMethodsCategory ifNil: [true]! Item was added: + ----- Method: TreeBrowser class>>showAllMethodsCategory: (in category 'preferences') ----- + showAllMethodsCategory: aBooleanOrNil + + ShowAllMethodsCategory == aBooleanOrNil ifTrue: [^ self]. + ShowAllMethodsCategory := aBooleanOrNil. + + self allInstancesDo: [:treeBrowser | treeBrowser updateMessageCategoryTree].! Item was changed: ----- Method: TreeBrowser class>>showBlankClassIcons (in category 'preferences') ----- showBlankClassIcons + <preference: 'Show generic class icons in Tree Browser' - <preference: 'Show blank class icons in Tree Browser' categoryList: #(Morphic Tools Browsing) + description: 'When true, classes with no distinct icon will get a generic icon. Note that #showClassIcons must be enabled for this to have an effect.' - description: 'When true, classes with no distinct icon will get a blank icon, which makes such labels wider and might obfuscate hierarchy indication. Note that #showClassIcons must be enabled for this to have an effect.' type: #Boolean> + ^ ShowBlankClassIcons ifNil: [true]! - ^ ShowBlankClassIcons ifNil: [false]! Item was added: + ----- Method: TreeBrowser class>>showCoreMethodsCategory (in category 'preferences') ----- + showCoreMethodsCategory + <preference: 'Show ''-- core --'' entry in message-category list in Tree Browser' + categoryList: #(Morphic Tools Browsing) + description: 'When true, a ''-- core --'' category can be selected to show selectors of all methods that are no extensions in the selected class.' + type: #Boolean> + + ^ ShowCoreMethodsCategory ifNil: [true]! Item was added: + ----- Method: TreeBrowser class>>showCoreMethodsCategory: (in category 'preferences') ----- + showCoreMethodsCategory: aBooleanOrNil + + ShowCoreMethodsCategory == aBooleanOrNil ifTrue: [^ self]. + ShowCoreMethodsCategory := aBooleanOrNil. + + self allInstancesDo: [:treeBrowser | treeBrowser updateMessageCategoryTree].! Item was changed: ----- Method: TreeBrowser>>classChildren: (in category 'class tree') ----- classChildren: aClass | all | + self isShowingAllClasses - self selectedSystemCategory = SystemOrganizer allCategory ifTrue: [^ aClass subclasses sortedSafely]. + self isShowingHierarchyOfClass - self selectedSystemCategory = self class hierarchyCategory ifTrue: [^ self classChildrenForHierarchy: aClass]. all := lastClassList. ^ all select: [:subclass | subclass superclass == aClass]! Item was changed: ----- Method: TreeBrowser>>classHasChildren: (in category 'class tree') ----- classHasChildren: aClass aClass == Class "... ProtoObject class ..." ifTrue: [^ false]. + self isShowingAllClasses - self selectedSystemCategory = SystemOrganizer allCategory ifTrue: [^ aClass subclasses notEmpty]. + self isShowingHierarchyOfClass - self selectedSystemCategory = self class hierarchyCategory ifTrue: [^ self classHasChildrenForHierarchy: aClass]. ^ lastClassList includesAnyOf: aClass subclasses! Item was changed: ----- Method: TreeBrowser>>classIcon: (in category 'class tree') ----- classIcon: aClass "Answer 'nil' instead of blank icon to keep the tree widget compact." | iconName | self class showClassIcons ifFalse: [^ nil]. ^ ((iconName := ToolIcons iconForClass: aClass name) ~~ #blank or: [ShowBlankClassIcons == true]) + ifTrue: [ToolIcons iconNamed: (iconName == #blank ifTrue: [#genericClass] ifFalse: [iconName])]! - ifTrue: [ToolIcons iconNamed: iconName]! Item was changed: ----- Method: TreeBrowser>>classLabel: (in category 'class tree') ----- classLabel: aClassOrTrait + self isShowingHierarchyOfClass - self selectedSystemCategory = self class hierarchyCategory ifTrue: [^ self classLabelForHierarchy: aClassOrTrait]. ^ aClassOrTrait isTrait ifTrue: [aClassOrTrait name asText addAttribute: TextEmphasis italic] ifFalse: [aClassOrTrait name]! Item was changed: ----- Method: TreeBrowser>>classPath (in category 'class tree') ----- classPath + self isShowingHierarchyOfClass - self selectedSystemCategory = self class hierarchyCategory ifTrue: [^ self classPathForHierarchy]. ^ self selectedClass ifNotNil: [:cls | | roots shouldAdd | roots := self classRoots asSet. shouldAdd := true. (Array streamContents: [:s | cls withAllSuperclassesDo: [:ea | shouldAdd ifTrue: [s nextPut: ea]. (roots includes: ea) ifTrue: [shouldAdd := false]]]) reversed]! Item was changed: ----- Method: TreeBrowser>>classRoots (in category 'class tree') ----- classRoots | all | + self isShowingAllClasses ifTrue: [^ {ProtoObject}]. + self isShowingHierarchyOfClass ifTrue: [^ self classRootsForHierarchy]. - self selectedSystemCategory = SystemOrganizer allCategory ifTrue: [^ {ProtoObject}]. - self selectedSystemCategory = self class hierarchyCategory ifTrue: [^ self classRootsForHierarchy]. all := lastClassList. ^ all select: [:class | all noneSatisfy: [:ea | class inheritsFrom: ea]]! Item was changed: ----- Method: TreeBrowser>>classTreeExpanded (in category 'class tree') ----- classTreeExpanded + "For reasons of usability and performance, we do not expand the entire class tree when potentially all classes in the system would be shown." + ^ self isShowingAllClasses not! - ^ self selectedSystemCategory ~= SystemOrganizer allCategory ! Item was changed: ----- Method: TreeBrowser>>expandClassTree (in category 'class tree - support') ----- expandClassTree "Expand full class hierarchy for specific categories, top-level only for the '-- all --' category." + self isShowingAllClasses - self selectedSystemCategory = SystemOrganizer allCategory " ifFalse: [self classRoots do: [:ea | self changed: #expandAllNodesRequested with: #classChildren:]]" ifTrue: [self changed: #expandNodeRequested with: {#classChildren:. ProtoObject}].! Item was added: + ----- Method: TreeBrowser>>isShowingAllClasses (in category 'class tree - support') ----- + isShowingAllClasses + + ^ self selectedSystemCategory = SystemOrganizer allCategory + or: [self selectedSystemCategory isNil]! Item was added: + ----- Method: TreeBrowser>>isShowingHierarchyOfClass (in category 'class tree - support') ----- + isShowingHierarchyOfClass + + ^ self selectedSystemCategory = self class hierarchyCategory! Item was changed: ----- Method: TreeBrowser>>messageCategoryRoots (in category 'message category tree') ----- messageCategoryRoots | hasExtensions hasAny roots | self hasClassSelected ifFalse: [^ Array new]. hasAny := self classOrMetaClassOrganizer isEmpty not. hasExtensions := self classOrMetaClassOrganizer categories anySatisfy: [:cat | cat first == $*]. roots := OrderedCollection new. + (hasAny and: [self class showAllMethodsCategory]) ifTrue: [ + roots add: ClassOrganizer allCategory]. - hasAny ifTrue: [roots add: ClassOrganizer allCategory]. hasExtensions ifTrue: [ + self class showCoreMethodsCategory ifTrue: [roots add: self class coreCategory]. - roots add: self class coreCategory. roots add: self class extensionCategory]. roots addAll: (self messageCategoryChildren: ''). ^ roots!

1 0

The Treated Inbox: WebClient-Core-ct.126.mcz
by commits＠source.squeak.org 12 May '23

12 May '23

Christoph Thiede uploaded a new version of WebClient-Core to project The Treated Inbox: http://source.squeak.org/treated/WebClient-Core-ct.126.mcz ==================== Summary ==================== Name: WebClient-Core-ct.126 Author: ct Time: 12 October 2020, 7:05:32.190311 pm UUID: a64ca560-814a-f940-8f64-e66a25cedc61 Ancestors: WebClient-Core-ul.123 Proposal to implement pre-authentication on WebClient. MOTIVATION. Until now, the authentication flow in Squeak's WebClient looks like this: First, a request is made without trying to authenticate the user. If the request fails with an error 401 (Unauthorized) or an error 407 (Proxy Authentication Required), the authentication headers are added to the request, and the request is retried. However, this does not work properly in some situations. For example, many modern REST APIs use to return an error 404 if an attempt is made to access a private resource without authenticating before [1] which currrently makes it impossible to authenticate to these APIs using the WebClient. Another issue I encountered today lies in some particular servers not requesting a specific authentication method via the WWW-Authenticate header along a 401 response as specified by the protocol [2]. Concretely, I encountered this problem with the quite popular GitHub API so I think our client should be robust enough to handle this contract violation. APPROACH. This patch adds a new property for the #preAuthenticationMethod to the WebClient class. It can be set to a symbol indicating any authentication method that is supported by the WebClient, e.g. #basic or #bearer. (Digest access authentication, however, cannot be used at this place because it depends on a realm specified by the server.) If this property is set, the relevant authentication headers will be added to the request already before the first attempt is made to request the resource. In addition, the patch refactors and reformatst the methods #authenticate:from: and #sendRequest:contentBlock:. The TESTS work as well as always (a number of them failing sporadically, but after some trials, I get a green bar again). WHAT REMAINS TO BE DONE. I deleted the fixme "Pre-authenticate the request if we have valid auth credentials" comment which I think was exactly what I implemented in this patch. I hope this assumption was correct? Also, another fixme comment requests to preserve the authState after following a redirect. Instead, with this patch, any specified pre-authentication method will be reused after every redirect. I did not fix this because I do not have a use-case scenario for it. Can we leave this as-is, and in a future version, could we simply delete this send to #flushAuthState? Also, I'm not sure about whether pre-authentication maybe should be the default for every request containing a username/password specification. This would speed up every web request that uses credentials by up to the factor 2 because we could save one futile query. Also, it appears to be the state-of-the-art solution, popular tools such as curl specify the credentials in the first run already. On the contrary, it would be a breaking change, and looking at the comment in #preAuthenticationMethod, pre-authentication as an opt-out feature might break or at least slow down NTLM/Negotiate use cases. However, I never heard of this before. Are these protocols still relevant at all? Please give this patch a careful review because still, all knowledge I have about this domain is collected from StackOverflow and Wikipedia a few hours ago. REFERENCES. [1] https://stackoverflow.com/a/17688080/13994294 [2] https://developer.mozilla.org/en-US/docs/Web/HTTP/Status/401 =============== Diff against WebClient-Core-ul.123 =============== Item was changed: Object subclass: #WebClient + instanceVariableNames: 'flags server scheme timeout stream cookies proxyServer lastScheme lastServer lastPort maxRedirect redirections userAgent authParams proxyParams accessLog debugLog preAuthenticationMethod' - instanceVariableNames: 'flags server scheme timeout stream cookies proxyServer lastScheme lastServer lastPort maxRedirect redirections userAgent authParams proxyParams accessLog debugLog' classVariableNames: 'DebugLog FlagAcceptCookies FlagAllowAuth FlagAllowRedirect ProxyHandler' poolDictionaries: '' category: 'WebClient-Core'! !WebClient commentStamp: 'ar 5/4/2010 13:17' prior: 0! WebClient provides a simple yet complete HTTP client implementation. To view the documentation evaluate: HelpBrowser openOn: WebClientHelp. ! Item was added: + ----- Method: WebClient>>authProcess:from:header:params: (in category 'authentication') ----- + authProcess: request from: response header: authHeader params: params + "Process an authentication header. + Answer true if an authentication response could be generated; otherwise, false." + + self + authDispatch: request + from: response + header: authHeader + params: params. + + params at: #authResponse ifAbsent: [^ false]. + + "If we generated an authentication response for the header use it" + request + headerAt: ((response ifNotNil: [response code = 401] ifNil: [true]) + ifTrue: ['Authorization'] + ifFalse: ['Proxy-Authorization']) + put: (params at: #authMethod), ' ', (params at: #authResponse). + + ^ true! Item was changed: ----- Method: WebClient>>authenticate:from: (in category 'sending') ----- authenticate: request from: response "Authenticate after having received a 401/407 response. Returns true if we should retry, false if we fail here." + | headers params | + - "NOTE: The first time through we do NOT ask for credentials right away. - Some authentication mechanisms (NTLM/Negotiate) can use the credentials - of the currently logged on user. Consequently we only ask for credentials - if we're unable to do so without asking. Methods that require credentials - (basic, digest) test for their existence explicitly." - - | headers authHeader params | - "Pick the right set of parameters" + response code = 401 + ifTrue: [ + params := authParams. + headers := response headersAt: 'WWW-Authenticate'. + "If the connection was closed, we need to flush the + proxy params or we won't pick up prior credentials." + self isConnected + ifFalse: [self flushAuthState: proxyParams]] + ifFalse: [ + params := proxyParams. + headers := response headersAt: 'Proxy-Authenticate']. + - response code = 401 ifTrue:[ - params := authParams. - headers := response headersAt: 'WWW-Authenticate'. - "If the connection was closed, we need to flush the - proxy params or we won't pick up prior credentials." - self isConnected - ifFalse:[self flushAuthState: proxyParams]. - ] ifFalse:[ - params := proxyParams. - headers := response headersAt: 'Proxy-Authenticate'. - ]. - "Remove any old response" + params removeKey: #authResponse ifAbsent: []. + - params removeKey: #authResponse ifAbsent:[]. - "Process the authentication header(s)" + headers + detect: [:authHeader | + self + authProcess: request + from: response + header: authHeader + params: params] + ifFound: [:authHeader | ^ true]. + + "If we fall through here this can have two reasons: One is that we don't have a suitable authentication method. Check for that first." + params at: #authMethod ifAbsent: [^ false]. + + "The other possibility is that the credentials are wrong. Clean out the previous auth state and go ask for credentials." - 1 to: headers size do:[:i| - authHeader := headers at: i. - self authDispatch: request from: response header: authHeader params: params. - "If we generated an authentication response for the header use it" - params at: #authResponse ifPresent:[:resp| - request headerAt: (response code = 401 - ifTrue:['Authorization'] - ifFalse:['Proxy-Authorization']) - put: (params at: #authMethod), ' ', resp. - ^true]. - ]. - - "If we fall through here this can have two reasons: One is that we don't have - a suitable authentication method. Check for that first." - params at: #authMethod ifAbsent:[^false]. - - "The other possibility is that the credentials are wrong. - Clean out the previous auth state and go ask for credentials." self flushAuthState: params. + - "Clean out old authentication headers" response code = 401 + ifTrue: [request removeHeader: 'Authorization']. - ifTrue:[request removeHeader: 'Authorization']. "Always clean out the proxy auth header since we don't support pre-authentication" request removeHeader: 'Proxy-Authorization'. + - "Signal WebAuthRequired" (WebAuthRequired client: self request: request response: response) + signal == true ifFalse: [^ false]. + - signal == true ifFalse:[^false]. - "And retry with the new credentials" + ^ self authenticate: request from: response! - ^self authenticate: request from: response! Item was added: + ----- Method: WebClient>>preAuthenticationMethod (in category 'accessing') ----- + preAuthenticationMethod + "The authentication method to be used for initial requests. Symbol, e.g. #basic or #bearer. If nil, no authentication will be used until the server requests an authentication. + + NOTE: Some authentication mechanisms (NTLM/Negotiate) can use the credentials of the currently logged on user. Consequently, by default we only ask for credentials if we're unable to do so without asking." + + ^ preAuthenticationMethod! Item was added: + ----- Method: WebClient>>preAuthenticationMethod: (in category 'accessing') ----- + preAuthenticationMethod: aSymbol + "The authentication method to be used for initial requests. See #preAuthenticationMethod." + + preAuthenticationMethod := aSymbol! Item was changed: ----- Method: WebClient>>sendRequest:contentBlock: (in category 'sending') ----- sendRequest: request contentBlock: contentBlock "Send an http request" | response repeatRedirect repeatAuth | - - "XXXX: Fixme. Pre-authenticate the request if we have valid auth credentials" - redirections := Dictionary new. ["The outer loop handles redirections" + repeatRedirect := false. + + "Always update the host header due to redirect" + request headerAt: 'Host' put: server. + + self preAuthenticationMethod ifNotNil: [:authMethod | + self + authProcess: request + from: nil + header: authMethod asString capitalized + params: authParams]. + - repeatRedirect := false. - - "Always update the host header due to redirect" - request headerAt: 'Host' put: server. - ["The inner loop handles authentication" + repeatAuth := false. + + "Connect can fail if SSL proxy CONNECT is involved" + self connect ifNotNil: [:resp| ^ resp]. + + "Write the request to the debugLog if present" + debugLog ifNotNil: [self writeRequest: request on: debugLog]. + + "Send the request itself" + self writeRequest: request on: stream. + contentBlock value: stream. + + response := request newResponse readFrom: stream. + response url: scheme, '://', server, request rawUrl. + + debugLog ifNotNil: [ + response writeOn: debugLog. + debugLog flush]. + response setCookiesDo: [:cookie| + self acceptCookie: cookie host: self serverUrlName path: request url]. + accessLog ifNotNil: [ + WebUtils logRequest: request response: response on: accessLog]. + "Handle authentication if needed" + (self allowAuth and: [response code = 401 or: [response code = 407]]) ifTrue: [ + "Eat up the content of the previous response" + response content. + repeatAuth := self authenticate: request from: response]. + + repeatAuth + ] whileTrue. - repeatAuth := false. - - "Connect can fail if SSL proxy CONNECT is involved" - self connect ifNotNil:[:resp| ^resp]. + "Flush previous authState. + XXXX: Fixme. authState must be preserved for pre-authentication of requests." + self flushAuthState. + + "Handle redirect if needed" + (self allowRedirect and: [response isRedirect]) ifTrue:[ - "Write the request to the debugLog if present" - debugLog ifNotNil:[self writeRequest: request on: debugLog]. - - "Send the request itself" - self writeRequest: request on: stream. - contentBlock value: stream. - - response := request newResponse readFrom: stream. - response url: (scheme, '://', server, request rawUrl). - - debugLog ifNotNil:[ - response writeOn: debugLog. - debugLog flush. - ]. - response setCookiesDo:[:cookie| - self acceptCookie: cookie host: self serverUrlName path: request url. - ]. - accessLog ifNotNil:[ - WebUtils logRequest: request response: response on: accessLog - ]. - "Handle authentication if needed" - (self allowAuth and:[response code = 401 or:[response code = 407]]) ifTrue:[ "Eat up the content of the previous response" response content. + repeatRedirect := self redirect: request from: response]. + repeatRedirect + ] whileTrue: [ - repeatAuth := self authenticate: request from: response. - ]. - - repeatAuth] whileTrue. - - "Flush previous authState. - XXXX: Fixme. authState must be preserved for pre-authentication of requests." - self flushAuthState. - - "Handle redirect if needed" - (self allowRedirect and:[response isRedirect]) ifTrue:[ - "Eat up the content of the previous response" - response content. - repeatRedirect := self redirect: request from: response. - ]. - repeatRedirect] whileTrue:[ "When redirecting, remove authentication headers" request removeHeader: 'Authorization'. request removeHeader: 'Proxy-Authorization'. ]. + - "If the response is not a success, eat up its content" + (response isSuccess or: [response isInformational]) ifFalse: [ + response content]. + + ^ response! - (response isSuccess or:[response isInformational]) ifFalse:[response content]. - - ^response!

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages May 2023