[Pkg] Monticello Public: System-PasswordManager-kph.1.mcz

squeak-dev-noreply at lists.squeakfoundation.org squeak-dev-noreply at lists.squeakfoundation.org
Sun Mar 22 21:18:08 UTC 2009


A new version of System-PasswordManager was added to project Monticello Public:
http://www.squeaksource.com/mc/System-PasswordManager-kph.1.mcz

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

Name: System-PasswordManager-kph.1
Author: kph
Time: 22 March 2009, 9:11:18 pm
UUID: d6b34653-b9cb-40b3-af09-889c302ff02f
Ancestors: 

extracted from MC

==================== Snapshot ====================

SystemOrganization addCategory: #'System-PasswordManager'!

Object subclass: #PasswordManager
	instanceVariableNames: 'directory'
	classVariableNames: 'Default'
	poolDictionaries: ''
	category: 'System-PasswordManager'!

!PasswordManager commentStamp: '<historical>' prior: 0!
Simple password manager to avoid storing passwords in the image.!

----- Method: PasswordManager class>>default (in category 'accessing') -----
default
	^Default ifNil:[Default := self new]!

----- Method: PasswordManager class>>editPasswords (in category 'accessing') -----
editPasswords
	^self default editPasswords!

----- Method: PasswordManager class>>passwordAt:user: (in category 'accessing') -----
passwordAt: location user: user
	^self default passwordAt: location user: user!

----- Method: PasswordManager class>>passwordAt:user:put: (in category 'accessing') -----
passwordAt: location user: user put: password
	^self default passwordAt: location user: user put: password!

----- Method: PasswordManager class>>queryPasswordAt:user: (in category 'accessing') -----
queryPasswordAt: location user: user
	^self default queryPasswordAt: location user: user!

----- Method: PasswordManager>>directory (in category 'accessing') -----
directory
	"Answer the directory in which to find the passwords"
	^directory ifNil:[ExternalSettings assuredPreferenceDirectory]!

----- Method: PasswordManager>>directory: (in category 'accessing') -----
directory: aDirectory
	"Indicate the directory in which to find the passwords"
	directory := aDirectory!

----- Method: PasswordManager>>editPasswords (in category 'editing') -----
editPasswords
	"Edit the passwords"
	(self directory fileNamesMatching: '*.pwd') do:[:fName|
		self editPasswordsIn: (self directory fullNameFor: fName).
	].!

----- Method: PasswordManager>>editPasswordsIn: (in category 'editing') -----
editPasswordsIn: pwdFile
	"Edit the passwords"
	| file data |
	file := FileStream readOnlyFileNamed: pwdFile.
	data := file contents.
	file close.
	UIManager default edit: data label: pwdFile accept:[:text|
		file := FileStream forceNewFileNamed: pwdFile.
		file nextPutAll: text asString.
		file close.
	].

!

----- Method: PasswordManager>>passwordAt:user: (in category 'queries') -----
passwordAt: location user: user
	"Answer the password stored under the given key, or nil if none can be found"
	| file stream tokens pwdFile |
	(location indexOf: Character space) = 0 
		ifFalse:[^self error: 'Location must not contain spaces'].
	(user indexOf: Character space) = 0 
		ifFalse:[^self error: 'User name must not contain spaces'].
	pwdFile := user,'.pwd'.
	file := [self directory readOnlyFileNamed: pwdFile] on: Error do:[:ex| ex return: nil].
	file ifNil:[^nil].
	[stream := file contents readStream] ensure:[file close].
	[stream atEnd] whileFalse:[
		tokens := stream nextLine findTokens: ' '.
		(tokens size = 2 and:[tokens first match: location]) ifTrue:[
			^(Base64MimeConverter mimeDecode: tokens last as: String)
		].
	].
	^nil!

----- Method: PasswordManager>>passwordAt:user:put: (in category 'queries') -----
passwordAt: location user: user put: password
	"Store the password under the given key"
	| file tokens pwd in out done sz pwdFile |
	user ifNil:[ ^ self ].
	(location indexOf: Character space) = 0 
		ifFalse:[^self error: 'Key must not contain spaces'].
	(user indexOf: Character space) = 0 
		ifFalse:[^self error: 'Key must not contain spaces'].
	password ifNotNil:[
		pwd := (Base64MimeConverter mimeEncode: password readStream) contents.
	].
	pwdFile := user,'.pwd'.
	file := [self directory readOnlyFileNamed: pwdFile] on: Error do:[:ex| ex return: nil].
	file ifNotNil:[
		[in := file contents readStream] ensure:[file close].
	] ifNil:[in := String new readStream].
	out := WriteStream on: (String new: 1000).

	done := pwd == nil. "if clearing passwords, we're done already"
	[in atEnd] whileFalse:[
		tokens := in nextLine findTokens: ' '.
		tokens size = 2 ifTrue:[
			(tokens first match: location) 
				ifTrue:[pwd ifNotNil:[out nextPutAll: location; space; nextPutAll: pwd; cr. done := true]]
				ifFalse:[out nextPutAll: tokens first; space; nextPutAll: tokens last; cr]]].
	done ifFalse:[out nextPutAll: location; space; nextPutAll: pwd; cr].

	file := [self directory forceNewFileNamed: pwdFile] on: Error do:[:ex| ex return: nil].
	file ifNil:[^nil].
	[file nextPutAll: out contents.
	sz := file size] ensure:[file close].
	sz = 0 ifTrue:[self directory deleteFileNamed: pwdFile ifAbsent:[]].
!

----- Method: PasswordManager>>queryPasswordAt:user: (in category 'queries') -----
queryPasswordAt: location user: user
	"Answer the password for the given user/location. 
	If the password is absent, query the user if interactive."
	| pwd |
	"search for existing password"
 
	pwd := self passwordAt: location user: user.
	pwd ifNotNil:[^pwd].

	pwd := FillInTheBlank requestPassword: 'Password for "', user, '" at ', location.
	pwd isEmptyOrNil ifTrue:[^nil].
	(self confirm: 'Remember password for "', user, '" at ', location,'?') ifTrue:[
		self passwordAt: location user: user put: pwd.
	].
	^pwd
	
 !



More information about the Packages mailing list