[Pkg] The Trunk: Network-nice.145.mcz

commits at source.squeak.org commits at source.squeak.org
Fri Dec 6 23:18:42 UTC 2013


Nicolas Cellier uploaded a new version of Network to project The Trunk:
http://source.squeak.org/trunk/Network-nice.145.mcz

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

Name: Network-nice.145
Author: nice
Time: 7 December 2013, 12:18:04.883 am
UUID: 5db477ec-3e3d-49da-830d-51da62c79e17
Ancestors: Network-topa.144

Move updateStream stuff to UpdateStream package

=============== Diff against Network-topa.144 ===============

Item was removed:
- ----- Method: ImageReadWriter class>>formFromServerFile: (in category '*network') -----
- 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 (Utilities serverUrls) returns the right group of servers."
- 
- 	| urls |
- 	urls := Utilities 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 removed:
- ----- Method: ServerDirectory class>>convertGroupNames (in category 'server groups') -----
- convertGroupNames
- 	"ServerDirectory convertGroupNames"
- 	self servers do: [:each | each convertGroupName]!

Item was removed:
- ----- Method: ServerDirectory class>>groupNames (in category '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 removed:
- ----- Method: ServerDirectory class>>serverInGroupNamed: (in category '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 removed:
- ----- Method: ServerDirectory class>>serversInGroupNamed: (in category '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 removed:
- ----- Method: ServerDirectory>>checkNames: (in category 'updates') -----
- 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 removed:
- ----- Method: ServerDirectory>>checkServersWithPrefix:andParseListInto: (in category 'updates') -----
- 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: (Utilities parseListContents: listContents).
- 
- 	serverList removeAll: outOfDateServers.
- 	^serverList
- 
- !

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

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

Item was removed:
- ----- Method: ServerDirectory>>copyUpdatesNumbered:toVersion: (in category 'updates') -----
- 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'.
- 	Utilities 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 removed:
- ----- Method: ServerDirectory>>exportUpdatesExcept: (in category 'updates') -----
- 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 :=  Utilities 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'.
- 	Utilities 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 removed:
- ----- Method: ServerDirectory>>openGroup (in category 'server groups') -----
- openGroup
- 	"Open all servers in the group.  Don't forget to close later."
- 
- 	self serversInGroup do: [:aDir | aDir wakeUp].
- !

Item was removed:
- ----- Method: ServerDirectory>>outOfDate: (in category 'updates') -----
- 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 removed:
- ----- Method: ServerDirectory>>putUpdate: (in category 'updates') -----
- 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'.
- 	Utilities 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 removed:
- ----- Method: ServerDirectory>>putUpdateMulti:fromDirectory: (in category 'updates') -----
- 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'.
- 	Utilities 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 removed:
- ----- Method: ServerDirectory>>serversInGroup (in category 'server groups') -----
- serversInGroup
- 	^self groupName
- 		ifNil: [Array with: self]
- 		ifNotNil: [self class serversInGroupNamed: self groupName]!

Item was removed:
- ----- Method: ServerDirectory>>updateInstallVersion: (in category 'updates') -----
- 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 | Utilities 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]!



More information about the Packages mailing list