On 4/22/10 2:00 AM, "Andreas Raab" <andreas.raab at gmx.de> wrote:

> Hi -
> 
> I just wanted to point out that I think the idea below is a *brilliant*
> interim solution for our current lack of a decent package loader. At the
> very least, we can give people starting points on how to load certain
> packages. I've added instructions on how to load Installer, Omnibrowser
> and Refactory Engine. Can someone knowledgable perhaps extend this to
> cover Seaside (hopefully both 2.8 and 3.0) as well? Perhaps Magma, too?
> 
> BTW, if you edit the workspace, there's a "trick" to it. You should
> enable syntax highlighting so that the contents is properly styled when
> you accept the method. This requires an updated trunk image since I've
> fixed a few issues there.
> 
> (I also think we should bring this workspace in particular into 4.1)
> 
> Cheers,
>    - Andreas

See SqueakLight3, use my modified CodeLoader .
Again I post here 

Example of loading my HV
| loader |
    loader := CodeLoader new.
    loader baseURL: 'http://www.squeaksource.com/Ladrillos/'.
    loader installLastMonticelloFor:  #('DynamicBindings'  'KomServices'
'KomHttpServer' 'HTML' ' Network-HTML' ).


Polish a bit and we don't need any more...

Edgar 

-------------- next part --------------
'From Squeak3.11alpha of 13 February 2010 [latest update: #9592] on 22 April 2010 at 7:17:55 am'!
Object subclass: #CodeLoader
	instanceVariableNames: 'baseURL sourceFiles segments publicKey'
	classVariableNames: 'DefaultBaseURL DefaultKey'
	poolDictionaries: ''
	category: 'System-Download'!
!CodeLoader commentStamp: 'nice 3/25/2010 22:59' prior: 0!
CodeLoader provides a simple facility for loading code from the network.

Examples:
	| loader |
	loader := CodeLoader new.
	loader baseURL:'http://isgwww.cs.uni-magdeburg.de/~raab/test/'.
	loader localCache: #('.cache' 'source').
	"Sources and segments can be loaded in parallel"
	loader loadSourceFiles: #('file1.st' 'file2.st.gz').
	loader localCache: #('.cache' 'segments').
	loader loadSegments: #('is1.extseg' 'is2.extseg.gz').
	"Install sources first - will wait until the files are actually loaded"
	loader installSourceFiles.
	"And then the segments"
	loader installSegments.!


!CodeLoader methodsFor: 'accessing' stamp: 'ar 12/13/1999 18:19'!
baseURL
	^baseURL! !

!CodeLoader methodsFor: 'accessing' stamp: 'ar 12/13/1999 18:19'!
baseURL: aString
	baseURL _ aString.! !

!CodeLoader methodsFor: 'accessing' stamp: 'ar 12/22/1999 15:07'!
publicKey
	^publicKey! !

!CodeLoader methodsFor: 'accessing' stamp: 'ar 12/22/1999 15:07'!
publicKey: aPublicKey
	publicKey _ aPublicKey! !

!CodeLoader methodsFor: 'accessing' stamp: 'edc 7/2/2008 10:37'!
segments
^ segments! !


!CodeLoader methodsFor: 'initialize-release' stamp: 'mir 1/11/2000 13:47'!
initialize
	publicKey _ DefaultKey.
	baseURL _ self class defaultBaseURL! !


!CodeLoader methodsFor: 'installing' stamp: 'edc 12/24/2008 08:15'!
installLastMonticelloFor: aList
	"Install the previously loaded source files"

	aList
		do: [:packName | 
			
					self lookLastVersion: packName].
	sourceFiles := nil! !

!CodeLoader methodsFor: 'installing' stamp: 'RAA 2/19/2001 08:23'!
installProject
	"Assume that we're loading a single file and it's a project"
	| aStream |
	aStream _ sourceFiles first contentStream.
	aStream ifNil:[^self error:'Project was not loaded'].
	ProjectLoading
			openName: nil 		"<--do we want to cache this locally? Need a name if so"
			stream: aStream
			fromDirectory: nil
			withProjectView: nil.
! !

