'From Squeak3.1alpha of 4 February 2001 [latest update: #3530] on 6 February 2001 at 7:25:59 pm'! "Change Set: SecurityTweaks-ar Date: 6 February 2001 Author: Andreas Raab Makes CodeLoader go through the same mechanisms as the project loader and moves some duplicate code into SecurityManager (removing it from Project and CodeLoader's code)."! !CodeLoader methodsFor: 'installing' stamp: 'ar 2/6/2001 19:11'! 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 respondsTo: #close) ifTrue:[contentStream close]. ^self error:'Insecure content encountered: ', reqEntry key printString]]. contents _ contentStream upToEnd unzipped. (contentStream respondsTo: #close) ifTrue:[contentStream close]. ^(RWBinaryOrTextStream with: contents) reset fileInObjectAndCode install.! ! !CodeLoader methodsFor: 'installing' stamp: 'ar 2/6/2001 19:13'! 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 respondsTo: #close) ifTrue:[aStream close]. ^self error:'Insecure content encountered']]. contents _ aStream upToEnd unzipped. (aStream respondsTo: #close) ifTrue:[aStream close]. ^(RWBinaryOrTextStream with: contents) reset fileIn! ! !CodeLoader class methodsFor: 'utilities' stamp: 'ar 2/6/2001 19:22'! 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 splitName: destFile to:[:path :file| SecurityManager default signFile: file directory: (FileDirectory on: path). ]. ! ! !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. ! ! !Project methodsFor: 'file in/out' stamp: 'ar 2/6/2001 19:17'! storeOnServerInnards "Save to disk as an Export Segment. Then put that file on the server I came from, as a new version. Version is literal piece of file name. Mime encoded and http encoded." | servers resp newName primaryServerDirectory serverVersionPair localDirectory localVersionPair myVersionNumber warning maxNumber | self assureIntegerVersion. "Find out what version" (servers _ self serverList) ifNil: [ (primaryServerDirectory _ self findAFolderToStoreProjectIn) ifNotNil: [ servers _ Array with: primaryServerDirectory. self storeNewPrimaryURL: primaryServerDirectory realUrl, '/'. ]. ] ifNotNil: [ primaryServerDirectory _ servers first. ]. localDirectory _ self squeakletDirectory. serverVersionPair _ self class mostRecent: self name onServer: primaryServerDirectory. localVersionPair _ self class mostRecent: self name onServer: localDirectory. maxNumber _ myVersionNumber _ self currentVersionNumber. ProgressNotification signal: '2:versionsDetected'. warning _ ''. myVersionNumber < serverVersionPair second ifTrue: [ warning _ warning,'\There are newer version(s) on the server'. maxNumber _ maxNumber max: serverVersionPair second. ]. myVersionNumber < localVersionPair second ifTrue: [ warning _ warning,'\There are newer version(s) in the local directory'. maxNumber _ maxNumber max: localVersionPair second. ]. "8 Nov 2000 - only check on the first attempt to publish" myVersionNumber = 0 ifTrue: [ warning isEmpty ifFalse: [ myVersionNumber = 0 ifTrue: [ warning _ warning,'\THIS PROJECT HAS NEVER BEEN SAVED' ]. warning _ 'WARNING', '\Project: ',self name,warning. resp _ (PopUpMenu labels: 'Store anyway\Cancel' withCRs) startUpWithCaption: (warning, '\Please cancel, rename this project, and see what is there.') withCRs. resp ~= 1 ifTrue: [^ nil] ]. ]. version _ self bumpVersion: maxNumber. "write locally - now zipped automatically" newName _ self versionedFileName. lastSavedAtSeconds _ Time totalSeconds. self exportSegmentFileName: newName directory: localDirectory. SecurityManager default signFile: newName directory: localDirectory. ProgressNotification signal: '4:localSaveComplete'. "3 is deep in export logic" primaryServerDirectory ifNotNil: [ self writeFileNamed: newName fromDirectory: localDirectory toServer: primaryServerDirectory. ]. ProgressNotification signal: '9999 save complete'. "Later, store with same name on secondary servers. Still can be race conditions. All machines will go through the server list in the same order." "2 to: servers size do: [:aServer | aServer putFile: local named: newName]." ! ! !ProjectLoading class methodsFor: 'as yet unclassified' stamp: 'ar 2/6/2001 19:12'! openFromFile: preStream fromDirectory: aDirectoryOrNil withProjectView: existingView "Reconstitute a Morph from the selected file, presumed to be represent a Morph saved via the SmartRefStream mechanism, and open it in an appropriate Morphic world." | morphOrList proj trusted | ProgressNotification signal: '2:fileSizeDetermined ',preStream size printString. trusted _ SecurityManager default positionToSecureContentsOf: preStream. trusted ifFalse:[(SecurityManager default enterRestrictedMode) ifFalse:[ (preStream respondsTo: #close) ifTrue:[preStream close]. ^self]]. morphOrList _ preStream asUnZippedStream. preStream sleep. "if ftp, let the connection close" ProgressNotification signal: '3:unzipped'. morphOrList _ morphOrList fileInObjectAndCode. ProgressNotification signal: '4:filedIn'. ProgressNotification signal: '9999 about to enter project'. "the hard part is over" (morphOrList isKindOf: ImageSegment) ifTrue: [ proj _ morphOrList arrayOfRoots detect: [:mm | mm class == Project] ifNone: [^self inform: 'No project found in this file']. proj versionFrom: preStream. proj lastDirectory: aDirectoryOrNil. CurrentProjectRefactoring currentBeParentTo: proj. existingView ifNil: [ Smalltalk isMorphic ifTrue: [ proj createViewIfAppropriate. ] ifFalse: [ ProjectView openAndEnter: proj. "Note: in MVC we get no further than the above" ]. ] ifNotNil: [ (existingView project isKindOf: DiskProxy) ifFalse: [ existingView project changeSet name: ChangeSet defaultName ]. "proj changeSet name: otherProjectName." "<<< why would we need this?" (existingView owner isKindOf: SystemWindow) ifTrue: [ existingView owner model: proj ]. existingView project: proj. ]. ^ ProjectEntryNotification signal: proj ]. (morphOrList isKindOf: SqueakPage) ifTrue: [ morphOrList _ morphOrList contentsMorph ]. (morphOrList isKindOf: PasteUpMorph) ifFalse: [ ^ self inform: 'This is not a PasteUpMorph or exported Project.' ]. (Project newMorphicOn: morphOrList) enter ! ! !SecurityManager methodsFor: 'security operations' stamp: 'ar 2/6/2001 19:13'! enterRestrictedMode "Some insecure contents was encountered. Close all doors and proceed." self isInRestrictedMode ifTrue:[^true]. Preferences securityChecksEnabled ifFalse:[^true]. "it's been your choice..." Preferences warnAboutInsecureContent ifTrue:[ (PopUpMenu confirm: 'You are about to load some insecure content. If you continue, access to files as well as some other capabilities will be limited.' trueChoice:'Load it anyways' falseChoice:'Do not load it') ifFalse:[ "user doesn't really want it" ^false. ]. ]. "here goes the actual restriction" self flushSecurityKeys. self disableFileAccess. self disableImageWrite. "self disableSocketAccess." ^true ! ! !SecurityManager methodsFor: 'security operations' stamp: 'ar 2/6/2001 19:09'! positionToSecureContentsOf: aStream | bytes trusted part1 part2 sig hash dsa okay pos | aStream binary. bytes _ aStream next: 4. pos _ aStream position. bytes = 'SPRJ' asByteArray ifFalse:[ "was not signed" aStream position: pos. ^false]. part1 _ aStream nextInto: (LargePositiveInteger basicNew: 20). part2 _ aStream nextInto: (LargePositiveInteger basicNew: 20). sig _ Array with: part1 with: part2. hash _ SecureHashAlgorithm new hashStream: aStream. dsa _ DigitalSignatureAlgorithm new. trusted _ self trustedKeys. okay _ (trusted detect:[:key| dsa verifySignature: sig ofMessageHash: hash publicKey: key] ifNone:[nil]) notNil. aStream position: pos+44. ^okay! ! !SecurityManager methodsFor: 'security operations' stamp: 'ar 2/6/2001 19:16'! signFile: fileName directory: fileDirectory "Sign the given project in the directory" | bytes file dsa hash sig key | Preferences signProjectFiles ifFalse:[^self]. "signing turned off" key _ self signingKey. key ifNil:[^self]. file _ FileStream readOnlyFileNamed: (fileDirectory fullNameFor: fileName). bytes _ file binary; contentsOfEntireFile. fileDirectory deleteFileNamed: fileName ifAbsent:[]. dsa _ DigitalSignatureAlgorithm new. dsa initRandom: Time millisecondClockValue + Date today julianDayNumber. hash _ SecureHashAlgorithm new hashStream: (ReadStream on: bytes). sig _ dsa computeSignatureForMessageHash: hash privateKey: key. file _ FileStream newFileNamed: (fileDirectory fullNameFor: fileName). file binary. "store a header identifying the signed file first" file nextPutAll: 'SPRJ' asByteArray. "now the signature" file nextPutAll: sig first; nextPutAll: sig last. "now the contents" file nextPutAll: bytes. file close.! ! ProjectLoading class removeSelector: #positionToSecureContentsOf:! Project removeSelector: #signProject:directory:! CodeLoader removeSelector: #positionedToSecuredContentsOf:!