Skip to content

Commit

Permalink
add pragmatic sandbox
Browse files Browse the repository at this point in the history
  • Loading branch information
LinqLover committed Jan 2, 2025
1 parent 7d0e27a commit c87d62f
Show file tree
Hide file tree
Showing 60 changed files with 508 additions and 4 deletions.
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
I choose a more pragmatic approach to sandboxing by using an allow-list of methods that are executed outside of the sandbox. This makes practical assumptions about not changing certain objects to improve the performance for certain queries significantly until the sandboxed code modifies these objects. In some cases, my pre-checks might be too weak, and side effects of the sandboxed code might not be visible to the sandboxed code itself.
Original file line number Diff line number Diff line change
@@ -0,0 +1,9 @@
evaluating
evaluate: aBlock
"Evaluate aBlock in a new sandbox instance and answer the result, isolating it from the rest of the image.
Example:
PragmaticSandbox evaluate: [World extent: 0 @ 0; bounds].
"

^ super evaluate: aBlock
Original file line number Diff line number Diff line change
@@ -0,0 +1,11 @@
evaluating
evaluate: aBlock ifFailed: failBlock
"Evaluate aBlock in a new sandbox instance and answer the result, isolating it from the rest of the image. If aBlock signals a failure, evaluate failBlock with that failure.
Example:
PragmaticSandbox evaluate: [1 / 0] ifFailed: [:ex | Transcript showln: ex description].
"

^ self new
evaluate: aBlock
ifFailed: failBlock
Original file line number Diff line number Diff line change
@@ -0,0 +1,15 @@
evaluating
evaluate: aBlock on: exceptionHandler do: exceptionBlock
"Evaluate aBlock in a new sandbox instance and answer the result, isolating it from the rest of the image. If aBlock signals an exception that can handled by the exceptionHandler, evaluate exceptionBlock with it. NOTE: Unhandled errors raised by aBlock will bubble up along the sender stack, but still, all handling is simulated in the sandbox until the exception will have been resumed. Depending on the configuration of the sandbox and your image, this can mean that even the eventual pop-up of the debugger will be simulated and thus invisible to you! Thus make sure to pass all relevant exceptions with this message.
Example:
PragmaticSandbox evaluate: [1 / 0] on: ZeroDivide do: [:ex | Transcript showln: ex description].
""Use with CAUTION and check your image via the ProcessBrowser afterwards""
PragmaticSandbox evaluate: [self halt] on: ZeroDivide do: [:ex | Transcript showln: ex description].
"

^ self new
evaluate: aBlock
on: exceptionHandler
do: exceptionBlock
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
instance creation
fromMemory: aSandboxMemory

^ self new importMemory: aSandboxMemory
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
sandbox
addObject: anObject

^ self nextSimulator addObject: anObject
Original file line number Diff line number Diff line change
@@ -0,0 +1,15 @@
initialize-release
addPragmaticClassesTo: pragmaticClasses

