'From Squeak3.1alpha of 4 February 2001 [latest update: #3528] on 6 February 2001 at 6:43:12 pm'! "Change Set: ProjSecurity Date: 3 February 2001 Author: Andreas Raab First pass on project security, signing and verification. The current default is to disable security checks up until the point where we have security aware VMs (hopefully soon)." Preferences addPreference: #signProjectFiles category: #security default: true balloonHelp: 'When true, projects will be signed before storing them on some server.'. Preferences addPreference: #warnAboutInsecureContent category: #security default: true balloonHelp: 'When true, show a warning when insecure content is encountered'. Preferences addPreference: #securityChecksEnabled category: #security default: false balloonHelp: 'When true, insecure content will make Squeak go into restricted mode. When false, all security mechanisms are turned off.'. Preferences addPreference: #automaticKeyGeneration category: #security default: false balloonHelp: 'When true, a key pair for signing projects is automatically generated on startup (only if no keys file is available).'. Preferences addPreference: #showSecurityStatus category: #security default: true balloonHelp: 'When true, a red border is drawn in the current project indicating that the system is in restricted mode.'. ! Object subclass: #SecurityManager instanceVariableNames: 'privateKeyPair trustedKeys keysFileName ' classVariableNames: 'Default ' poolDictionaries: '' category: 'System-Support'! !AutoStart class methodsFor: 'class initialization' stamp: 'ar 2/6/2001 17:12'! initialize "AutoStart initialize" Smalltalk addToStartUpList: AutoStart after: SecurityManager.! ! !DigitalSignatureAlgorithm methodsFor: 'initialization' stamp: 'ar 2/1/2001 20:18'! initRandomFromString: aString "Ask the user to type a long random string and use the result to seed the secure random number generator." | s k srcIndex | s _ aString. k _ LargePositiveInteger new: (s size min: 64). srcIndex _ 0. k digitLength to: 1 by: -1 do: [:i | k digitAt: i put: (s at: (srcIndex _ srcIndex + 1)) asciiValue]. k _ k + (Random new next * 16r7FFFFFFF) asInteger. "a few additional bits randomness" k highBit > 512 ifTrue: [k _ k bitShift: k highBit - 512]. self initRandom: k. ! ! !FileDirectory methodsFor: 'enumeration' stamp: 'ar 2/6/2001 15:48'! localName "Return the local name of this directory." ^FileDirectory localNameFor: pathName! ! !FileDirectory methodsFor: 'file directory' stamp: 'ar 2/6/2001 15:48'! assureExistance "Make sure the current directory exists. If necessary, create all parts inbetween" ^self containingDirectory assureExistanceOfPath: self localName! ! !FileDirectory methodsFor: 'file directory' stamp: 'ar 2/6/2001 15:50'! assureExistanceOfPath: localPath "Make sure the local directory exists. If necessary, create all parts inbetween" (self directoryNames includes: localPath) ifTrue:[^self]. "exists" "otherwise check parent first and then create local dir" self containingDirectory assureExistanceOfPath: self localName. self createDirectory: localPath.! ! !PasteUpMorph methodsFor: 'world state' stamp: 'ar 2/6/2001 16:39'! install owner _ nil. "since we may have been inside another world previously" submorphs do: [:ss | ss owner == nil ifTrue: [ss privateOwner: self]]. "Transcript that was in outPointers and then got deleted." self viewBox: Display boundingBox. Sensor eventQueue: SharedQueue new. worldState handsDo: [:h | h initForEvents]. self installFlaps. self borderWidth: 0. "default" (Preferences showSecurityStatus and:[SecurityManager default isInRestrictedMode]) ifTrue:[self borderWidth: 2; borderColor: Color red]. SystemWindow noteTopWindowIn: self. self displayWorldSafely. ! ! !Project methodsFor: 'file in/out' stamp: 'ar 2/6/2001 16:40'! signProject: newName directory: localDirectory "Sign the given project in the directory" | bytes file dsa hash sig key | Preferences signProjectFiles ifFalse:[^self]. "signing turned off" key _ SecurityManager default signingKey. key ifNil:[^self]. file _ FileStream readOnlyFileNamed: (localDirectory fullNameFor: newName). bytes _ file binary; contentsOfEntireFile. localDirectory deleteFileNamed: newName 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: (localDirectory fullNameFor: newName). file binary. "store a header identifying the signed project first" file nextPutAll: 'SPRJ' asByteArray. "now the signature" file nextPutAll: sig first; nextPutAll: sig last. "now the contents" file nextPutAll: bytes. file close.! ! !Project methodsFor: 'file in/out' stamp: 'ar 2/3/2001 14:39'! 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. self signProject: 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 17:48'! 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 _ self positionToSecureContentsOf: preStream. trusted ifFalse:[ (SecurityManager default enterRestrictedMode) ifFalse:[^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 ! ! !ProjectLoading class methodsFor: 'verification' stamp: 'ar 2/6/2001 16:42'! positionToSecureContentsOf: aStream | bytes trusted part1 part2 sig hash dsa okay | aStream binary. bytes _ aStream next: 4. bytes = 'SPRJ' asByteArray ifFalse:[ "was not signed" aStream position: 0. ^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 _ SecurityManager default trustedKeys. okay _ (trusted detect:[:key| dsa verifySignature: sig ofMessageHash: hash publicKey: key] ifNone:[nil]) notNil. aStream position: 44. ^okay! ! !SecurityManager methodsFor: 'initialize-release' stamp: 'ar 2/6/2001 16:24'! flushSecurityKey: aKey "Flush a security key" | n | n _ aKey first. 1 to: n basicSize do:[:i| n basicAt: i put: 0]. n _ aKey second. 1 to: n basicSize do:[:i| n basicAt: i put: 0]. ! ! !SecurityManager methodsFor: 'initialize-release' stamp: 'ar 2/6/2001 16:23'! flushSecurityKeys "Flush all keys" privateKeyPair ifNotNil:[ self flushSecurityKey: privateKeyPair first. self flushSecurityKey: privateKeyPair last. ]. privateKeyPair _ nil. trustedKeys do:[:key| self flushSecurityKey: key]. trustedKeys _ #().! ! !SecurityManager methodsFor: 'initialize-release' stamp: 'ar 2/6/2001 16:20'! initialize privateKeyPair _ nil. trustedKeys _ #(). keysFileName _ 'Squeak.keys'.! ! !SecurityManager methodsFor: 'initialize-release' stamp: 'ar 2/6/2001 16:22'! shutDown "Flush existing keys" self flushSecurityKeys.! ! !SecurityManager methodsFor: 'initialize-release' stamp: 'ar 2/6/2001 18:28'! startUp "Attempt to load existing keys" self loadSecurityKeys. (privateKeyPair == nil and:[self isInRestrictedMode not and:[Preferences automaticKeyGeneration]]) ifTrue:[ self generateKeyPairInBackground. ].! ! !SecurityManager methodsFor: 'accessing' stamp: 'ar 2/6/2001 16:19'! addTrustedKey: aPublicKey "Add a public key to the list of trusted keys" trustedKeys _ (trustedKeys copyWithout: aPublicKey) copyWith: aPublicKey.! ! !SecurityManager methodsFor: 'accessing' stamp: 'ar 2/6/2001 16:17'! keysFileName ^keysFileName! ! !SecurityManager methodsFor: 'accessing' stamp: 'ar 2/6/2001 16:17'! keysFileName: aFileName keysFileName _ aFileName! ! !SecurityManager methodsFor: 'accessing' stamp: 'ar 2/6/2001 18:33'! secureUserDirectory "SecurityManager default secureUserDirectory" "Primitive. Return the directory where we can securely store data that is not accessible in restricted mode." ^FileDirectory default pathName! ! !SecurityManager methodsFor: 'accessing' stamp: 'ar 2/6/2001 16:20'! signingKey "Return the key used for signing projects" ^privateKeyPair ifNotNil:[privateKeyPair first]! ! !SecurityManager methodsFor: 'accessing' stamp: 'ar 2/6/2001 16:42'! trustedKeys "Return an array of trusted public keys for verifying some project" privateKeyPair ifNil:[^trustedKeys]. ^{privateKeyPair second}, trustedKeys! ! !SecurityManager methodsFor: 'accessing' stamp: 'ar 2/6/2001 18:33'! untrustedUserDirectory "SecurityManager default untrustedUserDirectory" "Primitive. Return the untrusted user directory that is the root directory for files that are visible even in restricted mode." ^FileDirectory default pathName! ! !SecurityManager methodsFor: 'fileIn/out' stamp: 'ar 2/6/2001 18:29'! loadSecurityKeys "SecurityManager default loadSecurityKeys" "Load the keys file for the current user" | fd loc file keys | self isInRestrictedMode ifTrue:[^self]. "no point in even trying" loc _ self secureUserDirectory. "where to get it from" loc last = FileDirectory pathNameDelimiter ifFalse:[ loc _ loc copyWith: FileDirectory pathNameDelimiter. ]. fd _ FileDirectory on: loc. fd assureExistance. file _ [fd readOnlyFileNamed: keysFileName] on: FileDoesNotExistException do:[:ex| ex resume: nil]. file ifNil:[^self]. "no keys file" keys _ Object readFrom: file. privateKeyPair _ keys first. trustedKeys _ keys last. file close.! ! !SecurityManager methodsFor: 'fileIn/out' stamp: 'ar 2/6/2001 16:52'! storeSecurityKeys "SecurityManager default storeSecurityKeys" "Store the keys file for the current user" | fd loc file | self isInRestrictedMode ifTrue:[^self]. "no point in even trying" loc _ self secureUserDirectory. "where to put it" loc last = FileDirectory pathNameDelimiter ifFalse:[ loc _ loc copyWith: FileDirectory pathNameDelimiter. ]. fd _ FileDirectory on: loc. fd assureExistance. fd deleteFileNamed: self keysFileName ifAbsent:[]. file _ fd newFileNamed: self keysFileName. {privateKeyPair. trustedKeys} storeOn: file. file close.! ! !SecurityManager methodsFor: 'testing' stamp: 'ar 2/6/2001 16:14'! canWriteImage "SecurityManager default canWriteImage" "Primitive. Return true if the right to write an image hasn't been revoked." ^true "assume so unless otherwise proven"! ! !SecurityManager methodsFor: 'testing' stamp: 'ar 2/6/2001 16:16'! hasFileAccess "SecurityManager default hasFileAccess" "Return true if the right to access arbitrary files hasn't been revoked" ^true "assume so unless otherwise proven"! ! !SecurityManager methodsFor: 'testing' stamp: 'ar 2/6/2001 16:16'! hasSocketAccess "SecurityManager default hasSocketAccess" "Return true if the right to access sockets hasn't been revoked" ^true "assume so unless otherwise proven"! ! !SecurityManager methodsFor: 'testing' stamp: 'ar 2/6/2001 16:13'! isInRestrictedMode "Return true if we're in restricted mode" ^(self canWriteImage or:[self hasFileAccess "or:[self hasSocketAccess]"]) not! ! !SecurityManager methodsFor: 'security operations' stamp: 'ar 2/6/2001 16:14'! disableFileAccess "SecurityManager default disableFileAccess" "Primitive. Disable unlimited access to files. Cannot be revoked from the image." ^self primitiveFailed! ! !SecurityManager methodsFor: 'security operations' stamp: 'ar 2/6/2001 16:15'! disableImageWrite "SecurityManager default disableImageWrite" "Primitive. Disable writing to an image file. Cannot be revoked from the image." ^self primitiveFailed! ! !SecurityManager methodsFor: 'security operations' stamp: 'ar 2/6/2001 16:15'! disableSocketAccess "SecurityManage default disableSocketAccess" "Primitive. Disable access to sockets. Cannot be revoked from the image." ^self primitiveFailed! ! !SecurityManager methodsFor: 'security operations' stamp: 'ar 2/6/2001 18:06'! enterRestrictedMode "Some insecure contents was encountered. Close all doors and proceed." self isInRestrictedMode ifTrue:[^self]. 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: 'private' stamp: 'ar 2/6/2001 18:27'! generateKeyPairInBackground "SecurityManager default generateKeyPairInBackground" "Silently generate a key set on the local machine while running in the background." | d scheduler | d _ Delay forMilliseconds: 50. scheduler _ [d wait] forkAt: Processor userInterruptPriority. [self generateLocalKeyPair. scheduler terminate] fork.! ! !SecurityManager methodsFor: 'private' stamp: 'ar 2/6/2001 18:28'! generateLocalKeyPair "SecurityManager default generateLocalKeyPair" "Generate a key set on the local machine." | dsa | dsa _ DigitalSignatureAlgorithm new. dsa initRandomFromString: Time millisecondClockValue printString, Date today printString, Smalltalk platformName printString. privateKeyPair _ dsa generateKeySet. self storeSecurityKeys.! ! !SecurityManager class methodsFor: 'class initialization' stamp: 'ar 2/6/2001 17:12'! initialize "SecurityManager initialize" Default _ self new initialize. Smalltalk addToStartUpList: self. Smalltalk addToShutDownList: self.! ! !SecurityManager class methodsFor: 'class initialization' stamp: 'ar 2/6/2001 16:46'! shutDown self default shutDown.! ! !SecurityManager class methodsFor: 'class initialization' stamp: 'ar 2/6/2001 17:12'! startUp self default startUp.! ! !SecurityManager class methodsFor: 'accessing' stamp: 'ar 2/6/2001 16:21'! default ^Default ifNil:[Default _ self new initialize].! ! !SystemDictionary methodsFor: 'sources, change log' stamp: 'ar 2/6/2001 18:42'! forceChangesToDisk "Ensure that the changes file has been fully written to disk by closing and re-opening it. This makes the system more robust in the face of a power failure or hard-reboot." | changesFile | changesFile _ SourceFiles at: 2. (changesFile isKindOf: FileStream) ifTrue: [ changesFile flush. SecurityManager default hasFileAccess ifTrue:[ changesFile close. changesFile open: changesFile name forWrite: true]. changesFile setToEnd. ]. ! ! SystemDictionary removeSelector: #primitiveCanWriteImage! SystemDictionary removeSelector: #primitiveDisableFileAccess! SystemDictionary removeSelector: #primitiveDisableImageWrite! SystemDictionary removeSelector: #primitiveDisableSocketAccess! SystemDictionary removeSelector: #primitiveGetSecureUserDirectory! SystemDictionary removeSelector: #primitiveGetUntrustedUserDirectory! SystemDictionary removeSelector: #primitiveHasFileAccess! SystemDictionary removeSelector: #primitiveHasSocketAccess! SecurityManager initialize! AutoStart initialize!