'From Squeak5.3alpha of 26 September 2019 [latest update: #18993] on 27 September 2019 at 6:57:21 am'!
Object subclass: #CodeLoader
	instanceVariableNames: 'baseURL sourceFiles segments publicKey'
	classVariableNames: 'DefaultBaseURL DefaultKey'
	poolDictionaries: ''
	category: 'System-Download'!
!CodeLoader commentStamp: 'hjh 4/22/2010 12:58' prior: 0!
CodeLoader provides a simple facility for loading code from the network.

CodeLoader has a very specific purpose, primarily for loading Etoys projects. It is not meant to be used for anything else. Use Installer for general purposes.

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: 'initialize-release' stamp: 'mir 1/11/2000 13:47'!
initialize
	publicKey := DefaultKey.
	baseURL := self class defaultBaseURL! !


!CodeLoader methodsFor: 'installing' stamp: 'tak 9/4/2006 14:50'!
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 openOn: aStream! !

!CodeLoader methodsFor: 'installing' stamp: 'nice 7/18/2014 01:23'!
installSegment: reqEntry
	"Install the previously loaded segment"
	| contentStream contents trusted |
	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 upToEnd unzipped asString.
	(contentStream respondsTo: #close) ifTrue:[contentStream close].
	^(RWBinaryOrTextStream with: contents) reset fileInObjectAndCode install.! !

!CodeLoader methodsFor: 'installing' stamp: 'dtl 5/5/2019 18:57'!
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 := self allButShebangLine: aStream upToEnd unzipped asString.
	(aStream respondsTo: #close) ifTrue:[aStream close].
	^contents readStream fileIn! !


!CodeLoader methodsFor: 'loading' stamp: 'nice 12/27/2009 02:54'!
loadSegments: anArray
	"Load all the source files in the given array."
	| loader |
	loader := HTTPLoader default.
	segments := anArray collect:[:name |
		| reqName request |
		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: 'nice 12/26/2009 09:50'!
loadSourceFiles: anArray
	"Load all the source files in the given array."
	| loader |
	loader := HTTPLoader default.
	sourceFiles := anArray collect: [:name |
		self createRequestFor: name in: loader]! !


!CodeLoader methodsFor: 'private' stamp: 'dtl 5/6/2019 21:14'!
allButShebangLine: contentsString
	"If contentsString begins with '#!!' then assume that it contains a Unix
	shebang line should be skipped prior to evaluating the contents."
	
	(contentsString beginsWith: '#!!')
		ifTrue: [contentsString lineIndicesDo: [:line :end :endOfLine |
			^ contentsString allButFirst: endOfLine ]]
		ifFalse: [^ contentsString]

	" CodeLoader new allButShebangLine:
'#!!/usr/llocal/bin/squeak --
Transcript cr; show: ''Hello world!!''
' "! !

!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: '*SqueakRosCore' 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: '*SqueakRosCore' stamp: 'edc 9/17/2009 18:24'!
installMonticelloFor: aList 
	"Install the previously loaded source files"
	aList
		do: [:packName | self lookMonticelloVersion: packName].
	sourceFiles := nil! !

!CodeLoader methodsFor: '*SqueakRosCore' stamp: 'edc 4/13/2017 07:41'!
installSegments
	"Install the previously loaded segments"
	"We should understand segments, no get rid of them"
	segments == nil ifTrue:[^self].
	segments do:[:req| self installSegment: req].
	segments := nil.! !

!CodeLoader methodsFor: '*SqueakRosCore' stamp: 'edc 10/12/2010 08:12'!
installSourceFiles
| packName pos |
	"Install the previously loaded source files"
	sourceFiles == nil
		ifTrue: [^ self].
	sourceFiles
		do: [:req | (req url endsWith: '.mcz')
				ifTrue: [
					pos := req url lastIndexOf: $/.
					packName := req url copyFrom: pos + 1 to: req url size.
					self tryVersion: packName ].
				(req url endsWith: '.sar')
				ifTrue: [ SARInstaller new fileInFrom: req contentStream].
				(req url endsWith: '.cs') |(req url endsWith: 'st')
				ifTrue: [self installSourceFile: req contentStream]].
	sourceFiles := nil! !

!CodeLoader methodsFor: '*SqueakRosCore' stamp: 'edc 3/28/2011 09:21'!
lookLastVersion: packageName 
	| mcw montiNames package version |
	mcw := MCWorkingCopyBrowser new
				repository: (MCHttpRepository
						location: baseURL
						user: 'squeak'
						password: 'squeak').
	mcw repository
		ifNotNilDo: [:repos | montiNames := repos versionNamesForPackageNamed: packageName].
	package := montiNames detectMax: [ : pkg |  
				pkg versionNumber ] .
	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: '*SqueakRosCore' stamp: 'edc 12/12/2009 07:13'!
lookMonticelloVersion: packageName 
	| mcw montiNames package version pN |
	pN := packageName , '.mcz'.
	mcw := MCWorkingCopyBrowser new
				repository: (MCHttpRepository
						location: baseURL
						user: 'squeak'
						password: 'squeak').
	mcw repository
		ifNotNilDo: [:repos | montiNames := repos readableFileNames].
	package := montiNames
				detect: [:any | any = pN]
				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: '*SqueakRosCore' 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: '*SqueakRosCore' stamp: 'edc 7/2/2008 10:37'!
segments
^ segments! !

!CodeLoader methodsFor: '*SqueakRosCore' 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: 'utilities' stamp: 'mir 9/6/2000 15:03'!
compressFileNamed: aFileName
	self compressFileNamed: aFileName in: FileDirectory default! !

!CodeLoader class methodsFor: 'utilities' stamp: 'ul 6/17/2011 12:25'!
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
		displayProgressFrom: 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: 'nice 12/26/2009 09:50'!
exportCategories: catList to: aFileName
	"CodeLoader exportCategories: #( 'Game-Animation' 'Game-Framework' ) to: 'Game-Framework'"

	| classList |
	classList := OrderedCollection new.
	catList do: [:catName |
		| list |
		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: 'eem 7/3/2017 15:05'!
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 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 allSymbols.

	oldMethods := OrderedCollection new: classList size * 150.
	newMethods := OrderedCollection new: classList size * 150.
	keepSources
		ifTrue: [
			classList do: [:cl |
				cl selectorsAndMethodsDo:
					[:selector :m |
					| oldCodeString methodNode |
					m fileIndex > 0 ifTrue:
						[oldCodeString := cl sourceCodeAt: selector.
						methodNode := cl newCompiler
											parse: oldCodeString in: cl notifying: nil.
						oldMethods addLast: m.
						newMethods addLast: (m copyWithTempsFromMethodNode: methodNode)]]]].
	oldMethods asArray elementsExchangeIdentityWith: newMethods asArray.
	oldMethods := newMethods := nil.

	Smalltalk garbageCollect.
	is := ImageSegment 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: 'ul 6/17/2011 12:25'!
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...' 
		displayProgressFrom: 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.

! !
