[squeak-dev] The Trunk: UpdateStream-nice.4.mcz

commits at source.squeak.org commits at source.squeak.org
Fri Dec 6 23:08:51 UTC 2013


Nicolas Cellier uploaded a new version of UpdateStream to project The Trunk:
http://source.squeak.org/trunk/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

=============== Diff against UpdateStream-fbs.3 ===============

Item was added:
+ ----- 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!

Item was added:
+ ----- 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.
+ !

Item was added:
+ ----- 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'!

Item was added:
+ ----- 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'.!

Item was added:
+ ----- 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.!

Item was added:
+ ----- Method: ServerDirectory class>>convertGroupNames (in category '*UpdateStream-server groups') -----
+ convertGroupNames
+ 	"ServerDirectory convertGroupNames"
+ 	self servers do: [:each | each convertGroupName]!

Item was added:
+ ----- 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
+ !

Item was added:
+ ----- 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!

Item was added:
+ ----- 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].
+ !

Item was added:
+ ----- 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
+ !

Item was added:
+ ----- 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
+ 
+ !

Item was added:
+ ----- Method: ServerDirectory>>closeGroup (in category '*UpdateStream-server groups') -----
+ closeGroup
+ 	"Close connection with all servers in the group."
+ 
+ 	self serversInGroup do: [:aDir | aDir quit].
+ !

Item was added:
+ ----- Method: ServerDirectory>>convertGroupName (in category '*UpdateStream-server groups') -----
+ convertGroupName
+ 	group
+ 		ifNotNil: [self groupName: self groupName]!

Item was added:
+ ----- 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.
+ !

Item was added:
+ ----- 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.
+ !

Item was added:
+ ----- 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].
+ !

Item was added:
+ ----- 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!

Item was added:
+ ----- 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.
+ !

Item was added:
+ ----- 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].
+ !

Item was added:
+ ----- Method: ServerDirectory>>serversInGroup (in category '*UpdateStream-server groups') -----
+ serversInGroup
+ 	^self groupName
+ 		ifNil: [Array with: self]
+ 		ifNotNil: [self class serversInGroupNamed: self groupName]!

Item was added:
+ ----- 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]!

Item was added:
+ ----- 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]!

Item was changed:
+ ----- Method: UpdateStreamDownloader class>>assureAbsenceOfUnstableUpdateStream (in category 'server urls') -----
- ----- Method: UpdateStreamDownloader class>>assureAbsenceOfUnstableUpdateStream (in category 'fetching updates') -----
  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"!

Item was added:
+ ----- 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"!

Item was changed:
+ ----- Method: UpdateStreamDownloader class>>assureAvailabilityOfUnstableUpdateStream (in category 'server urls') -----
- ----- Method: UpdateStreamDownloader class>>assureAvailabilityOfUnstableUpdateStream (in category 'fetching updates') -----
  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"!

Item was added:
+ ----- 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!

Item was changed:
+ ----- Method: UpdateStreamDownloader class>>serverUrls (in category 'server urls') -----
- ----- Method: UpdateStreamDownloader class>>serverUrls (in category 'fetching updates') -----
  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!

Item was changed:
+ ----- Method: UpdateStreamDownloader class>>updateUrlLists (in category 'server urls') -----
- ----- Method: UpdateStreamDownloader class>>updateUrlLists (in category 'fetching updates') -----
  updateUrlLists
  
  	UpdateUrlLists ifNil: [UpdateUrlLists := OrderedCollection new].
  	^ UpdateUrlLists!



More information about the Squeak-dev mailing list