(Pragma allNamed: #pragmaticClass: from: self class to: thisContext methodClass)
do: [:pragma |
| className|
className := pragma argumentAt: 1.
(Smalltalk classNamed: className)
ifNil: [self warn: ('pragmatic class not found: {1}' format: {className})]
ifNotNil: [:class |
pragmaticClasses
at: class
ifPresent: [self warn: ('pragmatic class overridden: {1}' format: {class})];
at: class
put: pragma selector]].
Original file line number Diff line number Diff line change
@@ -0,0 +1,20 @@
initialize-release
addPragmaticMethodsTo: pragmaticMethods

(Pragma allNamed: #pragmaticClass:selector: from: self class to: thisContext methodClass)
do: [:pragma |
| className|
className := pragma argumentAt: 1.
(Smalltalk classNamed: className)
ifNil: [self warn: ('pragmatic method class not found: {1}' format: {className})]
ifNotNil: [:class |
| selector |
selector := pragma argumentAt: 2.
class >> selector
ifNil: [self warn: ('pragmatic method not found: {1}>>{2}' format: {class. selector})]
ifNotNil: [:method |
pragmaticMethods
at: method
ifPresent: [self warn: ('pragmatic method overridden: {1}' format: {method})];
at: method
put: pragma selector]]].
Original file line number Diff line number Diff line change
@@ -0,0 +1,21 @@
initialize-release
addPragmaticMultiMethodsTo: pragmaticMethods

(Pragma allNamed: #pragmaticClass:selectors: from: self class to: thisContext methodClass)
do: [:pragma |
| className|
className := pragma argumentAt: 1.
(Smalltalk classNamed: className)
ifNil: [self warn: ('pragmatic method class not found: {1}' format: {className})]
ifNotNil: [:class |
| selectors |
selectors := pragma argumentAt: 2.
selectors do: [:selector |
class >> selector
ifNil: [self warn: ('pragmatic method not found: {1}>>{2}' format: {class. selector})]
ifNotNil: [:method |
pragmaticMethods
at: method
ifPresent: [self warn: ('pragmatic method overridden: {1}' format: {method})];
at: method
put: {pragma selector}]]]].
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
private
assertUnmodifiedObject: anObject

self assert: (self nextSimulator hasModifiedObject: anObject) not.
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
sandbox
basicEvaluate: aBlock
"Evaluate aBlock in a the receiver, isolating it from the rest of the image, and answer the result as it is seen from the global perspective.
PRIVATE! Does not care about any exceptions that are signaled during the simulation, causing them to be handled still inside the sandbox, even if an exception handler has been defined outside of the sandbox stack. Depending on the configuration of the sandbox and your image, this can mean that even the eventual pop-up of the debugger will be simulated and thus invisible to you! Usually, it is a better idea to use the public #evaluate: protocol instead."

^ super evaluate: aBlock
Original file line number Diff line number Diff line change
@@ -0,0 +1,29 @@
controlling
context: aContext activateMethod: aCompiledMethod withArgs: arguments receiver: receiver do: aBlock

| args result selector |
selector := pragmaticMethods at: aCompiledMethod ifAbsent: nil.
selector ifNil:
[selector := pragmaticClasses at: aCompiledMethod methodClass ifAbsent: nil.
selector ifNotNil: [selector := {selector}]].

selector ifNil:
[^ super context: aContext activateMethod: aCompiledMethod withArgs: arguments receiver: receiver do: aBlock].

args := {receiver}.
selector isArray
ifTrue:
[selector := selector first.
args := args copyWith: aCompiledMethod selector.
args size < selector numArgs ifTrue:
[args := args copyWith: arguments]]
ifFalse:
[args := args , arguments].
args size < selector numArgs ifTrue:
[args := args copyWith: aContext].
result :=
[self assert: ((aContext objectClass: receiver) includesBehavior: aCompiledMethod methodClass).
self perform: selector withArguments: args]
on: Error do:
[^ super context: aContext activateMethod: aCompiledMethod withArgs: arguments receiver: receiver do: aBlock].
^ aContext push: result
Original file line number Diff line number Diff line change
@@ -0,0 +1,9 @@
controlling
context: aContext doPrimitive: primitiveIndex method: aCompiledMethod receiver: receiver args: arguments do: aBlock

primitiveIndex
caseOf:
{[101 "primitiveBeCursor"] -> [^ aContext push: receiver "ignore"]}
otherwise: [].

^ super context: aContext doPrimitive: primitiveIndex method: aCompiledMethod receiver: receiver args: arguments do: aBlock
Original file line number Diff line number Diff line change
@@ -0,0 +1,8 @@
pragmatic methods - CompiledMethod
doCompiledMethodPreamble: aCompiledMethod
<pragmaticClass: #CompiledMethod selector: #preamble>

self assertUnmodifiedObject: aCompiledMethod.
self assertUnmodifiedObject: aCompiledMethod trailer.

^ aCompiledMethod preamble
Original file line number Diff line number Diff line change
@@ -0,0 +1,7 @@
pragmatic methods - DateAndTime
doDateAndTime: aDateAndTime perform: selector context: aContext
<pragmaticClass: #DateAndTime selectors: #(day month year)>

self assertUnmodifiedObject: aDateAndTime.

^ aDateAndTime perform: selector
Original file line number Diff line number Diff line change
@@ -0,0 +1,8 @@
pragmatic methods - Environment
doEnvironmentAllClasses: anEnvironment context: aContext
<pragmaticClass: #Environment selector: #allClasses>

self assertUnmodifiedObject: anEnvironment.
self assertUnmodifiedObject: (anEnvironment instVarNamed: 'declarations').

^ anEnvironment allClasses
Original file line number Diff line number Diff line change
@@ -0,0 +1,8 @@
pragmatic methods - Environment
doEnvironmentClassNames: anEnvironment context: aContext
<pragmaticClass: #Environment selector: #classNames>

self assertUnmodifiedObject: anEnvironment.
self assertUnmodifiedObject: (anEnvironment instVarNamed: 'declarations').

^ anEnvironment classNames
Original file line number Diff line number Diff line change
@@ -0,0 +1,13 @@
pragmatic methods - Form
doFormAsDataUrl: aForm context: aContext
<pragmaticClass: #Form selector: #asDataUrl>

self assertUnmodifiedObject: aForm.
self assert: (aContext objectClass: aForm width) = SmallInteger.
self assert: (aContext objectClass: aForm height) = SmallInteger.
self assert: (aContext objectClass: aForm depth) = SmallInteger.
self assert: ((aContext objectClass: aForm bits) = Bitmap).
self assertUnmodifiedObject: aForm bits.
self assert: ((aContext objectClass: aForm offset) = Point).

^ aForm asDataUrl
Original file line number Diff line number Diff line change
@@ -0,0 +1,7 @@
pragmatic methods - RemoteString
doRemoteStringText: aRemoteString
<pragmaticClass: #RemoteString selector: #text>

self assertUnmodifiedObject: aRemoteString.

^ aRemoteString text
Original file line number Diff line number Diff line change
@@ -0,0 +1,9 @@
pragmatic methods - String
doString: aString includesSubstring: anotherString context: aContext
<pragmaticClass: #String selector: #includesSubstring:>

self assertUnmodifiedObject: aString.
self assert: ((aContext objectClass: anotherString) includesBehavior: String).
self assertUnmodifiedObject: anotherString.

^ aString includesSubstring: anotherString
Original file line number Diff line number Diff line change
@@ -0,0 +1,7 @@
pragmatic methods - String
doStringAsLowercase: aString
<pragmaticClass: #String selector: #asLowercase>

self assertUnmodifiedObject: aString.

^ aString asLowercase
Original file line number Diff line number Diff line change
@@ -0,0 +1,13 @@
pragmatic methods - Symbol
doSymbolClass: aSymbolClass selectorsMatching: aStringPattern context: aContext
<pragmaticClass: #'Symbol class' selector: #selectorsMatching:>

self assertUnmodifiedObject: aSymbolClass.
self assertUnmodifiedObject: (aSymbolClass classPool at: #NewSymbols).
self assertUnmodifiedObject: (aSymbolClass classPool at: #NewSymbols) array.
self assertUnmodifiedObject: (aSymbolClass classPool at: #SymbolTable).
self assertUnmodifiedObject: (aSymbolClass classPool at: #SymbolTable) array.
self assert: ((aContext objectClass: aStringPattern) includesBehavior: String).
self assertUnmodifiedObject: aStringPattern.

^ Symbol selectorsMatching: aStringPattern
Original file line number Diff line number Diff line change
@@ -0,0 +1,11 @@
pragmatic methods - SystemNavigation
doSystemNavigation: aSystemNavigation perform: selector withArgs: arguments context: aContext
<pragmaticClass: #SystemNavigation selectors: #(allImplementorsOf: allCallsOn:)>

self assert: aSystemNavigation == SystemNavigation default.
self assertUnmodifiedObject: aSystemNavigation.
self flag: #imprecise. "only works correctly if *no* class changes were made in the system"
self assert: ((aContext objectClass: arguments first) includesBehavior: Symbol).
self assertUnmodifiedObject: arguments first.

^ aSystemNavigation perform: selector withArguments: arguments
Original file line number Diff line number Diff line change
@@ -0,0 +1,8 @@
pragmatic methods - TalkConversation
doTalkConversation: aTalkConversation perform: selector
<pragmaticClass: #TalkConversation selectors: #(latestDate latestMessage messages)>

self assertUnmodifiedObject: aTalkConversation.
self flag: #imprecise. "only works correctly if talk messages, mail objects, and sqh wrappers are unchanged"

^ aTalkConversation perform: selector
Original file line number Diff line number Diff line change
@@ -0,0 +1,8 @@
pragmatic methods - TalkInbox
doTalkInbox: aTalkInbox perform: selector
<pragmaticClass: #TalkInbox selectors: #(conversations contributions messages mostRecentConversations)>

self assertUnmodifiedObject: aTalkInbox.
self flag: #imprecise. "only works correctly if talk messages, mail objects, and sqh wrappers are unchanged"

^ aTalkInbox perform: selector
Original file line number Diff line number Diff line change
@@ -0,0 +1,10 @@
pragmatic methods - TalkInbox
doTalkInboxClass: aTalkInboxClass perform: selector
<pragmaticClass: #'TalkInbox class'>

self assertUnmodifiedObject: aTalkInboxClass.
self assertUnmodifiedObject: aTalkInboxClass methodDict.
self flag: #imprecise.
self assert: (aTalkInboxClass wellKnownInboxPragmas anySatisfy: [:pragma | pragma selector = selector]).

^ aTalkInboxClass perform: selector
Original file line number Diff line number Diff line change
@@ -0,0 +1,8 @@
pragmatic methods - TalkMailObject
doTalkMailObjectDate: aMailObject
<pragmaticClass: #TalkMailObject selector: #date>

self assertUnmodifiedObject: aMailObject.
self flag: #imprecise.

^ aMailObject date
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
pragmatic methods - WebClient
doWebClientDefaultUserAgent: aWebClient
<pragmaticClass: #WebClient selector: #defaultUserAgent>

^ aWebClient defaultUserAgent
Original file line number Diff line number Diff line change
@@ -0,0 +1,14 @@
sandbox
evaluate: aBlock
"Evaluate aBlock in a the receiver and answer the result, isolating it from the rest of the image.
Example:
PragmaticSandbox evaluate: [World extent: 0 @ 0; bounds].
"

^ self
evaluate: aBlock
ifFailed: [:ex | SandboxError new
messageText: 'Exception from simulated code: ' , ex;
tag: ex;
signal]
Original file line number Diff line number Diff line change
@@ -0,0 +1,12 @@
sandbox
evaluate: aBlock ifFailed: failBlock
"Evaluate aBlock in a the receiver and answer the result, isolating it from the rest of the image. If aBlock signals a failure, evaluate failBlock with that failure.
Example:
PragmaticSandbox evaluate: [1 / 0] ifFailed: [:ex | Transcript showln: ex description].
"

^ self
evaluate: aBlock
on: Error, Warning, Halt
do: failBlock
Original file line number Diff line number Diff line change
@@ -0,0 +1,19 @@
sandbox
evaluate: aBlock on: exceptionHandler do: exceptionBlock
"Evaluate aBlock in the receiver, isolating it from the rest of the image. If aBlock signals an exception that can handled by the exceptionHandler, evaluate exceptionBlock with it. NOTE: Unhandled errors raised by aBlock will bubble up along the sender stack, but still, all handling is simulated in the sandbox until the exception will have been resumed. Depending on the configuration of the sandbox and your image, this can mean that even the pop-up of the eventual debugger will be simulated and thus invisible to you! Thus make sure to pass all relevant exceptions with this message.
Example:
PragmaticSandbox evaluate: [1 / 0] on: ZeroDivide do: [:ex | Transcript showln: ex description].
""Use with CAUTION and check your image via the ProcessBrowser afterwards""
PragmaticSandbox evaluate: [self halt] on: ZeroDivide do: [:ex | Transcript showln: ex description].
"

| result exception |
self basicEvaluate: [[result := aBlock value]
on: exceptionHandler
do: [:ex | exception := ex]].

(self basicEvaluate: [exception]) ifNotNil: [:ex | ^ exceptionBlock cull: ex].

^ self readableObjectFor: (self basicEvaluate: [result])
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
sandbox
exportMemory

^ self nextSimulator exportMemory
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
sandbox
importMemory: memory

self nextSimulator importMemory: memory.
Loading

0 comments on commit c87d62f

Please sign in to comment.