'From Squeak3.1alpha of 28 February 2001 [latest update: #4295] on 5 September 2001 at 6:17:54 pm'! "Change Set: LocalEtoyUserLists-ar Date: 5 September 2001 Author: Andreas Raab Fix up access to eToy user list for local project directories. Also provide a mechanism for giving a 'baseFolderSpec' in file based project directories which is used to match against a list of directories. E.g., for BJ's setup the baseFolderSpec would be something like: MyVolume:Squeak:users:*-Squeak which matches against the appropriate directory (such as 'Cathy-Squeak' in which case 'Cathy' is the login name)."! Object subclass: #ServerDirectory instanceVariableNames: 'server directory type user passwordHolder group moniker altURL urlObject socket loaderUrl eToyUserListUrl eToyUserList ' classVariableNames: 'LocalEToyBaseFolderSpecs LocalEToyUserListUrls LocalProjectDirectories Servers ' poolDictionaries: '' category: 'Network-Kernel'! !FileDirectory methodsFor: 'school support' stamp: 'ar 9/5/2001 16:09'! eToyBaseFolderSpec ^ServerDirectory eToyBaseFolderSpecForFileDirectory: self! ! !FileDirectory methodsFor: 'school support' stamp: 'ar 9/5/2001 16:09'! eToyBaseFolderSpec: aString ^ServerDirectory eToyBaseFolderSpecForFileDirectory: self put: aString! ! !FileDirectory methodsFor: 'school support' stamp: 'ar 9/5/2001 16:44'! eToyUserList | spec index fd list match | spec _ self eToyBaseFolderSpec. "something like 'U:\Squeak\users\*-Squeak'." spec ifNil:[^ServerDirectory eToyUserListForFileDirectory: self]. "Compute list of users based on base folder spec" index _ spec indexOf: $*. "we really need one" index = 0 ifTrue:[^ServerDirectory eToyUserListForFileDirectory: self]. fd _ FileDirectory on: (FileDirectory dirPathFor: (spec copyFrom: 1 to: index)). "reject all non-directories" list _ fd entries select:[:each| each isDirectory]. "reject all non-matching entries" match _ spec copyFrom: fd pathName size + 2 to: spec size. list _ list collect:[:each| each name]. list _ list select:[:each| match match: each]. "extract the names (e.g., those positions that match '*')" index _ match indexOf: $*. list _ list collect:[:each| each copyFrom: index to: each size - (match size - index)]. ^list! ! !FileDirectory methodsFor: 'school support' stamp: 'ar 9/5/2001 15:41'! eToyUserListUrl ^ServerDirectory eToyUserListUrlForFileDirectory: self! ! !FileDirectory methodsFor: 'school support' stamp: 'ar 9/5/2001 15:48'! eToyUserListUrl: urlString ^ServerDirectory eToyUserListUrlForFileDirectory: self put: urlString.! ! !FileDirectory methodsFor: 'school support' stamp: 'mir 9/5/2001 18:17'! eToyUserName: aString "Set the default directory from the given user name" | dirName | dirName _ self eToyBaseFolderSpec. "something like 'U:\Squeak\users\*-Squeak'" dirName ifNil:[^self]. dirName _ dirName copyReplaceAll:'*' with: aString. dirName last = self class pathNameDelimiter ifFalse:[dirName _ dirName, self slash]. FileDirectory setDefaultDirectoryFrom: dirName. dirName _ dirName copyFrom: 1 to: dirName size - 1. pathName _ dirName! ! !FileDirectory methodsFor: 'school support' stamp: 'ar 9/5/2001 16:13'! hasEToyUserList ^self eToyUserListUrl notNil or:[self eToyBaseFolderSpec notNil]! ! !ProjectLauncher methodsFor: 'eToy login' stamp: 'ar 9/5/2001 16:32'! doEtoyLogin "Pop up the eToy login if we have a server that provides us with a known user list" "Find us a server who could do eToy authentification for us" eToyAuthentificationServer _ (ServerDirectory localProjectDirectories, ServerDirectory servers values) detect:[:any| any hasEToyUserList] ifNone:[nil]. eToyAuthentificationServer "no server provides user information" ifNil:[^self startUpAfterLogin]. self prepareForLogin. EtoyLoginMorph loginAndDo:[:userName| self loginAs: userName] ifCanceled:[self cancelLogin].! ! !ProjectLauncher methodsFor: 'eToy login' stamp: 'ar 9/5/2001 16:05'! loginAs: userName "Assuming that we have a valid user url; read its contents and see if the user is really there." | actualName userList | eToyAuthentificationServer ifNil:[ self proceedWithLogin. ^true]. userList _ eToyAuthentificationServer eToyUserList. userList ifNil:[ self inform: 'Sorry, I cannot find the user list. (this may be due to a network problem) Please hit Cancel if you wish to use Squeak.'. ^false]. "case insensitive search" actualName _ userList detect:[:any| any sameAs: userName] ifNone:[nil]. actualName isNil ifTrue:[ self inform: 'Unknown user: ',userName. ^false]. Utilities authorName: actualName. eToyAuthentificationServer eToyUserName: actualName. self proceedWithLogin. ^true! ! !ServerDirectory methodsFor: 'school support' stamp: 'ar 9/5/2001 15:45'! eToyUserList "Return a list of all known users for eToy login support" | urlString | eToyUserList ifNotNil:[^eToyUserList]. urlString _ self eToyUserListUrl. urlString ifNil:[^nil]. eToyUserList _ self class parseEToyUserListFrom: urlString. ^eToyUserList! ! !ServerDirectory methodsFor: 'school support' stamp: 'ar 9/5/2001 16:05'! eToyUserName: aString "Ignored here"! ! !ServerDirectory methodsFor: 'school support' stamp: 'ar 9/5/2001 16:12'! hasEToyUserList ^eToyUserListUrl notNil! ! !ServerDirectory class methodsFor: 'available servers' stamp: 'ar 9/5/2001 16:11'! resetLocalProjectDirectories LocalProjectDirectories _ nil. LocalEToyUserListUrls _ nil. LocalEToyBaseFolderSpecs _ nil. ! ! !ServerDirectory class methodsFor: 'server prefs' stamp: 'ar 9/5/2001 16:12'! parseServerEntryFrom: stream | server type directory entries serverName | entries _ self parseServerEntryArgsFrom: stream. serverName _ entries at: 'name' ifAbsent: [^nil]. directory _ entries at: 'directory' ifAbsent: [^nil]. type _ entries at: 'type' ifAbsent: [^nil]. type = 'file' ifTrue: [ server _ FileDirectory default directoryNamed: directory. entries at: 'userListUrl' ifPresent:[:value | server eToyUserListUrl: value]. entries at: 'baseFolderSpec' ifPresent:[:value | server eToyBaseFolderSpec: value]. ^self addLocalProjectDirectory: server]. type = 'bss' ifTrue: [server _ SuperSwikiServer new type: #http]. type = 'http' ifTrue: [server _ HTTPServerDirectory new type: #ftp]. type = 'ftp' ifTrue: [server _ ServerDirectory new type: #ftp]. server directory: directory. entries at: 'server' ifPresent: [:value | server server: value]. entries at: 'user' ifPresent: [:value | server user: value]. entries at: 'group' ifPresent: [:value | server groupName: value]. entries at: 'passwdseq' ifPresent: [:value | server passwordSequence: value asNumber]. entries at: 'url' ifPresent: [:value | server altUrl: value]. entries at: 'loaderUrl' ifPresent: [:value | server loaderUrl: value]. entries at: 'acceptsUploads' ifPresent: [:value | server acceptsUploads: value asLowercase = 'true']. entries at: 'userListUrl' ifPresent:[:value | server eToyUserListUrl: value]. ServerDirectory addServer: server named: serverName. ! ! !ServerDirectory class methodsFor: 'school support' stamp: 'ar 9/5/2001 16:10'! eToyBaseFolderSpecForFileDirectory: aFileDirectory ^self localEToyBaseFolderSpecs at: aFileDirectory ifAbsent:[nil]! ! !ServerDirectory class methodsFor: 'school support' stamp: 'ar 9/5/2001 16:30'! eToyBaseFolderSpecForFileDirectory: aFileDirectory put: aString ^self localEToyBaseFolderSpecs at: aFileDirectory put: aString! ! !ServerDirectory class methodsFor: 'school support' stamp: 'ar 9/5/2001 16:38'! eToyUserListForFileDirectory: aFileDirectory | urlString | urlString _ self eToyUserListUrlForFileDirectory: aFileDirectory. urlString ifNil:[^nil]. ^self parseEToyUserListFrom: urlString! ! !ServerDirectory class methodsFor: 'school support' stamp: 'ar 9/5/2001 15:46'! eToyUserListUrlForFileDirectory: aFileDirectory ^self localEToyUserListUrls at: aFileDirectory ifAbsent:[nil]! ! !ServerDirectory class methodsFor: 'school support' stamp: 'ar 9/5/2001 15:48'! eToyUserListUrlForFileDirectory: aFileDirectory put: urlString ^self localEToyUserListUrls at: aFileDirectory put: urlString! ! !ServerDirectory class methodsFor: 'school support' stamp: 'ar 9/5/2001 16:11'! localEToyBaseFolderSpecs ^LocalEToyBaseFolderSpecs ifNil:[LocalEToyBaseFolderSpecs _ IdentityDictionary new]! ! !ServerDirectory class methodsFor: 'school support' stamp: 'ar 9/5/2001 15:47'! localEToyUserListUrls ^LocalEToyUserListUrls ifNil:[LocalEToyUserListUrls _ IdentityDictionary new].! ! !ServerDirectory class methodsFor: 'school support' stamp: 'ar 9/5/2001 16:34'! parseEToyUserListFrom: urlString | url userString userList | urlString ifNil:[^nil]. url _ urlString asUrl. ["Note: We need to prevent going through the plugin API when retrieving a local (file) URL, since the plugin API (correctly) rejects file:// downloads." Cursor wait showWhile:[ (url hasRemoteContents) ifTrue:[ "Go through the browser (if present)" userString _ (HTTPClient httpGet: url toText) contents. ] ifFalse:[ "Go grab it directly" userString _ url retrieveContents contents. ]. ]. ] on: Error do:[:ex| userString _ nil. ex return]. userString ifNil:[^nil]. "Get rid of any line ending problems" userString _ userString copyReplaceAll: String crlf with: String cr. userString _ userString copyReplaceAll: String lf with: String cr. userList _ (userString findTokens: Character cr) collect:[:each| each withBlanksTrimmed]. userList _ userList reject:[:any| any isEmpty]. (userList first = '##user list##') ifFalse:[^nil]. userList _ userList copyFrom: 2 to: userList size. ^userList! !