'From Squeak3.1alpha of 28 February 2001 [latest update: #4175] on 27 June 2001 at 9:49:22 pm'!
"Change Set: serverGroups
Date: 26 June 2001
Author: Michael Rueger
Changes the way server groups are managed. Replaces the list of servers held in every ServerDirectory with a group name. Groups are computed on demand by filtering through the list of known servers.
These changes are a precondition for the external server definitions introduced in a later change set."!
!DocLibrary methodsFor: 'doc pane' stamp: 'mir 6/26/2001 12:08'!
docObjectAt: classAndMethod
"Return a morphic object that is the documentation pane for this method. nil if none can be found. Look on both the network and the disk."
| fileNames server aUrl strm local obj |
methodVersions size = 0 ifTrue: [self updateMethodVersions]. "first time"
fileNames _ self docNamesAt: classAndMethod.
self assureCacheFolder.
self haveNetwork ifTrue: [
"server _ (ServerDirectory serverInGroupNamed: group) clone." "Note: directory ends with '/updates' which needs to be '/docpane', but altUrl end one level up"
server _ ServerDirectory serverInGroupNamed: group.
"later try multiple servers"
aUrl _ server altUrl, 'docpane/'.
fileNames do: [:aVersion |
strm _ HTTPSocket httpGetNoError: aUrl,aVersion
args: nil accept: 'application/octet-stream'.
strm class == RWBinaryOrTextStream ifTrue: [
self cache: strm as: aVersion.
strm reset.
obj _ strm fileInObjectAndCode asMorph.
(obj valueOfProperty: #classAndMethod) = classAndMethod ifFalse: [
self inform: 'suspicious object'.
obj setProperty: #classAndMethod toValue: classAndMethod].
^ obj]. "The pasteUpMorph itself"
"If file not there, error 404, just keep going"]].
local _ ServerDirectory new fullPath: DocsCachePath.
"check that it is really there -- let user respecify"
fileNames do: [:aVersion |
(local includesKey: aVersion) ifTrue: [
strm _ local readOnlyFileNamed: aVersion.
obj _ strm fileInObjectAndCode asMorph.
(obj valueOfProperty: #classAndMethod) = classAndMethod ifFalse: [
self inform: 'suspicious object'.
obj setProperty: #classAndMethod toValue: classAndMethod].
Transcript cr; show: 'local cache: ', aVersion.
^ obj]. "The pasteUpMorph itself"
"If file not there, just keep looking"].
"Never been documented"
^ nil! !
!DocLibrary methodsFor: 'database of updates' stamp: 'mir 6/26/2001 12:07'!
absorbAfter: oldVersion from: fileName
"Read the .ix file and add to the methodVersions database. See class comment."
| server aUrl strm newUpdate newName prevFile classAndMethod updateID key verList new |
server _ ServerDirectory serverInGroupNamed: group.
"later try multiple servers"
aUrl _ server altUrl, 'docpane/', fileName.
strm _ HTTPSocket httpGetNoError: aUrl
args: nil accept: 'application/octet-stream'.
strm class == RWBinaryOrTextStream ifFalse: [^ false].
(strm upTo: $ ) = 'External' ifFalse: [strm close. ^ false].
newUpdate _ Integer readFrom: strm.
newUpdate = oldVersion ifTrue: [strm close. ^ false]. "already have it"
strm upTo: $'.
newName _ strm nextDelimited: $'. strm upTo: Character cr.
prevFile _ strm upTo: Character cr.
"does this report on updates just after what I know?"
oldVersion = (prevFile splitInteger first) ifFalse: [
strm close. ^ prevFile]. "see earlier sucessor file"
[strm atEnd] whileFalse: [
strm upTo: $'.
classAndMethod _ strm nextDelimited: $'. strm next.
updateID _ Integer readFrom: strm.
key _ DocLibrary properStemFor: classAndMethod.
verList _ methodVersions at: key ifAbsent: [#()].
(verList includes: updateID) ifFalse: [
new _ verList, (Array with: updateID with: -1 "file date seen").
methodVersions at: key put: new]].
strm close.
lastUpdate _ newUpdate.
lastUpdateName _ newName.
^ true! !
!FileList methodsFor: 'file list menu' stamp: 'mir 6/26/2001 12:07'!
putUpdate
"Put this file out as an Update on the servers."
| names choice |
self canDiscardEdits ifFalse: [^ self changed: #flash].
names _ ServerDirectory groupNames asSortedArray.
choice _ (SelectionMenu labelList: names selections: names) startUp.
choice == nil ifTrue: [^ self].
(ServerDirectory serverInGroupNamed: choice) putUpdate:
(directory oldFileNamed: self fullName).
self volumeListIndex: volListIndex.
! !
!FtpUrl methodsFor: 'downloading' stamp: 'mir 6/26/2001 09:47'!
retrieveContents
"currently assumes directories end in /, and things that don't end in / are files. Also, doesn't handle errors real well...."
| server contents pathString listing auth idx fileName serverName userName password |
pathString _ self pathString.
pathString _ pathString copyFrom: 2 to: pathString size. "remove the leading /"
pathString last = $/ ifTrue:["directory?!!"
fileName _ nil.
] ifFalse:[
fileName _ pathString copyFrom: (pathString lastIndexOf: $/)+1 to: pathString size.
pathString _ pathString copyFrom: 1 to: (pathString lastIndexOf: $/) - 1.
].
auth _ self authority.
idx _ auth indexOf: $@.
idx > 0 ifTrue:[
serverName _ (auth copyFrom: idx+1 to: auth size).
userName _ (auth copyFrom: 1 to: idx-1).
password _ nil.
] ifFalse:[
serverName _ auth.
userName _ 'anonymous'.
password _ 'SqueakUser'.
].
server _ ServerDirectory servers
detect:[:s| s isTypeFTP and:[s server asLowercase = serverName asLowercase]]
ifNone:[nil].
server ifNil:[
server _ ServerDirectory new.
server server: serverName.
] ifNotNil:[server _ server copy reset].
server user: userName.
password ifNotNil:[server password: password].
server directory: pathString.
fileName == nil ifFalse:[
"a file"
contents _ (server getFileNamed: fileName).
server sleep.
(contents respondsTo: #contents) ifTrue: [
"the file exists--return it"
^MIMEDocument contentType: (MIMEDocument guessTypeFromName: self path last) content: contents contents ]
ifFalse: [
"some error"
^nil ]. ].
"a directory?"
listing _ String streamContents: [ :stream |
stream nextPutAll: '
', self pathString, ''; cr.
stream nextPutAll: 'Listing for ', self pathString, '
'; cr.
stream nextPutAll: ''; cr.
server entries do: [ :entry |
stream nextPutAll: '- ';
nextPutAll: '';
nextPutAll: entry name;
nextPutAll: '';
cr ] ].
server sleep.
^MIMEDocument contentType: 'text/html' content: listing! !
!ServerDirectory methodsFor: 'updates' stamp: 'mir 6/26/2001 11:56'!
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."
| final fileSize this serverList listContents decided myContents abort |
serverList _ self serversInGroup.
final _ OrderedCollection new.
fileSize _ 0. listContents _ ''. "list of updates"
abort _ false.
serverList do: [:aServer |
decided _ false.
this _ aServer getFileNamed: prefix , 'updates.list'.
(this = #error:) ifTrue: [^'' "Not found"].
this class == String ifTrue: ["no ftp"
(PopUpMenu labels: 'Cancel entire update' withCRs)
startUpWithCaption: 'Server ', aServer moniker,
' is unavailable.\Please consider phoning the administator.\' withCRs, this.
abort _ true.
decided _ true].
decided not & (this size > fileSize) ifTrue:
["new has a longer update.list"
fileSize _ this size.
final do: [:each | abort _ self outOfDate: each].
(final _ OrderedCollection new) add: aServer.
listContents _ this contentsOfEntireFile.
listBlock value: (Utilities parseListContents: listContents).
decided _ true].
decided not & (this size < fileSize) ifTrue:
[abort _ self outOfDate: aServer. decided _ true].
decided not ifTrue:
[myContents _ this contentsOfEntireFile.
myContents = listContents
ifTrue: [final add: aServer]
ifFalse: [abort _ self outOfDate: aServer]].
abort ifTrue: [^ Array new].
].
^ final
! !
!ServerDirectory methodsFor: 'updates' stamp: 'mir 6/26/2001 12:00'!
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 groupNamed: 'Disney Internal Updates*')
exportUpdatesExcept: #(3959).
"
| myServers updateStrm response seq indexPrefix listContents version versIndex lastNum expContents expVersIndex additions |
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 _ (PopUpMenu labels: 'Make update for an older version\Cancel update' withCRs)
startUpWithCaption: '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') contentsOfEntireFile.
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 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 _ 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.
! !
!ServerDirectory methodsFor: 'updates' stamp: 'mir 6/26/2001 12:02'!
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 _ (PopUpMenu labels: 'Install update\Cancel update' withCRs)
startUpWithCaption: '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"
lastNum _ (listContents at: versIndex) last last initialIntegerOrNil.
versIndex < listContents size ifTrue:
[response _ (PopUpMenu labels: 'Make update for an older version\Cancel update' withCRs)
startUpWithCaption: 'This system, ', SystemVersion current version,
' is not the latest version'.
response = 1 ifFalse: [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').
"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.
! !
!ServerDirectory methodsFor: 'updates' stamp: 'mir 6/26/2001 12:01'!
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 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 file numStr indexPrefix listContents version versIndex seq stripped |
self inform: 'This code has not been tested since the rewrite for
multiple copies of updates.list.'.
(self checkNames: list) ifFalse: [^ nil].
response _ (PopUpMenu labels: 'Install update\Cancel update' withCRs)
startUpWithCaption: '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 _ (PopUpMenu labels: 'Make update for an older version\Cancel update' withCRs)
startUpWithCaption: 'This system, ', SystemVersion current version,
' is not the latest version'.
response = 1 ifFalse: [self closeGroup. ^ nil].
numStr _ FillInTheBlank
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 | 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) , 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 _ 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].
! !
!ServerDirectory methodsFor: 'updates' stamp: 'mir 6/26/2001 12:07'!
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 _ (SelectionMenu labelList: names selections: names) startUp.
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]! !
!ServerDirectory methodsFor: 'server groups' stamp: 'mir 6/26/2001 11:56'!
closeGroup
"Close connection with all servers in the group."
self serversInGroup do: [:aDir | aDir quit].
! !
!ServerDirectory methodsFor: 'server groups' stamp: 'mir 6/26/2001 12:25'!
convertGroupName
group
ifNotNil: [self groupName: self groupName]! !
!ServerDirectory methodsFor: 'server groups' stamp: 'mir 6/26/2001 11:59'!
groupName
^group
ifNil: [self moniker]
ifNotNil: [
(group isKindOf: String)
ifTrue: [group]
ifFalse: [group key]]! !
!ServerDirectory methodsFor: 'server groups' stamp: 'mir 6/26/2001 12:13'!
groupName: groupName
group _ groupName! !
!ServerDirectory methodsFor: 'server groups' stamp: 'mir 6/26/2001 11:57'!
openGroup
"Open all servers in the group. Don't forget to close later."
self serversInGroup do: [:aDir | aDir wakeUp].
! !
!ServerDirectory methodsFor: 'server groups' stamp: 'mir 6/26/2001 11:56'!
serversInGroup
^self groupName
ifNil: [Array with: self]
ifNotNil: [self class serversInGroupNamed: self groupName]! !
!ServerDirectory class methodsFor: 'available servers' stamp: 'mir 6/26/2001 09:46'!
addServer: server named: nameString
self servers at: nameString put: server! !
!ServerDirectory class methodsFor: 'available servers' stamp: 'mir 6/26/2001 09:45'!
nameForServer: aServer
^self servers keyAtValue: aServer! !
!ServerDirectory class methodsFor: 'available servers' stamp: 'mir 6/26/2001 09:47'!
removeServerNamed: nameString
self
removeServerNamed: nameString
ifAbsent: [self error: 'Server "' , nameString asString , '" not found']! !
!ServerDirectory class methodsFor: 'available servers' stamp: 'mir 6/26/2001 09:46'!
removeServerNamed: nameString ifAbsent: aBlock
self servers removeKey: nameString ifAbsent: [aBlock value]! !
!ServerDirectory class methodsFor: 'available servers' stamp: 'mir 6/26/2001 09:45'!
resetServers
Servers _ nil! !
!ServerDirectory class methodsFor: 'available servers' stamp: 'mir 6/26/2001 14:29'!
serverForURL: aURL
| serversForURL server urlPath serverPath relPath |
serversForURL _ self servers values select: [:each |
(aURL beginsWith: each downloadUrl)
or: [(aURL beginsWith: each realUrl)
or: [aURL , '/' beginsWith: each downloadUrl]]].
serversForURL isEmpty
ifTrue: [^nil].
server _ serversForURL first.
urlPath _ aURL asUrl path.
(urlPath isEmpty not
and: [urlPath last isEmpty])
ifTrue: [urlPath removeLast].
serverPath _ server downloadUrl asUrl path.
(serverPath isEmpty not
and: [serverPath last isEmpty])
ifTrue: [serverPath removeLast].
urlPath size < serverPath size
ifTrue: [^nil].
relPath _ String new.
serverPath size +1 to: urlPath size do: [:i | relPath _ relPath , '/' , (urlPath at: i)].
^relPath isEmpty
ifTrue: [server]
ifFalse: [server directoryNamed: (relPath copyFrom: 2 to: relPath size)]! !
!ServerDirectory class methodsFor: 'available servers' stamp: 'mir 6/26/2001 14:06'!
serverNamed: nameString
^self serverNamed: nameString ifAbsent: [self error: 'Server name not found']! !
!ServerDirectory class methodsFor: 'available servers' stamp: 'mir 6/26/2001 09:44'!
serverNamed: nameString ifAbsent: aBlock
^self servers at: nameString asString ifAbsent: [aBlock value]! !
!ServerDirectory class methodsFor: 'available servers' stamp: 'mir 6/26/2001 09:48'!
serverNames
^self servers keys asSortedArray! !
!ServerDirectory class methodsFor: 'available servers' stamp: 'mir 6/26/2001 09:45'!
servers
Servers ifNil: [Servers _ Dictionary new].
^Servers! !
!ServerDirectory class methodsFor: 'server groups' stamp: 'mir 6/26/2001 12:26'!
convertGroupNames
"ServerDirectory convertGroupNames"
self servers do: [:each | each convertGroupName]! !
!ServerDirectory class methodsFor: 'server groups' stamp: 'mir 6/26/2001 12:11'!
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
! !
!ServerDirectory class methodsFor: 'server groups' stamp: 'mir 6/26/2001 12:06'!
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! !
!ServerDirectory class methodsFor: 'server groups' stamp: 'mir 6/26/2001 11:55'!
serversInGroupNamed: nameString
"Return the servers in the group of this name."
"ServerDirectory serversInGroupNamed: 'Squeak Public Updates' "
^self servers values select: [:server |
nameString = server groupName].
! !
!Utilities class methodsFor: 'fetching updates' stamp: 'mir 6/26/2001 12:08'!
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,
Utilities readServerUpdatesSaveLocally: true updateImage: true.
These can then be rebroadcast to any server using, eg,
Utilities 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 _ (SelectionMenu labelList: names selections: names) startUp.
choice == nil ifTrue: [^ self].
(ServerDirectory serverInGroupNamed: choice)
putUpdateMulti: fileNamesInOrder fromDirectory: updateDirectory
! !
ServerDirectory class removeSelector: #addGroup:named:!
ServerDirectory class removeSelector: #groupNamed:!
ServerDirectory class removeSelector: #namedServers!
ServerDirectory removeSelector: #group!
ServerDirectory removeSelector: #group:!
ServerDirectory removeSelector: #removeFromGroup!
"Postscript:
Convert to the new group organization."
ServerDirectory convertGroupNames.
!