[squeak-dev] Squeak 4.6: UpdateStream-nice.4.mczcommits at source.squeak.org commits at source.squeak.orgFri Jun 5 20:27:06 UTC 2015
Chris Muller uploaded a new version of UpdateStream to project Squeak 4.6: http://source.squeak.org/squeak46/UpdateStream-nice.4.mcz ==================== Summary ==================== Name: UpdateStream-nice.4 Author: nice Time: 7 December 2013, 12:08:41.719 am UUID: 5fcdedce-88aa-469a-bf8b-32820f051c4f Ancestors: UpdateStream-fbs.3 Move some updateStream hooks in UpdateStream package This does not make the package properly removeable, because those hooks often are hardcoded So after removal, there will be some unimplemented sends ==================== Snapshot ==================== SystemOrganization addCategory: #UpdateStream! ----- Method: ServerDirectory class>>convertGroupNames (in category '*UpdateStream-server groups') ----- convertGroupNames "ServerDirectory convertGroupNames" self servers do: [:each | each convertGroupName]! ----- Method: ServerDirectory class>>groupNames (in category '*UpdateStream-server groups') ----- groupNames "Return the names of all registered groups of servers, including individual servers not in any group." "ServerDirectory groupNames" | names | names := Set new. self servers do: [:server | names add: server groupName]. ^names asSortedArray ! ----- Method: ServerDirectory class>>serverInGroupNamed: (in category '*UpdateStream-server groups') ----- serverInGroupNamed: groupName "Return the first (available) server in the group of this name." | servers | servers := self serversInGroupNamed: groupName. servers isEmpty ifTrue: [self error: 'No server found in group "' , groupName asString , '".']. ^servers first! ----- Method: ServerDirectory class>>serversInGroupNamed: (in category '*UpdateStream-server groups') ----- serversInGroupNamed: nameString "Return the servers in the group of this name." "ServerDirectory serversInGroupNamed: 'Squeak Public Updates' " ^self servers values select: [:server | nameString = server groupName]. ! ----- Method: ServerDirectory>>checkNames: (in category '*UpdateStream-updating') ----- checkNames: list "Look at these names for update and see if they are OK" list do: [:local | (local count: [:char | char == $.]) > 1 ifTrue: [ self inform: 'File name ',local,' may not have more than one period'. ^ false]. local size > 26 ifTrue: ["allows for 5 digit update numbers" self inform: 'File name ',local,' is too long. Please rename it.'. ^ false]. (local at: 1) isDigit ifTrue: [ self inform: 'File name ',local,' may not begin with a number'. ^ false]. (local findDelimiters: '%/* ' startingAt: 1) <= local size ifTrue: [ self inform: 'File name ',local,' may not contain % / * or space'. ^ false]]. ^ true ! ----- 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 isEmpty ifTrue: [^Array new]. updateLists := Dictionary new. serverList do: [:updateServer | [listContents := updateServer getFileNamed: prefix , 'updates.list'. updateLists at: updateServer put: listContents] on: Error do: [:ex | 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 | (updateLists at: updateServer) size < maxSize]. outOfDateServers do: [:updateServer | (self outOfDate: updateServer) ifTrue: [^Array new]]. listBlock value: (UpdateStreamDownloader default parseListContents: listContents). serverList removeAll: outOfDateServers. ^serverList ! ----- Method: ServerDirectory>>closeGroup (in category '*UpdateStream-server groups') ----- closeGroup "Close connection with all servers in the group." self serversInGroup do: [:aDir | aDir quit]. ! ----- Method: ServerDirectory>>convertGroupName (in category '*UpdateStream-server groups') ----- convertGroupName group ifNotNil: [self groupName: self groupName]! ----- Method: ServerDirectory>>copyUpdatesNumbered:toVersion: (in category '*UpdateStream-updating') ----- copyUpdatesNumbered: selectList toVersion: otherVersion "Into the section of updates.list corresponding to otherVersion, copy all the fileNames from this version matching the selectList." " (ServerDirectory serverInGroupNamed: 'Disney Internal Updates*') copyUpdatesNumbered: #(4411 4412) to version: 'Squeak3.1beta'. " | myServers updateStrm indexPrefix version versIndex lastNum otherVersIndex additions outOfOrder 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 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" otherVersIndex := (listContents collect: [:pair | pair first]) indexOf: otherVersion. otherVersIndex = 0 ifTrue: [self inform: 'There is no section in updates.list for the target version'. self closeGroup. ^ nil]. "abort" versIndex < listContents size ifTrue: [(self confirm: 'This system, ', version , ' is not the latest version.\OK to copy updates from that old version?' withCRs) ifFalse: [self closeGroup. ^ nil]]. "abort" "Append all fileNames in my list that are not in the export list" additions := OrderedCollection new. outOfOrder := OrderedCollection new. lastNum := (listContents at: otherVersIndex) last isEmpty ifTrue: [0] "no checking if the current list is empty" ifFalse: [(listContents at: otherVersIndex) last last initialIntegerOrNil]. (listContents at: versIndex) last do: [:fileName | | seq | seq := fileName initialIntegerOrNil. (selectList includes: seq) ifTrue: [seq > lastNum ifTrue: [additions addLast: fileName] ifFalse: [outOfOrder addLast: seq]]]. outOfOrder isEmpty ifFalse: [UIManager default inform: 'Updates numbered ' , outOfOrder asArray printString, ' are out of order.\ The last update in ' withCRs, otherVersion, ' is ', lastNum printString, '.\No update will take place.' withCRs. self closeGroup. ^ nil]. "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'). "Write a new copy of updates.list on all servers..." listContents at: otherVersIndex put: {otherVersion. (listContents at: otherVersIndex) last , additions}. updateStrm := ReadStream on: (String streamContents: [:s | Utilities writeList: listContents toStream: s]). myServers do: [:aServer | 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. ! ----- 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 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 := 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. (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" "Write a new copy of updates.list on all servers..." updateStrm := ReadStream on: (String streamContents: [:s | Utilities 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. ! ----- Method: ServerDirectory>>openGroup (in category '*UpdateStream-server groups') ----- openGroup "Open all servers in the group. Don't forget to close later." self serversInGroup do: [:aDir | aDir wakeUp]. ! ----- 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 := 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! ----- 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 notifyWithLabel: '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 := 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]. 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" (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]]. "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]]. "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 | Utilities 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. ! ----- 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])) ifFalse: [^ nil]. 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 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 := 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. "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 | Utilities writeList: listContents toStream: s]). myServers do: [:aServer | list doWithIndex: [: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]. ! ----- Method: ServerDirectory>>serversInGroup (in category '*UpdateStream-server groups') ----- serversInGroup ^self groupName ifNil: [Array with: self] ifNotNil: [self class serversInGroupNamed: self groupName]! ----- Method: ServerDirectory>>updateInstallVersion: (in category '*UpdateStream-updating') ----- updateInstallVersion: newVersion "For each server group, ask whether we want to put the new version marker (eg 'Squeak2.3') at the end of the file. Current version of Squeak must be the old one when this is done. ServerDirectory new updateInstallVersion: 'Squeak9.9test' " | myServers updateStrm names choice indexPrefix listContents version versIndex | [names := ServerDirectory groupNames asSortedArray. choice := UIManager default chooseFrom: names values: names. choice == nil] whileFalse: [indexPrefix := (choice endsWith: '*') ifTrue: [(choice findTokens: ' ') first] "special for internal updates" ifFalse: ['']. "normal" myServers := (ServerDirectory serverInGroupNamed: choice) checkServersWithPrefix: indexPrefix andParseListInto: [:x | listContents := x]. myServers size = 0 ifTrue: [^ 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']. "abort" "Append new version to updates following my version" listContents := listContents copyReplaceFrom: versIndex+1 to: versIndex with: {{newVersion. {}}}. updateStrm := ReadStream on: (String streamContents: [:s | UpdateStreamDownloader default writeList: listContents toStream: s]). myServers do: [:aServer | updateStrm reset. aServer putFile: updateStrm named: indexPrefix ,'updates.list'. Transcript cr; show: indexPrefix ,'updates.list written on server ', aServer moniker]. self closeGroup]! ----- Method: ImageReadWriter class>>formFromServerFile: (in category '*UpdateStream') ----- formFromServerFile: fileName "Answer a ColorForm stored on the file with the given name. Meant to be called from during the getting of updates from the server. That assures that (UpdateStreamDownloader default serverUrls) returns the right group of servers." | urls | urls := UpdateStreamDownloader default serverUrls collect: [:url | url, fileName]. " fileName starts with: 'updates/' " urls do: [:aURL | | form doc | (fileName findTokens: '.') last asLowercase = 'gif' ifTrue: [ form := HTTPSocket httpGif: aURL. form = (ColorForm extent: 20 at 20 depth: 8) ifTrue: [self inform: 'The file ',aURL,' is ill formed.']. ^ form]. (fileName findTokens: '.') last asLowercase = 'bmp' ifTrue: [ doc := HTTPSocket httpGet: aURL accept: 'image/bmp'. form := Form fromBMPFile: doc. doc close. form ifNil: [self inform: 'The file ',aURL,' is ill formed.'. ^ Form new] ifNotNil: [^ form]]. self inform: 'File ', fileName, 'does not end with .gif or .bmp']. self inform: 'That file not found on any server we know'.! Object subclass: #UpdateStreamDownloader instanceVariableNames: '' classVariableNames: 'PromptForUpdateServer UpdateDownloader UpdateSavesFile UpdateUrlLists' poolDictionaries: '' category: 'UpdateStream'! ----- Method: UpdateStreamDownloader class>>applyUpdatesFromDisk (in category 'fetching updates') ----- applyUpdatesFromDisk "UpdateStreamDownloader applyUpdatesFromDisk" "compute highest update number" | updateDirectory updateNumbers | updateDirectory := self getUpdateDirectoryOrNil. updateDirectory ifNil: [^ self]. updateNumbers := updateDirectory fileNames collect: [:fn | fn initialIntegerOrNil] thenSelect: [:fn | fn notNil]. self applyUpdatesFromDiskToUpdateNumber: (updateNumbers inject: 0 into: [:max :num | max max: num]) stopIfGap: false! ----- Method: UpdateStreamDownloader class>>applyUpdatesFromDiskToUpdateNumber:stopIfGap: (in category 'fetching updates') ----- applyUpdatesFromDiskToUpdateNumber: lastUpdateNumber stopIfGap: stopIfGapFlag "To use this mechanism, be sure all updates you want to have considered are in a folder named 'updates' which resides in the same directory as your image. Having done that, simply evaluate: UpdateStreamDownloader applyUpdatesFromDiskToUpdateNumber: 1234 stopIfGap: false and all numbered updates <= lastUpdateNumber not yet in the image will be loaded in numerical order." | previousHighest currentUpdateNumber done fileNames aMessage updateDirectory loaded | updateDirectory := self getUpdateDirectoryOrNil. updateDirectory ifNil: [^ self]. previousHighest := SystemVersion current highestUpdate. currentUpdateNumber := previousHighest. done := false. loaded := 0. [done] whileFalse: [currentUpdateNumber := currentUpdateNumber + 1. currentUpdateNumber > lastUpdateNumber ifTrue: [done := true] ifFalse: [fileNames := updateDirectory fileNamesMatching: currentUpdateNumber printString , '*'. fileNames size > 1 ifTrue: [^ self inform: 'ambiguity -- two files both start with ' , currentUpdateNumber printString , ' (at this point it is probably best to remedy the situation on disk, then try again.)']. fileNames size = 0 ifTrue: [Transcript cr; show: 'gap in updates from disk for update number '; print: currentUpdateNumber; show: ' found...'. done := stopIfGapFlag] ifFalse: [ChangeSet newChangesFromStream: (updateDirectory readOnlyFileNamed: fileNames first) named: fileNames first. SystemVersion current registerUpdate: currentUpdateNumber. loaded := loaded + 1]]]. aMessage := loaded = 0 ifTrue: ['No new updates found.'] ifFalse: [loaded printString , ' update(s) loaded.']. self inform: aMessage , ' Highest numbered update is now ' , (currentUpdateNumber - 1) printString , '.'! ----- Method: UpdateStreamDownloader class>>assureAbsenceOfUnstableUpdateStream (in category 'server urls') ----- assureAbsenceOfUnstableUpdateStream "Check to see if the unstable Updates stream is in the list; if it is, *remove* it. This is the *opposite* of #assureAvailabilityOfUnstableUpdateStream" UpdateUrlLists ifNil: [UpdateUrlLists := OrderedCollection new]. UpdateUrlLists := UpdateUrlLists select: [:pair | pair first ~= 'Unstable Updates*'] "UpdateStreamDownloader assureAbsenceOfUnstableUpdateStream"! ----- Method: UpdateStreamDownloader class>>assureAvailabilityOfSqueakPublicUpdateStream (in category 'server urls') ----- assureAvailabilityOfSqueakPublicUpdateStream "Check to see if the Squeak public Updates stream is in the list; if not, add it" UpdateUrlLists ifNil: [UpdateUrlLists := OrderedCollection new]. UpdateUrlLists do: [:pair | (pair first = 'Squeak Public Updates') ifTrue: [^ self]]. UpdateUrlLists addFirst: #('Squeak Public Updates' #('ftp.squeak.org/')) "UpdateStreamDownloader assureAvailabilityOfSqueakPublicUpdateStream"! ----- Method: UpdateStreamDownloader class>>assureAvailabilityOfUnstableUpdateStream (in category 'server urls') ----- assureAvailabilityOfUnstableUpdateStream "Check to see if the unstable Updates stream is in the list; if not, add it" UpdateUrlLists ifNil: [UpdateUrlLists := OrderedCollection new]. UpdateUrlLists do: [:pair | (pair first = 'Unstable Updates*') ifTrue: [^ self]]. UpdateUrlLists addFirst: #('Unstable Updates*' #('squeak.cs.uiuc.edu/Squeak2.0/' 'update.squeakfoundation.org/external/')) "UpdateStreamDownloader assureAvailabilityOfUnstableUpdateStream"! ----- Method: UpdateStreamDownloader class>>broadcastUpdatesFrom:to:except: (in category 'fetching updates') ----- broadcastUpdatesFrom: n1 to: n2 except: skipList " Note: This method takes its list of files from the directory named 'updates', which will have been created and filled by, eg, UpdateStreamDownloader readServerUpdatesSaveLocally: true updateImage: true. These can then be rebroadcast to any server using, eg, UpdateStreamDownloader broadcastUpdatesFrom: 1 to: 9999 except: #(223 224). If the files are already on the server, and it is only a matter of copying them to the index for a different version, then use... (ServerDirectory serverInGroupNamed: 'SqC Internal Updates*') exportUpdatesExcept: #(). " | fileNames fileNamesInOrder names choice file updateDirectory | updateDirectory := FileDirectory default directoryNamed: 'updates'. fileNames := updateDirectory fileNames select: [:n | n first isDigit and: [(n initialIntegerOrNil between: n1 and: n2) and: [(skipList includes: n initialIntegerOrNil) not]]]. (file := fileNames select: [:n | (n occurrencesOf: $.) > 1]) size > 0 ifTrue: [self halt: file first , ' has multiple periods']. fileNamesInOrder := fileNames asSortedCollection: [:a :b | a initialIntegerOrNil < b initialIntegerOrNil]. names := ServerDirectory groupNames asSortedArray. choice := UIManager default chooseFrom: names values: names. choice == nil ifTrue: [^ self]. (ServerDirectory serverInGroupNamed: choice) putUpdateMulti: fileNamesInOrder fromDirectory: updateDirectory ! ----- Method: UpdateStreamDownloader class>>chooseUpdateList (in category 'fetching updates') ----- chooseUpdateList "When there is more than one set of update servers, let the user choose which we will update from. Put it at the front of the list. Return false if the user aborted. If the preference #promptForUpdateServer is false, then suppress that prompt, in effect using the same server choice that was used the previous time (a convenience for those of us who always answer the same thing to the prompt.)" | index him | ((UpdateUrlLists size > 1) and: [self promptForUpdateServer]) ifTrue: [index := UIManager default chooseFrom: (UpdateUrlLists collect: [:each | each first]) lines: #() title: 'Choose a group of servers\from which to fetch updates.' translated withCRs. index > 0 ifTrue: [him := UpdateUrlLists at: index. UpdateUrlLists removeAt: index. UpdateUrlLists addFirst: him]. ^ index > 0]. ^ true! ----- Method: UpdateStreamDownloader class>>default (in category 'accessing') ----- default "Answer the default downloader. Currently, all methods are at class side, so it'll be ourself" ^self! ----- Method: UpdateStreamDownloader class>>extractThisVersion: (in category 'fetching updates') ----- extractThisVersion: list "Pull out the part of the list that applies to this version." | listContents version versIndex | listContents := self parseListContents: list. version := SystemVersion current version. versIndex := (listContents collect: [:pair | pair first]) indexOf: version. versIndex = 0 ifTrue: [^ Array new]. "abort" ^ (listContents at: versIndex) last! ----- Method: UpdateStreamDownloader class>>fileInFromUpdatesFolder: (in category 'fetching updates') ----- fileInFromUpdatesFolder: numberList "File in a series of updates with the given updates numbers, from the updates folder in the default directory. The file-ins are done in numeric order, even if numberList was not sorted upon entry. This is useful for test-driving the retrofitting of a possibly discontinguous list of updates from an alpha version back to a stable release. UpdateStreamDownloader fileInFromUpdatesFolder: #(4745 4746 4747 4748 4749 4750 4751 4752 4754 4755 4761 4762 4767 4769). " | fileNames fileNamesInOrder file updateDirectory | updateDirectory := FileDirectory default directoryNamed: 'updates'. fileNames := updateDirectory fileNames select: [:n | n first isDigit and: [numberList includes: n initialIntegerOrNil]]. (file := fileNames select: [:n | (n occurrencesOf: $.) > 1]) size > 0 ifTrue: [self error: file first , ' has multiple periods']. fileNamesInOrder := fileNames asSortedCollection: [:a :b | a initialIntegerOrNil < b initialIntegerOrNil]. fileNamesInOrder do: [:aFileName | (updateDirectory readOnlyFileNamed: aFileName) fileIntoNewChangeSet]! ----- Method: UpdateStreamDownloader class>>getUpdateDirectoryOrNil (in category 'fetching updates') ----- getUpdateDirectoryOrNil ^ (FileDirectory default directoryNames includes: 'updates') ifTrue: [FileDirectory default directoryNamed: 'updates'] ifFalse: [self inform: 'Error: cannot find "updates" folder'. nil]! ----- Method: UpdateStreamDownloader class>>lastUpdateNum: (in category 'fetching updates') ----- lastUpdateNum: updatesFileStrm "Look in the Updates file and see what the last sequence number is. Warn the user if the version it is under is not this image's version." | verIndex seqIndex char ver seqNum | verIndex := seqIndex := 0. "last # starting a line and last digit starting a line" seqNum := 0. updatesFileStrm reset; ascii. [char := updatesFileStrm next. updatesFileStrm atEnd] whileFalse: [ char == Character cr ifTrue: [ updatesFileStrm peek == $# ifTrue: [verIndex := updatesFileStrm position +1. seqIndex = 0 ifFalse: ["See if last num of old version if biggest so far" updatesFileStrm position: seqIndex. ver := SmallInteger readFrom: updatesFileStrm. seqNum := seqNum max: ver. updatesFileStrm position: verIndex-1]]. updatesFileStrm peek isDigit ifTrue: [seqIndex := updatesFileStrm position]]]. seqIndex = 0 ifFalse: ["See if last num of old version if biggest so far" updatesFileStrm position: seqIndex. ver := SmallInteger readFrom: updatesFileStrm. seqNum := seqNum max: ver. updatesFileStrm setToEnd]. ^ seqNum! ----- Method: UpdateStreamDownloader class>>newUpdatesOn:special:throughNumber: (in category 'fetching updates') ----- newUpdatesOn: serverList special: indexPrefix throughNumber: aNumber "Return a list of fully formed URLs of update files we do not yet have. Go to the listed servers and look at the file 'updates.list' for the names of the last N update files. We look backwards for the first one we have, and make the list from there. tk 9/10/97 No updates numbered higher than aNumber (if it is not nil) are returned " | existing out maxNumber | maxNumber := aNumber ifNil: [99999]. out := OrderedCollection new. existing := SystemVersion current updates. serverList do: [:server | | raw doc list char | doc := HTTPClient httpGet: 'http://' , server,indexPrefix,'updates.list'. "test here for server being up" doc class == RWBinaryOrTextStream ifTrue: [raw := doc reset; contents. "one file name per line" list := self extractThisVersion: raw. list reverseDo: [:fileName | | ff itsNumber | ff := (fileName findTokens: '/') last. "allow subdirectories" itsNumber := ff initialIntegerOrNil. (existing includes: itsNumber) ifFalse: [ (itsNumber == nil or: [itsNumber <= maxNumber]) ifTrue: [out addFirst: 'http://' , server, fileName]] ifTrue: [^ out]]. ((out size > 0) or: [char := doc reset; skipSeparators; next. (char == $*) | (char == $#)]) ifTrue: [^ out "we have our list"]]. "else got error msg instead of file" "Server was down, try next one"]. self inform: 'All code update servers seem to be unavailable'. ^ out! ----- Method: UpdateStreamDownloader class>>objectStrmFromUpdates: (in category 'fetching updates') ----- objectStrmFromUpdates: fileName "Go to the known servers and look for this file in the updates folder. It is an auxillery file, like .morph or a .gif. Return a RWBinaryOrTextStream on it. Meant to be called from during the getting of updates from the server. That assures that (UpdateStreamDownloader serverUrls) returns the right group of servers." Cursor wait showWhile: [ | urls | urls := UpdateStreamDownloader serverUrls collect: [:url | url, 'updates/', fileName]. urls do: [:aUrl | | doc | doc := HTTPSocket httpGet: aUrl accept: 'application/octet-stream'. "test here for server being up" doc class == RWBinaryOrTextStream ifTrue: [^ doc reset]]]. self inform: 'All update servers are unavailable, or bad file name'. ^ nil! ----- Method: UpdateStreamDownloader class>>parseListContents: (in category 'fetching updates') ----- parseListContents: listContents | sections vers strm line fileNames | "Parse the contents of updates.list into {{vers. {fileNames*}}*}, and return it." sections := OrderedCollection new. fileNames := OrderedCollection new: 1000. vers := nil. strm := ReadStream on: listContents. [strm atEnd] whileFalse: [line := strm nextLine. line size > 0 ifTrue: [line first = $# ifTrue: [vers ifNotNil: [sections addLast: {vers. fileNames asArray}]. "Start a new section" vers := line allButFirst. fileNames resetTo: 1] ifFalse: [line first = $* ifFalse: [fileNames addLast: line]]]]. vers ifNotNil: [sections addLast: {vers. fileNames asArray}]. ^ sections asArray " TEST: | list | list := UpdateStreamDownloader parseListContents: (FileStream oldFileNamed: 'updates.list') contentsOfEntireFile. list = (UpdateStreamDownloader parseListContents: (String streamContents: [:s | UpdateStreamDownloader writeList: list toStream: s])) ifFalse: [self error: 'test failed'] ifTrue: [self inform: 'test OK'] "! ----- Method: UpdateStreamDownloader class>>position:atVersion: (in category 'fetching updates') ----- position: updateStrm atVersion: version "Set the stream to the end of the last line of updates names for this version. Usually the end of the file. We will add a new update name. Return the contents of the rest of the file." | char foundIt where data | updateStrm reset; ascii. foundIt := false. [char := updateStrm next. updateStrm atEnd] whileFalse: [ (char == Character cr or: [char == Character lf]) ifTrue: [ updateStrm peek == $# ifTrue: [ foundIt ifTrue: ["Next section" where := updateStrm position. data := updateStrm upTo: (255 asCharacter). updateStrm position: where. ^ data]. "won't be found -- copy all the way to the end" updateStrm next. (updateStrm nextMatchAll: version) ifTrue: [ (updateStrm atEnd or: [(updateStrm peek = Character cr) | (updateStrm peek = Character lf)]) ifTrue: [ foundIt := true ]]]]]. foundIt ifTrue: [ updateStrm setToEnd. ^ '']. self error: 'The current version does not have a section in the Updates file'. ! ----- Method: UpdateStreamDownloader class>>promptForUpdateServer (in category 'preferences') ----- promptForUpdateServer <preference: 'Prompt for update server' category: 'updates' description: 'If false, the prompt for server choice when updating code from the server is suppressed. Set this to false to leave the server choice unchanged from update to update.' type: #Boolean> ^PromptForUpdateServer ifNil: [ false ]! ----- Method: UpdateStreamDownloader class>>promptForUpdateServer: (in category 'preferences') ----- promptForUpdateServer: aBoolean PromptForUpdateServer := aBoolean! ----- Method: UpdateStreamDownloader class>>readNextUpdateFromServer (in category 'fetching updates') ----- readNextUpdateFromServer "UpdateStreamDownloader readNextUpdateFromServer" self updateFromServerThroughUpdateNumber: (ChangeSet highestNumberedChangeSet + 1)! ----- Method: UpdateStreamDownloader class>>readNextUpdatesFromDisk: (in category 'fetching updates') ----- readNextUpdatesFromDisk: n "Read the updates up through the current highest-update-number plus n. Thus, UpdateStreamDownloader readNextUpdatesFromDisk: 7 will read the next seven updates from disk" self applyUpdatesFromDiskToUpdateNumber: ChangeSet highestNumberedChangeSet + n stopIfGap: false! ----- Method: UpdateStreamDownloader class>>readServer:special:updatesThrough:saveLocally:updateImage: (in category 'fetching updates') ----- readServer: serverList special: indexPrefix updatesThrough: 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." "UpdateStreamDownloader readServer: UpdateStreamDownloader serverUrls updatesThrough: 828 saveLocally: true updateImage: true" | str urls failed loaded | Cursor wait showWhile: [ | docQueue docQueueSema | urls := self newUpdatesOn: (serverList collect: [:url | url, 'updates/']) special: indexPrefix throughNumber: maxNumber. loaded := 0. failed := nil. "send downloaded documents throuh this queue" docQueue := SharedQueue new. "this semaphore keeps too many documents from beeing queueed up at a time" docQueueSema := Semaphore new. 5 timesRepeat: [ docQueueSema signal ]. "fork a process to download the updates" self retrieveUrls: urls ontoQueue: docQueue withWaitSema: docQueueSema. "process downloaded updates in the foreground" 'Processing updates' displayProgressFrom: 0 to: urls size during: [:bar | | nextDoc this updateName | [ this := docQueue next. nextDoc := docQueue next. nextDoc = #failed ifTrue: [ failed := this ]. (failed isNil and: [ nextDoc ~= #finished ]) ] whileTrue: [ failed ifNil: [ nextDoc reset; text. nextDoc size = 0 ifTrue: [ failed := this ]. ]. failed ifNil: [ nextDoc peek asciiValue = 4 "pure object file" ifTrue: [failed := this]]. "Must be fileIn, not pure object file" failed ifNil: [ "(this endsWith: '.html') ifTrue: [doc := doc asHtml]." "HTML source code not supported here yet" updateImage ifTrue: [ updateName := (this findTokens: '/') last. ChangeSet newChangesFromStream: nextDoc named: updateName. SystemVersion current registerUpdate: updateName initialIntegerOrNil]. saveLocally ifTrue: [self saveUpdate: nextDoc onFile: (this findTokens: '/') last]. "if wanted" loaded := loaded + 1. bar value: loaded]. docQueueSema signal]. ]]. failed ~~ nil & (urls size - loaded > 0) ifTrue: [ str := loaded printString ,' new update file(s) processed.'. str := str, '\Could not load ' withCRs, (urls size - loaded) printString ,' update file(s).', '\Starting with "' withCRs, failed, '".'. self inform: str]. ^ Array with: failed with: loaded ! ----- Method: UpdateStreamDownloader class>>readServerUpdatesSaveLocally:updateImage: (in category 'fetching updates') ----- readServerUpdatesSaveLocally: saveLocally updateImage: updateImage ^ self readServerUpdatesThrough: nil saveLocally: saveLocally updateImage: updateImage! ----- 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" ifFalse: ['']. "normal" [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 := 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" tryAgain := true]]]]. tryAgain ifFalse: [ str := loaded printString ,' new update file(s) processed.'. ^ self inform: str]. ].! ----- Method: UpdateStreamDownloader class>>retrieveUrls:ontoQueue:withWaitSema: (in category 'fetching updates') ----- retrieveUrls: urls ontoQueue: queue withWaitSema: waitSema "download the given list of URLs. The queue will be loaded alternately with url's and with the retrieved contents. If a download fails, the contents will be #failed. If all goes well, a special pair with an empty URL and the contents #finished will be put on the queue. waitSema is waited on every time before a new document is downloaded; this keeps the downloader from getting too far ahead of the main process" "kill the existing downloader if there is one" | updateCounter | UpdateDownloader ifNotNil: [UpdateDownloader terminate]. updateCounter := 0. "fork a new downloading process" UpdateDownloader := [ 'Downloading updates' displayProgressFrom: 0 to: urls size during: [:bar | urls do: [:url | | front canPeek doc | waitSema wait. queue nextPut: url. doc := HTTPClient httpGet: url. doc isString ifTrue: [queue nextPut: #failed. UpdateDownloader := nil. Processor activeProcess terminate] ifFalse: [canPeek := 120 min: doc size. front := doc next: canPeek. doc skip: -1 * canPeek. (front beginsWith: '<!!DOCTYPE') ifTrue: [ (front includesSubString: 'Not Found') ifTrue: [ queue nextPut: #failed. UpdateDownloader := nil. Processor activeProcess terminate]]]. UpdateDownloader ifNotNil: [queue nextPut: doc. updateCounter := updateCounter + 1. bar value: updateCounter]]]. queue nextPut: ''. queue nextPut: #finished. UpdateDownloader := nil] newProcess. UpdateDownloader priority: Processor userInterruptPriority. "start the process running" UpdateDownloader resume! ----- Method: UpdateStreamDownloader class>>saveUpdate:onFile: (in category 'fetching updates') ----- saveUpdate: doc onFile: fileName "Save the update on a local file. With or without the update number on the front, depending on the preference #updateRemoveSequenceNum" | file fName pos updateDirectory | (FileDirectory default directoryNames includes: 'updates') ifFalse: [FileDirectory default createDirectory: 'updates']. updateDirectory := FileDirectory default directoryNamed: 'updates'. fName := fileName. self updateRemoveSequenceNum ifTrue: [pos := fName findFirst: [:c | c isDigit not]. fName := fName copyFrom: pos to: fName size]. doc reset; ascii. (updateDirectory fileExists: fName) ifFalse: [file := updateDirectory newFileNamed: fName. file nextPutAll: doc contents. file close]. ! ----- Method: UpdateStreamDownloader class>>serverUrls (in category 'server urls') ----- serverUrls "Return the current list of server URLs. For code updates. Format of UpdateUrlLists is #( ('squeak updates' ('url1' 'url2')) ('some other updates' ('url3' 'url4')))" | list | list := UpdateUrlLists first last. "If there is a dead server, return a copy with that server last" Socket deadServer ifNotNil: [ list clone withIndexDo: [:aName :ind | (aName beginsWith: Socket deadServer) ifTrue: [ list := list asOrderedCollection. "and it's a copy" list removeAt: ind. list addLast: aName]] ]. ^ list asArray! ----- Method: UpdateStreamDownloader class>>setUpdateServer: (in category 'fetching updates') ----- setUpdateServer: groupName "UpdateStreamDownloader setUpdateServer: 'Squeakland' " | entry index | entry := UpdateUrlLists detect: [:each | each first = groupName] ifNone: [^self]. index := UpdateUrlLists indexOf: entry. UpdateUrlLists removeAt: index. UpdateUrlLists addFirst: entry! ----- Method: UpdateStreamDownloader class>>summariesForUpdates:through: (in category 'fetching updates') ----- summariesForUpdates: startNumber through: stopNumber "Answer the concatenation of summary strings for updates numbered in the given range" ^ String streamContents: [:aStream | ((ChangeSet changeSetsNamedSuchThat: [:aName | aName first isDigit and: [aName initialIntegerOrNil >= startNumber and: [aName initialIntegerOrNil <= stopNumber]]]) asSortedCollection: [:a :b | a name < b name]) do: [:aChangeSet | aStream cr; nextPutAll: aChangeSet summaryString]] "UpdateStreamDownloader summariesForUpdates: 4899 through: 4903" ! ----- Method: UpdateStreamDownloader class>>updateComment (in category 'fetching updates') ----- updateComment "The following used to be at the beginning of the update file. Now it is here to simplify parsing the file... * To add a new update: Name it starting with a new four-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 a copy of updates.list on the server. * * Special file with a different name for Disney Internal Updates. * No need to move or rename files to release them to external updates. "! ----- Method: UpdateStreamDownloader class>>updateFromServer (in category 'fetching updates') ----- updateFromServer "Update the image by loading all pending updates from the server. Also save local copies of the update files if the #updateSavesFile preference is set to true" self readServerUpdatesSaveLocally: self updateSavesFile updateImage: true! ----- Method: UpdateStreamDownloader class>>updateFromServerThroughUpdateNumber: (in category 'fetching updates') ----- updateFromServerThroughUpdateNumber: aNumber "Update the image by loading all pending updates from the server. Also save local copies of the update files if the #updateSavesFile preference is set to true" self readServerUpdatesThrough: aNumber saveLocally: self updateSavesFile updateImage: true! ----- Method: UpdateStreamDownloader class>>updateRemoveSequenceNum (in category 'preferences') ----- updateRemoveSequenceNum ^false! ----- Method: UpdateStreamDownloader class>>updateSavesFile (in category 'preferences') ----- updateSavesFile <preference: 'Update saves files' category: 'updates' description: 'If true, then when an update is loaded from the server, a copy of it will automatically be saved on a local file as well.' type: #Boolean> ^UpdateSavesFile ifNil: [ false ]! ----- Method: UpdateStreamDownloader class>>updateSavesFile: (in category 'preferences') ----- updateSavesFile: aBoolean UpdateSavesFile := aBoolean! ----- Method: UpdateStreamDownloader class>>updateUrlLists (in category 'server urls') ----- updateUrlLists UpdateUrlLists ifNil: [UpdateUrlLists := OrderedCollection new]. ^ UpdateUrlLists! ----- Method: UpdateStreamDownloader class>>writeList:toStream: (in category 'fetching updates') ----- writeList: listContents toStream: strm "Write a parsed updates.list out as text. This is the inverse of parseListContents:" strm reset. listContents do: [:pair | | version fileNames | version := pair first. fileNames := pair last. strm nextPut: $#; nextPutAll: version; cr. fileNames do: [:fileName | strm nextPutAll: fileName; cr]]. strm close! ----- Method: UpdateStreamDownloader class>>zapUpdateDownloader (in category 'fetching updates') ----- zapUpdateDownloader UpdateDownloader ifNotNil: [UpdateDownloader terminate]. UpdateDownloader := nil.! ----- Method: AutoStart class>>checkForUpdates (in category '*UpdateStream') ----- checkForUpdates | availableUpdate updateServer | World ifNotNil: [ World install. ActiveHand position: 100 @ 100 ]. HTTPClient isRunningInBrowser ifFalse: [ ^ self processUpdates ]. availableUpdate := (Smalltalk namedArguments at: 'UPDATE' ifAbsent: [ '' ]) asInteger. availableUpdate ifNil: [ ^ false ]. updateServer := Smalltalk namedArguments at: 'UPDATESERVER' ifAbsent: [ Smalltalk namedArguments at: 'UPDATE_SERVER' ifAbsent: [ 'Squeakland' ] ]. UpdateStreamDownloader default setUpdateServer: updateServer. ^ SystemVersion checkAndApplyUpdates: availableUpdate! ----- Method: FileList>>putUpdate: (in category '*UpdateStream') ----- putUpdate: fullFileName "Put this file out as an Update on the servers." | names choice | self canDiscardEdits ifFalse: [^ self changed: #flash]. names := ServerDirectory groupNames asSortedArray. choice := UIManager default chooseFrom: names values: names. choice == nil ifTrue: [^ self]. (ServerDirectory serverInGroupNamed: choice) putUpdate: (directory oldFileNamed: fullFileName). self volumeListIndex: volListIndex. ! ----- Method: FileList>>serviceBroadcastUpdate (in category '*UpdateStream') ----- serviceBroadcastUpdate "Answer a service for broadcasting a file as an update" ^ SimpleServiceEntry provider: self label: 'broadcast as update' selector: #putUpdate: description: 'broadcast file as update' buttonLabel: 'broadcast'! ----- Method: FilePackage class>>conflictsWithUpdatedMethods: (in category '*UpdateStream-instance creation') ----- conflictsWithUpdatedMethods: fullName | conflicts changeList | conflicts := (self fromFileNamed: fullName) conflictsWithUpdatedMethods. conflicts isEmpty ifTrue: [^ self]. changeList := ChangeList new. changeList changes: conflicts file: (FileDirectory default readOnlyFileNamed: fullName) close. ChangeList open: changeList name: 'Conflicts for ', (FileDirectory localNameFor: fullName) multiSelect: true.! ----- Method: FilePackage class>>fileReaderServicesForFile:suffix: (in category '*UpdateStream-reader service') ----- fileReaderServicesForFile: fullName suffix: suffix ^(suffix = 'st') | (suffix = 'cs') | (suffix = '*') ifTrue: [self services] ifFalse: [#()]! ----- Method: FilePackage class>>serviceConflictsWithUpdatedMethods (in category '*UpdateStream-reader service') ----- serviceConflictsWithUpdatedMethods ^ SimpleServiceEntry provider: self label: 'conflicts with updated methods' selector: #conflictsWithUpdatedMethods: description: 'check for conflicts with more recently updated methods in the image, showing the conflicts in a transcript window' buttonLabel: 'conflicts'! ----- Method: FilePackage class>>services (in category '*UpdateStream-reader service') ----- services ^ Array with: self serviceConflictsWithUpdatedMethods! ----- Method: FilePackage>>checkForMoreRecentUpdateThanChangeSet:pseudoClass:selector: (in category '*UpdateStream-conflict checker') ----- checkForMoreRecentUpdateThanChangeSet: updateNumberChangeSet pseudoClass: pseudoClass selector: selector "Returns the source code for a conflict if a conflict is found, otherwise returns nil." | classOrMeta allChangeSets moreRecentChangeSets conflictingChangeSets changeRecordSource classAndMethodPrintString | classAndMethodPrintString := pseudoClass name, (pseudoClass hasMetaclass ifTrue: [' class'] ifFalse: ['']), '>>', selector asString. changeRecordSource := pseudoClass sourceCode at: selector. changeRecordSource isText ifTrue: [changeRecordSource := Text fromString: 'method: ', classAndMethodPrintString, ' was removed'] ifFalse: [changeRecordSource stamp isEmptyOrNil ifTrue: [self notify: 'Warning: ', classAndMethodPrintString, ' in ', self packageName, ' has no timestamp/initials!!']]. pseudoClass exists ifFalse: [(self classes at: pseudoClass name) hasDefinition ifTrue: [^ nil "a method was added for a newly defined class; not a conflict"] ifFalse: [self class logCr; log: 'CONFLICT found for ', classAndMethodPrintString, '... class ', pseudoClass name asString, ' does not exist in the image and is not defined in the file'. ^ changeRecordSource]]. classOrMeta := pseudoClass realClass. "Only printout the replacing methods here, but we still check for removed methods too in the rest of this method." (self class verboseConflicts and: [classOrMeta includesSelector: selector]) ifTrue: [self class logCr; log: '...checking ', classOrMeta asString, '>>', selector asString]. allChangeSets := ChangesOrganizer allChangeSets. moreRecentChangeSets := allChangeSets copyFrom: (allChangeSets indexOf: updateNumberChangeSet) to: (allChangeSets size). conflictingChangeSets := (moreRecentChangeSets select: [:cs | (cs atSelector: selector class: classOrMeta) ~~ #none]). conflictingChangeSets isEmpty ifTrue: [^ nil]. self class logCr; log: 'CONFLICT found for ', classAndMethodPrintString, (' with newer changeset' asPluralBasedOn: conflictingChangeSets). conflictingChangeSets do: [:cs | self class log: ' ', cs name]. ^ changeRecordSource ! ----- Method: FilePackage>>conflictsWithUpdatedMethods (in category '*UpdateStream-conflict checker') ----- conflictsWithUpdatedMethods "Check this package for conflicts with methods in the image which are in newer updates." | localFileName stream updateNumberString updateNumber imageUpdateNumber updateNumberChangeSet conflicts fileStream | localFileName := FileDirectory localNameFor: fullName. stream := ReadStream on: sourceSystem. stream upToAll: 'latest update: #'. updateNumberString := stream upTo: $]. stream close. fileStream := FileStream readOnlyFileNamed: fullName. (fileStream contentsOfEntireFile includes: Character linefeed) ifTrue: [self notifyWithLabel: 'The changeset file ', localFileName, ' contains linefeeds. Proceed if... you know that this is okay (e.g. the file contains raw binary data).']. fileStream close. updateNumberString isEmpty ifFalse: "remove prepended junk, if any" [updateNumberString := (updateNumberString findTokens: Character space) last]. updateNumberString asInteger ifNil: [(self confirm: 'Error: ', localFileName, ' has no valid Latest Update number in its header. Do you want to enter an update number for this file?') ifFalse: [^ self] ifTrue: [updateNumberString := UIManager default request: 'Please enter the estimated update number (e.g. 4332).']]. updateNumberString asInteger ifNil: [self inform: 'Conflict check cancelled.'. ^ self]. updateNumber := updateNumberString asInteger. imageUpdateNumber := SystemVersion current highestUpdate. updateNumber > imageUpdateNumber ifTrue: [(self confirm: 'Warning: The update number for this file (#', updateNumberString, ') is greater than the highest update number for this image (#', imageUpdateNumber asString, '). This probably means you need to update your image. Should we proceed anyway as if the file update number is #', imageUpdateNumber asString, '?') ifTrue: [updateNumber := imageUpdateNumber. updateNumberString := imageUpdateNumber asString] ifFalse: [^ self]]. updateNumberChangeSet := self findUpdateChangeSetMatching: updateNumber. updateNumberChangeSet ifNil: [^ self]. Smalltalk isMorphic ifTrue: [self currentWorld findATranscript: self currentEvent]. self class logCr; logCr; log: 'Checking ', localFileName, ' (#', updateNumberString, ') for method conflicts with changesets after ', updateNumberChangeSet name, ' ...'. conflicts := OrderedCollection new. self classes do: [:pseudoClass | (Array with: pseudoClass with: pseudoClass metaClass) do: [:classOrMeta | classOrMeta selectorsDo: [:selector | | conflict | conflict := self checkForMoreRecentUpdateThanChangeSet: updateNumberChangeSet pseudoClass: classOrMeta selector: selector. conflict ifNotNil: [conflicts add: conflict]. ]. ]. ]. self class logCr; log: conflicts size asString, (' conflict' asPluralBasedOn: conflicts), ' found.'; logCr. self class closeLog. ^ conflicts! ----- Method: FilePackage>>findUpdateChangeSetMatching: (in category '*UpdateStream-conflict checker') ----- findUpdateChangeSetMatching: updateNumber "Find update-changeset beginning with updateNumber, or reasonably close." "This is to account for the fact that many changeset files are output from final releases, but may be tested for conflicts in a following alpha image, which will often not include that particular update-changeset from the final release but will contain ones near it. For example, if the file updateNumber is 5180 (from 3.5 final), but the image has no update-changeset beginning with 5180 because it's a 3.6alpha image (which starts at 5181), it will try up to 5190 and down to 5170 for a close match." | updateNumberChangeSet updateNumberToTry | updateNumberToTry := updateNumber. updateNumberChangeSet := nil. [updateNumberChangeSet isNil and: [updateNumberToTry notNil]] whileTrue: [updateNumberChangeSet := ChangesOrganizer allChangeSets detect: [:cs | (cs name beginsWith: updateNumberToTry asString) and: [(cs name at: (updateNumberToTry asString size + 1)) isDigit not]] ifNone: [nil]. updateNumberToTry >= updateNumber ifTrue: [updateNumberToTry < (updateNumber + 10) ifTrue: [updateNumberToTry := updateNumberToTry + 1] ifFalse: [updateNumberToTry := updateNumber]]. updateNumberToTry <= updateNumber ifTrue: [updateNumberToTry > (updateNumber - 10) ifTrue: [updateNumberToTry := updateNumberToTry - 1] ifFalse: [updateNumberToTry := nil "we're done trying"]]. ]. updateNumberChangeSet ifNil: [(self confirm: 'Warning: No changeset beginning with ', updateNumber asString, ' (within +/- 10) was found in the image. You must have changesets going back this far in your image in order to accurately check for conflicts. Proceed anyway?') ifTrue: [updateNumberChangeSet := ChangesOrganizer allChangeSets first]]. ^ updateNumberChangeSet! ----- Method: MCConfigurationBrowser>>post (in category '*UpdateStream') ----- post "Take the current configuration and post an update" | name update managers names choice | (self checkRepositories and: [self checkDependencies]) ifFalse: [^self]. name := UIManager default request: 'Update name (.cs) will be appended):' initialAnswer: self configuration suggestedNameOfNextVersion. name isEmpty ifTrue:[^self]. self configuration name: name. update := MCPseudoFileStream on: (String new: 100). update localName: name, '.cs'. update nextPutAll: '"Change Set: ', name. update cr; nextPutAll: 'Date: ', Date today printString. update cr; nextPutAll: 'Author: Posted by Monticello'. update cr; cr; nextPutAll: 'This is a configuration map created by Monticello."'. update cr; cr; nextPutAll: '(MCConfiguration fromArray: #'. self configuration fileOutOn: update. update nextPutAll: ') upgrade.'. update position: 0. managers := Smalltalk at: #UpdateManager ifPresent:[:mgr| mgr allRegisteredManagers]. managers ifNil:[managers := #()]. managers size > 0 ifTrue:[ | servers index | servers := ServerDirectory groupNames asSortedArray. names := (managers collect:[:each| each packageVersion]), servers. index := UIManager default chooseFrom: names lines: {managers size}. index = 0 ifTrue:[^self]. index <= managers size ifTrue:[ | mgr | mgr := managers at: index. ^mgr publishUpdate: update. ]. choice := names at: index. ] ifFalse:[ names := ServerDirectory groupNames asSortedArray. choice := UIManager default chooseFrom: names values: names. choice == nil ifTrue: [^ self]. ]. (ServerDirectory serverInGroupNamed: choice) putUpdate: update.! ----- Method: SystemVersion class>>checkAndApplyUpdates: (in category '*UpdateStream') ----- checkAndApplyUpdates: availableUpdate "SystemVersion checkAndApplyUpdates: nil" ^(availableUpdate isNil or: [availableUpdate > SystemVersion current highestUpdate]) ifTrue: [ (self confirm: 'There are updates available. Do you want to install them now?') ifFalse: [^false]. UpdateStreamDownloader default readServerUpdatesThrough: availableUpdate saveLocally: false updateImage: true. Smalltalk snapshot: true andQuit: false. true] ifFalse: [false]!
More information about the Squeak-dev mailing list |