[squeak-dev] The Trunk: UpdateStream-tpr.19.mczcommits at source.squeak.org commits at source.squeak.orgTue Apr 19 19:00:39 UTC 2022
tim Rowledge uploaded a new version of UpdateStream to project The Trunk: http://source.squeak.org/trunk/UpdateStream-tpr.19.mcz ==================== Summary ==================== Name: UpdateStream-tpr.19 Author: tpr Time: 19 April 2022, 12:00:38.42091 pm UUID: d0403132-e967-480d-bda3-7cd20b9d2a5f Ancestors: UpdateStream-ct.18 Use the new ToolBuilder ability to show a list of options - typically a small number, maybe with a cancel button etc - as opposed to an arbitrary list of values. This separates it out from the chooseFrom:... protocol. Also update "UIManager default" with "Project uiManager" =============== Diff against UpdateStream-ct.18 =============== Item was changed: ----- Method: ServerDirectory>>checkServersWithPrefix:andParseListInto: (in category '*UpdateStream-updating') ----- checkServersWithPrefix: prefix andParseListInto: listBlock "Check that all servers are up and have the latest Updates.list. Warn user when can't write to a server that can still be read. The contents of updates.list is parsed into {{vers. {fileNames*}}*}, and returned via the listBlock." | serverList updateLists listContents maxSize outOfDateServers | serverList := self serversInGroup. + serverList ifEmpty: [^Array new]. - serverList isEmpty - ifTrue: [^Array new]. updateLists := Dictionary new. + serverList do: + [:updateServer | - serverList do: [:updateServer | [listContents := updateServer getFileNamed: prefix , 'updates.list'. updateLists at: updateServer put: listContents] on: Error do: [:ex | + Project uiManager + chooseOptionFrom: #('Cancel entire update') - UIManager default chooseFrom: #('Cancel entire update') title: 'Server ', updateServer moniker, ' is unavailable.\Please consider phoning the administator.\' withCRs, listContents. ^Array new]]. maxSize := (updateLists collect: [:each | each size]) max. + outOfDateServers := updateLists keys select: + [:updateServer | - outOfDateServers := updateLists keys select: [:updateServer | (updateLists at: updateServer) size < maxSize]. + outOfDateServers do: + [:updateServer | - outOfDateServers do: [:updateServer | (self outOfDate: updateServer) ifTrue: [^Array new]]. listBlock value: (UpdateStreamDownloader default parseListContents: listContents). serverList removeAll: outOfDateServers. ^serverList ! Item was changed: ----- Method: ServerDirectory>>exportUpdatesExcept: (in category '*UpdateStream-updating') ----- exportUpdatesExcept: skipList "Into the section of updates.list corresponding to this version, copy all the fileNames in the named updates.list for this group that are more recently numbered." " (ServerDirectory serverInGroupNamed: 'Disney Internal Updates*') exportUpdatesExcept: #(3959). " | myServers updateStrm response indexPrefix version versIndex lastNum expContents expVersIndex additions listContents | self openGroup. indexPrefix := (self groupName includes: $*) ifTrue: [(self groupName findTokens: ' ') first] "special for internal updates" ifFalse: ['']. "normal" + myServers := self + checkServersWithPrefix: indexPrefix + andParseListInto: + [:x | listContents := x]. - myServers := self checkServersWithPrefix: indexPrefix - andParseListInto: [:x | listContents := x]. myServers size = 0 ifTrue: [self closeGroup. ^ self]. version := SystemVersion current version. versIndex := (listContents collect: [:pair | pair first]) indexOf: version. versIndex = 0 ifTrue: [self inform: 'There is no section in updates.list for your version'. self closeGroup. ^ nil]. "abort" versIndex < listContents size ifTrue: + [response := Project uiManager + chooseOptionFrom: #('Make update from an older version' 'Cancel update') + title: 'This system, ', SystemVersion current version, + ' is not the latest version'. - [response := UIManager default - chooseFrom: #('Make update from an older version' 'Cancel update') - title: 'This system, ', SystemVersion current version, - ' is not the latest version'. response = 1 ifFalse: [self closeGroup. ^ nil]]. "abort" "Get the old export updates.list." expContents := UpdateStreamDownloader default parseListContents: (myServers first getFileNamed: 'updates.list'). expVersIndex := (expContents collect: [:pair | pair first]) indexOf: version. expVersIndex = 0 ifTrue: [self inform: 'There is no section in updates.list for your version'. self closeGroup. ^ nil]. "abort" lastNum := (expContents at: expVersIndex) last isEmpty ifTrue: [0] "no checking if the current list is empty" ifFalse: [(expContents at: expVersIndex) last last initialIntegerOrNil]. "Save old copy of updates.list on local disk" FileDirectory default deleteFileNamed: 'updates.list.bk'. UpdateStreamDownloader default writeList: expContents toStream: (FileStream fileNamed: 'updates.list.bk'). "Append all fileNames in my list that are not in the export list" additions := OrderedCollection new. (listContents at: versIndex) last do: + [:fileName | | seq | + seq := fileName initialIntegerOrNil. - [:fileName | | seq | seq := fileName initialIntegerOrNil. (seq > lastNum and: [(skipList includes: seq) not]) ifTrue: [additions addLast: fileName]]. expContents at: expVersIndex put: {version. (expContents at: expVersIndex) last , additions}. + (self confirm: 'Do you really want to export ' , additions size printString , ' recent updates?') ifFalse: + [self closeGroup. ^ nil]. "abort" - (self confirm: 'Do you really want to export ' , additions size printString , ' recent updates?') - ifFalse: [self closeGroup. ^ nil]. "abort" "Write a new copy of updates.list on all servers..." updateStrm := ReadStream on: + (String streamContents: + [:s | UpdateStreamDownloader default writeList: expContents toStream: s]). - (String streamContents: [:s | UpdateStreamDownloader default writeList: expContents toStream: s]). myServers do: [:aServer | updateStrm reset. aServer putFile: updateStrm named: 'updates.list' retry: true. Transcript show: 'Update succeeded on server ', aServer moniker; cr]. self closeGroup. Transcript cr; show: 'Be sure to test your new update!!'; cr. ! Item was changed: ----- Method: ServerDirectory>>outOfDate: (in category '*UpdateStream-updating') ----- outOfDate: aServer "Inform the user that this server does not have a current version of 'Updates.list' Return true if the user does not want any updates to happen." + | response | + response := Project uiManager + chooseOptionFrom: #('Install on others' 'Cancel entire update') + title: 'The server ', aServer moniker, ' is not up to date. + Please store the missing updates maually.'. + ^ response ~= 1! - | response | - response := UIManager default chooseFrom: #('Install on others' 'Cancel entire update') - title: 'The server ', aServer moniker, ' is not up to date. - Please store the missing updates maually.'. - ^ response ~= 1! Item was changed: ----- Method: ServerDirectory>>putUpdate: (in category '*UpdateStream-updating') ----- putUpdate: fileStrm "Put this file out as an Update on the servers of my group. Each version of the system may have its own set of update files, or they may all share the same files. 'updates.list' holds the master list. Each update is a fileIn whose name begins with a number. See Utilities class readServerUpdatesThrough:saveLocally:updateImage:. When two sets of updates are stored on the same directory, one of them has a * in its serverUrls description. When that is true, the first word of the description is put on the front of 'updates.list', and that index file is used." | myServers updateStrm newName response localName seq indexPrefix listContents version versIndex lastNum stripped | localName := fileStrm localName. fileStrm size = 0 ifTrue: [^ self inform: 'That file has zero bytes!! May have a new name.']. + (fileStrm contentsOfEntireFile includes: Character linefeed) ifTrue: + [self notify: 'That file contains linefeeds. Proceed if... - (fileStrm contentsOfEntireFile includes: Character linefeed) - ifTrue: [self notify: 'That file contains linefeeds. Proceed if... you know that this is okay (e.g. the file contains raw binary data).']. fileStrm reset. (self checkNames: {localName}) ifFalse: [^ nil]. "illegal characters" + response := Project uiManager + chooseOptionFrom: #('Install update' 'Cancel update') + title: 'Do you really want to broadcast the file ', localName, - response := UIManager default chooseFrom: #('Install update' 'Cancel update') - title: 'Do you really want to broadcast the file ', localName, '\to every Squeak user who updates from ' withCRs, self groupName, '?'. response = 1 ifFalse: [^ nil]. "abort" self openGroup. indexPrefix := (self groupName includes: $*) ifTrue: [(self groupName findTokens: ' ') first] "special for internal updates" ifFalse: ['']. "normal" + myServers := self + checkServersWithPrefix: indexPrefix + andParseListInto: + [:x | listContents := x]. + myServers size = 0 ifTrue: + [self closeGroup. ^ self]. - myServers := self checkServersWithPrefix: indexPrefix - andParseListInto: [:x | listContents := x]. - myServers size = 0 ifTrue: [self closeGroup. ^ self]. version := SystemVersion current version. versIndex := (listContents collect: [:pair | pair first]) indexOf: version. versIndex = 0 ifTrue: [self inform: 'There is no section in updates.list for your version'. self closeGroup. ^ nil]. "abort" "A few affirmations..." versIndex < listContents size ifTrue: [(self confirm: 'This system, ', version , + ' is not the latest version.\Make update for an older version?' withCRs) ifFalse: + [self closeGroup. ^ nil]]. "abort" - ' is not the latest version.\Make update for an older version?' withCRs) - ifFalse: [self closeGroup. ^ nil]]. "abort" (listContents at: versIndex) last isEmpty ifTrue: [(self confirm: 'Please confirm that you mean to issue the first update for ' , + version , '\(otherwise something is wrong).' withCRs) ifFalse: + [self closeGroup. ^ nil]]. - version , '\(otherwise something is wrong).' withCRs) - ifFalse: [self closeGroup. ^ nil]]. "We now determine next update number to be max of entire index" lastNum := listContents inject: 0 into: + [:max :pair | + pair last isEmpty + ifTrue: [max] + ifFalse: [max max: pair last last initialIntegerOrNil]]. - [:max :pair | pair last isEmpty - ifTrue: [max] - ifFalse: [max max: pair last last initialIntegerOrNil]]. "Save old copy of updates.list on local disk" FileDirectory default deleteFileNamed: indexPrefix , 'updates.list.bk'. UpdateStreamDownloader default writeList: listContents toStream: (FileStream fileNamed: indexPrefix , 'updates.list.bk'). "append name to updates with new sequence number" seq := (lastNum + 1) printString padded: #left to: 4 with: $0. "strip off any old seq number" stripped := localName copyFrom: (localName findFirst: [:c | c isDigit not]) to: localName size. newName := seq , stripped. listContents at: versIndex put: {version. (listContents at: versIndex) last copyWith: newName}. "Write a new copy on all servers..." updateStrm := ReadStream on: + (String streamContents: + [:s | + UpdateStreamDownloader default writeList: listContents toStream: s]). - (String streamContents: [:s | UpdateStreamDownloader default writeList: listContents toStream: s]). myServers do: [:aServer | fileStrm reset. "reopen" aServer putFile: fileStrm named: newName retry: true. updateStrm reset. aServer putFile: updateStrm named: indexPrefix , 'updates.list' retry: true. Transcript show: 'Update succeeded on server ', aServer moniker; cr]. self closeGroup. Transcript cr; show: 'Be sure to test your new update!!'; cr. "rename the file locally (may fail)" fileStrm directory rename: localName toBe: newName. ! Item was changed: ----- Method: ServerDirectory>>putUpdateMulti:fromDirectory: (in category '*UpdateStream-updating') ----- putUpdateMulti: list fromDirectory: updateDirectory "Put these files out as an Update on the servers of my group. List is an array of local file names with or without number prefixes. Each version of the system has its own set of update files. 'updates.list' holds the master list. Each update is a fileIn whose name begins with a number. See Utilities class absorbUpdatesFromServer." | myServers updateStrm lastNum response newNames numStr indexPrefix version versIndex listContents | (self checkNames: (list collect: "Check the names without their numbers" + [:each | + each copyFrom: (each findFirst: [:c | c isDigit not]) to: each size])) - [:each | each copyFrom: (each findFirst: [:c | c isDigit not]) to: each size])) ifFalse: [^ nil]. + response := Project uiManager + chooseOptionFrom: #('Install update' 'Cancel update') + title: 'Do you really want to broadcast ', list size printString, ' updates', - response := UIManager default chooseFrom: #('Install update' 'Cancel update') - title: 'Do you really want to broadcast ', list size printString, ' updates', '\to every Squeak user who updates from ' withCRs, self groupName, '?'. response = 1 ifFalse: [^ nil]. "abort" self openGroup. indexPrefix := (self groupName includes: $*) ifTrue: [(self groupName findTokens: ' ') first] "special for internal updates" ifFalse: ['']. "normal" myServers := self checkServersWithPrefix: indexPrefix andParseListInto: [:x | listContents := x]. myServers size = 0 ifTrue: [self closeGroup. ^ self]. version := SystemVersion current version. versIndex := (listContents collect: [:pair | pair first]) indexOf: version. versIndex = 0 ifTrue: [self inform: 'There is no section in updates.list for your version'. self closeGroup. ^ nil]. "abort" lastNum := (listContents at: versIndex) last last initialIntegerOrNil. versIndex < listContents size ifTrue: + [response := UIManager default chooseOptionFrom: #('Make update for an older version' 'Cancel update') - [response := UIManager default chooseFrom: #('Make update for an older version' 'Cancel update') title: 'This system, ', SystemVersion current version, ' is not the latest version'. response = 1 ifFalse: [self closeGroup. ^ nil]. + numStr := Project uiManager - numStr := UIManager default request: 'Please confirm or change the starting update number' initialAnswer: (lastNum+1) printString. lastNum := numStr asNumber - 1]. "abort" "Save old copy of updates.list on local disk" FileDirectory default deleteFileNamed: indexPrefix , 'updates.list.bk'. UpdateStreamDownloader default writeList: listContents toStream: (FileStream fileNamed: indexPrefix , 'updates.list.bk'). "Append names to updates with new sequence numbers" newNames := list with: (lastNum+1 to: lastNum+list size) collect: + [:each :num | | stripped seq | + seq := num printString padded: #left to: 4 with: $0. - [:each :num | | stripped seq | seq := num printString padded: #left to: 4 with: $0. "strip off any old seq number" stripped := each copyFrom: (each findFirst: [:c | c isDigit not]) to: each size. seq , stripped]. listContents at: versIndex put: {version. (listContents at: versIndex) second , newNames}. "Write a new copy on all servers..." updateStrm := ReadStream on: + (String streamContents: + [:s | + UpdateStreamDownloader default writeList: listContents toStream: s]). - (String streamContents: [:s | UpdateStreamDownloader default writeList: listContents toStream: s]). myServers do: [:aServer | + list withIndexDo: + [:local :ind | | file | - list withIndexDo: [:local :ind | | file | file := updateDirectory oldFileNamed: local. aServer putFile: file named: (newNames at: ind) retry: true. file close]. updateStrm reset. aServer putFile: updateStrm named: indexPrefix , 'updates.list' retry: true. Transcript show: 'Update succeeded on server ', aServer moniker; cr]. self closeGroup. Transcript cr; show: 'Be sure to test your new update!!'; cr. "rename the file locally" list with: newNames do: + [:local :newName | + updateDirectory rename: local toBe: newName]. - [:local :newName | updateDirectory rename: local toBe: newName]. ! Item was changed: ----- Method: UpdateStreamDownloader class>>readServerUpdatesThrough:saveLocally:updateImage: (in category 'fetching updates') ----- readServerUpdatesThrough: maxNumber saveLocally: saveLocally updateImage: updateImage "Scan the update server(s) for unassimilated updates. If maxNumber is not nil, it represents the highest-numbered update to load. This makes it possible to update only up to a particular point. If saveLocally is true, then save local copies of the update files on disc. If updateImage is true, then absorb the updates into the current image. A file on the server called updates.list has the names of the last N update files. We look backwards for the first one we do not have, and start there" "* To add a new update: Name it starting with a new two-digit code. * Do not use %, /, *, space, or more than one period in the name of an update file. * The update name does not need to have any relation to the version name. * Figure out which versions of the system the update makes sense for. * Add the name of the file to each version's category below. * Put this file and the update file on all of the servers. * * To make a new version of the system: Pick a name for it (no restrictions) * Put # and exactly that name on a new line at the end of this file. * During the release process, fill in exactly that name in the dialog box. * Put this file on the server." "When two sets of updates need to use the same directory, one of them has a * in its serverUrls description. When that is true, the first word of the description is put on the front of 'updates.list', and that is the index file used." "UpdateStreamDownloader readServerUpdatesThrough: 3922 saveLocally: true updateImage: true" | failed loaded str res servers triple tryAgain indexPrefix | UpdateStreamDownloader chooseUpdateList ifFalse: [^ self]. "ask the user which kind of updates" servers := UpdateStreamDownloader serverUrls copy. indexPrefix := (UpdateStreamDownloader updateUrlLists first first includes: $*) + ifTrue: [(UpdateStreamDownloader updateUrlLists first first findTokens: ' ') first] "special for internal updates" - ifTrue: [(UpdateStreamDownloader updateUrlLists first first findTokens: ' ') first] - "special for internal updates" ifFalse: ['']. "normal" + [servers isEmpty] whileFalse: + [triple := self readServer: servers special: indexPrefix - [servers isEmpty] whileFalse: [ - triple := self readServer: servers special: indexPrefix updatesThrough: maxNumber saveLocally: saveLocally updateImage: updateImage. "report to user" failed := triple first. loaded := triple second. tryAgain := false. failed ifNil: ["is OK" + loaded = 0 ifTrue: "found no updates" + [servers size > 1 ifTrue: "not the last server" + [res := Project uiManager + chooseOptionFrom: #('Stop looking' 'Try next server') - loaded = 0 ifTrue: ["found no updates" - servers size > 1 ifTrue: ["not the last server" - res := UIManager default - chooseFrom: #('Stop looking' 'Try next server') title: 'No new updates on the server ', servers first, ' Would you like to try the next server? (Normally, all servers are identical, but sometimes a server won''t let us store new files, and gets out of date.)' . + res = 2 + ifFalse: [^ self] + ifTrue: + [servers := servers allButFirst. "try the next server" - res = 2 ifFalse: [^ self] - ifTrue: [servers := servers allButFirst. "try the next server" tryAgain := true]]]]. + tryAgain ifFalse: + [str := loaded printString ,' new update file(s) processed.'. + ^ self inform: str]].! - tryAgain ifFalse: [ - str := loaded printString ,' new update file(s) processed.'. - ^ self inform: str]. - ].!
More information about the Squeak-dev mailing list |