!CodeLoader methodsFor: 'installing' stamp: 'edc 7/2/2008 10:16'!
installSegment: reqEntry
	"Install the previously loaded segment"
	| contentStream contents trusted inputStream |
	contentStream _ reqEntry value contentStream.
	contentStream ifNil:[^self error:'No content to install: ', reqEntry key printString].
	trusted _ SecurityManager default positionToSecureContentsOf: contentStream.
	trusted ifFalse:[(SecurityManager default enterRestrictedMode) ifFalse:[
		contentStream close.
		^self error:'Insecure content encountered: ', reqEntry key printString]].
	contents _ contentStream ascii upToEnd unzipped.
	(contentStream respondsTo: #close) ifTrue:[contentStream close].
	inputStream := (MultiByteBinaryOrTextStream with: contents) reset .
	inputStream setConverterForCode.
(inputStream fileInObjectAndCode ) inspect! !

!CodeLoader methodsFor: 'installing' stamp: 'mir 1/20/2000 13:37'!
installSegments
	"Install the previously loaded segments"
	segments == nil ifTrue:[^self].
	segments do:[:req| self installSegment: req].
	segments _ nil.! !

!CodeLoader methodsFor: 'installing' stamp: 'sd 1/30/2004 15:16'!
installSourceFile: aStream
	"Install the previously loaded source file"
	| contents trusted |
	aStream ifNil:[^self error:'No content to install'].
	trusted _ SecurityManager default positionToSecureContentsOf: aStream.
	trusted ifFalse:[(SecurityManager default enterRestrictedMode) 
					ifFalse:[ aStream close.
							^ self error:'Insecure content encountered']].
	contents _ aStream ascii upToEnd unzipped.
	(aStream respondsTo: #close) ifTrue:[aStream close].
	^(RWBinaryOrTextStream with: contents) reset fileIn! !

!CodeLoader methodsFor: 'installing' stamp: 'edc 3/6/2010 19:12'!
installSourceFiles
	"Install the previously loaded source files"
	| aSuffix | 
	sourceFiles == nil
		ifTrue: [^ self].
	sourceFiles
		do: [:req | aSuffix :=  (req url  findTokens: '.') last..
			aSuffix caseOf: {
			[ 'mcz'] -> [MczInstaller installStream: req contentStream].
				['sar'] ->[ SARInstaller new fileInFrom: req contentStream]}
				otherwise: [self installSourceFile: req contentStream]].
	sourceFiles := nil! !

!CodeLoader methodsFor: 'installing' stamp: 'edc 12/24/2008 10:26'!
lookLastVersion: packageName 
	| mcw montiNames package version |
	mcw := MCWorkingCopyBrowser new
				repository: (MCHttpRepository
						location: baseURL
						user: 'squeak'
						password: 'squeak').
	mcw repository
		ifNotNilDo: [:repos | montiNames := repos readableFileNames].
	package := montiNames
				detect: [:any | any beginsWith: packageName]
				ifNone: [].
	package
		ifNotNil: [Utilities
				informUser: 'Installing ' , packageName printString
				during: [version := mcw repository loadVersionFromFileNamed: package.
					version load]].
	MCPackageManager
		managersForCategory: packageName
		do: [:wc | wc repositoryGroup
				addRepository: (MCHttpRepository new location: baseURL)]! !

!CodeLoader methodsFor: 'installing' stamp: 'edc 7/2/2008 10:27'!
readObject: reqEntry
	"Install the previously loaded segment"
	| contentStream contents trusted inputStream |
	contentStream _ reqEntry value contentStream.
	contentStream ifNil:[^self error:'No content to install: ', reqEntry key printString].
	trusted _ SecurityManager default positionToSecureContentsOf: contentStream.
	trusted ifFalse:[(SecurityManager default enterRestrictedMode) ifFalse:[
		contentStream close.
		^self error:'Insecure content encountered: ', reqEntry key printString]].
	contents _ contentStream ascii upToEnd unzipped.
	(contentStream respondsTo: #close) ifTrue:[contentStream close].
	inputStream := (MultiByteBinaryOrTextStream with: contents) reset .
	inputStream setConverterForCode.
^(inputStream fileInObjectAndCode ) ! !


!CodeLoader methodsFor: 'loading' stamp: 'mir 10/13/2000 12:24'!
loadSegments: anArray
	"Load all the source files in the given array."
	| loader request reqName |
	loader _ HTTPLoader default.
	segments _ anArray collect:[:name |
		reqName _ (FileDirectory extensionFor: name) isEmpty
			ifTrue: [FileDirectory fileName: name extension: ImageSegment compressedFileExtension]
			ifFalse: [name].
		request _ self createRequestFor: reqName in: loader.
		name->request].
! !

!CodeLoader methodsFor: 'loading' stamp: 'ar 12/14/1999 14:40'!
loadSourceFiles: anArray
	"Load all the source files in the given array."
	| loader request |
	loader _ HTTPLoader default.
	sourceFiles _ anArray collect:[:name|
		request _ self createRequestFor: name in: loader.
		request].
! !


!CodeLoader methodsFor: 'private' stamp: 'mir 2/2/2001 14:44'!
createRequestFor: name in: aLoader
	"Create a URL request for the given string, which can be cached locally."
	| request |
	request _ HTTPLoader httpRequestClass for: self baseURL , name in: aLoader.
	aLoader addRequest: request. "fetch from URL"
	^request! !

!CodeLoader methodsFor: 'private' stamp: 'avi 4/30/2004 01:40'!
httpRequestClass
	^HTTPDownloadRequest! !


!CodeLoader methodsFor: 'debugging' stamp: 'edc 7/10/2008 06:09'!
tryVersion: packageName 
| mcw montiNames package version |

mcw := MCWorkingCopyBrowser new repository: (MCHttpRepository
				location: baseURL
				user: ''
				password: '').
mcw repository ifNotNilDo: [:repos | montiNames := repos readableFileNames ].
	
	
	
	package := (montiNames detect:[:ea| ea beginsWith: packageName] ifNone:[] ) .
	package ifNotNil: [MCWorkingCopy allManagers do: [:each | 
		each  repositoryGroup
			addRepository: (MCHttpRepository new location: baseURL)]..
	version := mcw repository loadVersionFromFileNamed: package.
	version load].
^version! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

CodeLoader class
	instanceVariableNames: ''!

!CodeLoader class methodsFor: 'accessing' stamp: 'mir 1/11/2000 13:45'!
defaultBaseURL
	^DefaultBaseURL ifNil: ['']! !

!CodeLoader class methodsFor: 'accessing' stamp: 'mir 1/11/2000 13:45'!
defaultBaseURL: aURLString
	DefaultBaseURL _ aURLString! !

!CodeLoader class methodsFor: 'accessing' stamp: 'ar 12/22/1999 15:08'!
defaultKey
	"Return the default key used for verifying signatures of loaded code"
	^DefaultKey! !

!CodeLoader class methodsFor: 'accessing' stamp: 'mir 1/10/2000 18:16'!
defaultKey: aPublicKey
	"Store the default key used for verifying signatures of loaded code"
	DefaultKey _ aPublicKey
	"CodeLoader defaultKey: DOLPublicKey"
	"CodeLoader defaultKey: (DigitalSignatureAlgorithm testKeySet at: 2)"! !

!CodeLoader class methodsFor: 'accessing' stamp: 'edc 8/16/2008 17:34'!
tryHttpURL: aHttpURL
| loader pos baseUrl packName wName mcc  lista |

loader := self new.
pos := aHttpURL printString lastPositionOf: $/.
	baseUrl := aHttpURL printString  copyFrom: 1 to: pos.
	loader baseURL: baseUrl.
	packName :=  aHttpURL printString  copyFrom: pos + 1 to: aHttpURL printString size.
Transcript show: packName;cr.

wName :=  packName copyUpToLast: $..
(UGlobalInstaller unwantedPackages includes: wName) ifTrue:[Transcript show: 'Avoid loading';cr.
	^self].
mcc := MCWorkingCopyBrowser new.
mcc  repository: MCCacheRepository default.
lista := mcc workingCopies select:
		[:wc |
		 wc ancestors notEmpty] thenCollect: [:ea| ea ancestry ancestors first  name].
(lista includes: wName) ifTrue:[Transcript show: 'Was loaded';cr.
	^self].
	loader loadSourceFiles: (Array with: packName).
	
	(packName endsWith: '.sar') ifTrue:[^loader installSourceFiles].
	loader tryVersion: packName! !


!CodeLoader class methodsFor: 'utilities' stamp: 'mir 9/6/2000 15:03'!
compressFileNamed: aFileName
	self compressFileNamed: aFileName in: FileDirectory default! !

!CodeLoader class methodsFor: 'utilities' stamp: 'mir 10/13/2000 13:27'!
compressFileNamed: aFileName in: aDirectory
	"Compress the currently selected file"
	| zipped buffer unzipped zipFileName |
	unzipped _ aDirectory readOnlyFileNamed: (aDirectory fullNameFor: aFileName).
	unzipped binary.
	zipFileName _ aFileName copyUpToLast: $. .
	zipped _ aDirectory newFileNamed: (zipFileName, FileDirectory dot, ImageSegment compressedFileExtension).
	zipped binary.
	zipped _ GZipWriteStream on: zipped.
	buffer _ ByteArray new: 50000.
	'Compressing ', zipFileName displayProgressAt: Sensor cursorPoint
		from: 0 to: unzipped size
		during:[:bar|
			[unzipped atEnd] whileFalse:[
				bar value: unzipped position.
				zipped nextPutAll: (unzipped nextInto: buffer)].
			zipped close.
			unzipped close].
! !

!CodeLoader class methodsFor: 'utilities' stamp: 'mir 1/18/2000 16:22'!
exportCategories: catList to: aFileName
	"CodeLoader exportCategories: #( 'Game-Animation' 'Game-Framework' ) to: 'Game-Framework'"

	| list classList |
	classList _ OrderedCollection new.
	catList do: [:catName |
		list _ SystemOrganization listAtCategoryNamed: catName asSymbol.
		list do: [:nm | classList add: (Smalltalk at: nm); add: (Smalltalk at: nm) class]].
	self exportCodeSegment: aFileName classes: classList keepSource: true! !

!CodeLoader class methodsFor: 'utilities' stamp: 'mir 1/18/2000 20:53'!
exportCategoryNamed: catName
	"CodeLoader exportCategoryNamed: 'OceanicPanic' "

	| list |
	list _ SystemOrganization listAtCategoryNamed: catName asSymbol.
	self exportClassesNamed: list to: catName! !

!CodeLoader class methodsFor: 'utilities' stamp: 'mir 1/18/2000 20:53'!
exportClassesNamed: classNameList to: aFileName

	| classList |
	classList _ OrderedCollection new.
	classNameList do: [:nm | classList add: (Smalltalk at: nm); add: (Smalltalk at: nm) class].
	self exportCodeSegment: aFileName classes: classList keepSource: true! !

!CodeLoader class methodsFor: 'utilities' stamp: 'mir 10/11/2000 19:12'!
exportCodeSegment: exportName classes: aClassList keepSource: keepSources

	"Code for writing out a specific category of classes as an external image segment.  Perhaps this should be a method."

	| is oldMethods newMethods m oldCodeString argsAndTemps classList symbolHolder fileName |
	keepSources
		ifTrue: [
			self confirm: 'We are going to abandon sources.
Quit without saving after this has run.' orCancel: [^self]].

	classList _ aClassList asArray.

	"Strong pointers to symbols"
	symbolHolder := Symbol allInstances.

	oldMethods _ OrderedCollection new: classList size * 150.
	newMethods _ OrderedCollection new: classList size * 150.
	keepSources
		ifTrue: [
			classList do: [:cl |
				cl selectors do:
					[:selector |
					m _ cl compiledMethodAt: selector.
					m fileIndex > 0 ifTrue:
						[oldCodeString _ cl sourceCodeAt: selector.
						argsAndTemps _ (cl compilerClass new
							parse: oldCodeString in: cl notifying: nil) tempNames.
						oldMethods addLast: m.
						newMethods addLast: (m copyWithTempNames: argsAndTemps)]]]].
	oldMethods asArray elementsExchangeIdentityWith: newMethods asArray.
	oldMethods _ newMethods _ m _ oldCodeString _ argsAndTemps _ nil.

	Smalltalk garbageCollect.
	is _ ImageSegment new copyFromRootsForExport: classList.	"Classes and MetaClasses"

	fileName _ FileDirectory fileName: exportName extension: ImageSegment fileExtension.
	is writeForExport: fileName.
	self compressFileNamed: fileName

! !

!CodeLoader class methodsFor: 'utilities' stamp: 'mir 10/12/2000 17:39'!
loadCode: codeSegmentName from: baseURL ifClassNotLoaded: testClass

	CodeLoader defaultBaseURL: baseURL.
	(Smalltalk includesKey: testClass)
		ifFalse: [CodeLoader loadCodeSegment: codeSegmentName].
! !

!CodeLoader class methodsFor: 'utilities' stamp: 'mir 2/2/2001 14:56'!
loadCodeSegment: segmentName
	| loader |
	loader _ self new.
	loader loadSegments: (Array with: segmentName). 
	loader installSegments.! !

!CodeLoader class methodsFor: 'utilities' stamp: 'asm 12/6/2002 08:11'!
signFile: fileName renameAs: destFile key: privateKey dsa: dsa
	"Sign the given file using the private key."
	| in out |
	in _ FileStream readOnlyFileNamed: fileName.	in binary.
	out _ FileStream newFileNamed: destFile.			out binary.
	[in atEnd] whileFalse:[out nextPutAll: (in next: 4096)].
	in close.	out close.
	FileDirectory activeDirectoryClass splitName: destFile to:[:path :file|
		SecurityManager default signFile: file directory: (FileDirectory on: path).
	].
! !

!CodeLoader class methodsFor: 'utilities' stamp: 'mir 2/14/2000 16:47'!
signFiles: fileNames in: dirName key: privateKey
	"Sign the files in the current directory and put them into a folder signed."

	|  newNames oldNames |
	oldNames _ fileNames collect:[:fileName | dirName , FileDirectory slash, fileName].
	newNames _ fileNames collect:[:fileName | dirName , FileDirectory slash, 'signed', FileDirectory slash, fileName].
	CodeLoader
		signFilesFrom: oldNames
		to: newNames
		key: privateKey! !

!CodeLoader class methodsFor: 'utilities' stamp: 'mir 1/18/2000 18:49'!
signFiles: fileNames key: privateKey
	"Sign the files in the current directory and put them into a folder signed."

	|  newNames |
	newNames _ fileNames collect:[:fileName | 'signed', FileDirectory slash, fileName].
	CodeLoader
		signFilesFrom: fileNames
		to: newNames
		key: privateKey! !

!CodeLoader class methodsFor: 'utilities' stamp: 'ads 7/31/2003 14:00'!
signFilesFrom: sourceNames to: destNames key: privateKey
	"Sign all the given files using the private key.
	This will add an 's' to the extension of the file."
	"| fd oldNames newNames |
	fd _ FileDirectory default directoryNamed:'unsigned'.
	oldNames _ fd fileNames.
	newNames _ oldNames collect:[:name| 'signed', FileDirectory slash, name].
	oldNames _ oldNames collect:[:name| 'unsigned', FileDirectory slash, name].
	CodeLoader
		signFilesFrom: oldNames
		to: newNames
		key: DOLPrivateKey."
	| dsa |
	dsa _ DigitalSignatureAlgorithm new.
	dsa initRandomNonInteractively.
	'Signing files...' displayProgressAt: Sensor cursorPoint
		from: 1 to: sourceNames size during:[:bar|
			1 to: sourceNames size do:[:i|
				bar value: i.
				self signFile: (sourceNames at: i) renameAs: (destNames at: i) key: privateKey dsa: dsa]].
! !

!CodeLoader class methodsFor: 'utilities' stamp: 'ar 2/6/2001 19:17'!
verifySignedFileNamed: aFileName
	"CodeLoader verifySignedFileNamed: 'signed\dummy1.dsq' "

	| secured signedFileStream |
	signedFileStream _ FileStream fileNamed: aFileName.
	secured _ SecurityManager default positionToSecureContentsOf: signedFileStream.
	signedFileStream close.
	Transcript show: aFileName , ' verified: '; show: secured printString; cr.

! !