From b36532a2eba07ed11eb9f501cc9afd7673ef10c5 Mon Sep 17 00:00:00 2001
From: Christoph Thiede <christoph.thiede@student.hpi.de>
Date: Fri, 3 Jan 2025 02:23:27 +0100
Subject: [PATCH] add restrictive pragmatic sandbox
---
...context.activateMethod.withArgs.receiver.do..st | 4 +++-
.../PragmaticSandbox.class/methodProperties.json | 2 +-
.../RestrictivePragmaticSandbox.class/README.md | 1 +
.../instance/doMorphOpenInWorld.context..st | 5 +++++
.../instance/doObjectInspect.perform.context..st | 5 +++++
.../doToolSetBrowse.perform.args.context..st | 6 ++++++
.../instance/pragmatic.forbidden..st | 5 +++++
.../instance/pragmaticForbidden..st | 4 ++++
.../methodProperties.json | 9 +++++++++
.../properties.json | 14 ++++++++++++++
10 files changed, 53 insertions(+), 2 deletions(-)
create mode 100644 packages/SimulationStudio-Sandbox.package/RestrictivePragmaticSandbox.class/README.md
create mode 100644 packages/SimulationStudio-Sandbox.package/RestrictivePragmaticSandbox.class/instance/doMorphOpenInWorld.context..st
create mode 100644 packages/SimulationStudio-Sandbox.package/RestrictivePragmaticSandbox.class/instance/doObjectInspect.perform.context..st
create mode 100644 packages/SimulationStudio-Sandbox.package/RestrictivePragmaticSandbox.class/instance/doToolSetBrowse.perform.args.context..st
create mode 100644 packages/SimulationStudio-Sandbox.package/RestrictivePragmaticSandbox.class/instance/pragmatic.forbidden..st
create mode 100644 packages/SimulationStudio-Sandbox.package/RestrictivePragmaticSandbox.class/instance/pragmaticForbidden..st
create mode 100644 packages/SimulationStudio-Sandbox.package/RestrictivePragmaticSandbox.class/methodProperties.json
create mode 100644 packages/SimulationStudio-Sandbox.package/RestrictivePragmaticSandbox.class/properties.json
diff --git a/packages/SimulationStudio-Sandbox.package/PragmaticSandbox.class/instance/context.activateMethod.withArgs.receiver.do..st b/packages/SimulationStudio-Sandbox.package/PragmaticSandbox.class/instance/context.activateMethod.withArgs.receiver.do..st
index 6be91dd..4506f5a 100644
--- a/packages/SimulationStudio-Sandbox.package/PragmaticSandbox.class/instance/context.activateMethod.withArgs.receiver.do..st
+++ b/packages/SimulationStudio-Sandbox.package/PragmaticSandbox.class/instance/context.activateMethod.withArgs.receiver.do..st
@@ -26,4 +26,6 @@ context: aContext activateMethod: aCompiledMethod withArgs: arguments receiver:
self perform: selector withArguments: args]
on: Error do:
[^ super context: aContext activateMethod: aCompiledMethod withArgs: arguments receiver: receiver do: aBlock].
- ^ aContext push: result
\ No newline at end of file
+ ^ (aContext isPrimFailToken: result)
+ ifTrue: [result second value]
+ ifFalse: [aContext push: result]
\ No newline at end of file
diff --git a/packages/SimulationStudio-Sandbox.package/PragmaticSandbox.class/methodProperties.json b/packages/SimulationStudio-Sandbox.package/PragmaticSandbox.class/methodProperties.json
index 407d836..ccc1f5d 100644
--- a/packages/SimulationStudio-Sandbox.package/PragmaticSandbox.class/methodProperties.json
+++ b/packages/SimulationStudio-Sandbox.package/PragmaticSandbox.class/methodProperties.json
@@ -11,7 +11,7 @@
"addPragmaticMultiMethodsTo:" : "ct 1/3/2025 01:37",
"assertUnmodifiedObject:" : "ct 1/2/2025 04:50",
"basicEvaluate:" : "ct 12/29/2024 06:20",
- "context:activateMethod:withArgs:receiver:do:" : "ct 1/1/2025 20:35",
+ "context:activateMethod:withArgs:receiver:do:" : "ct 1/3/2025 01:30",
"context:doPrimitive:method:receiver:args:do:" : "ct 12/29/2024 04:56",
"doCompiledMethodPreamble:" : "ct 1/2/2025 22:56",
"doDateAndTime:perform:context:" : "ct 1/2/2025 04:49",
diff --git a/packages/SimulationStudio-Sandbox.package/RestrictivePragmaticSandbox.class/README.md b/packages/SimulationStudio-Sandbox.package/RestrictivePragmaticSandbox.class/README.md
new file mode 100644
index 0000000..1b3ec55
--- /dev/null
+++ b/packages/SimulationStudio-Sandbox.package/RestrictivePragmaticSandbox.class/README.md
@@ -0,0 +1 @@
+I am a more restrictive version of the pragmatic sandbox. I explicitly disallow common headful operations that should typically not be done in headless environments.
\ No newline at end of file
diff --git a/packages/SimulationStudio-Sandbox.package/RestrictivePragmaticSandbox.class/instance/doMorphOpenInWorld.context..st b/packages/SimulationStudio-Sandbox.package/RestrictivePragmaticSandbox.class/instance/doMorphOpenInWorld.context..st
new file mode 100644
index 0000000..88e1e74
--- /dev/null
+++ b/packages/SimulationStudio-Sandbox.package/RestrictivePragmaticSandbox.class/instance/doMorphOpenInWorld.context..st
@@ -0,0 +1,5 @@
+pragmatic methods - Morph
+doMorphOpenInWorld: aMorph context: aContext
+ <pragmaticClass: #Morph selector: #openInWorld>
+
+ ^ self pragmatic: aContext forbidden: 'Use #imageForm instead'
\ No newline at end of file
diff --git a/packages/SimulationStudio-Sandbox.package/RestrictivePragmaticSandbox.class/instance/doObjectInspect.perform.context..st b/packages/SimulationStudio-Sandbox.package/RestrictivePragmaticSandbox.class/instance/doObjectInspect.perform.context..st
new file mode 100644
index 0000000..ed2559d
--- /dev/null
+++ b/packages/SimulationStudio-Sandbox.package/RestrictivePragmaticSandbox.class/instance/doObjectInspect.perform.context..st
@@ -0,0 +1,5 @@
+pragmatic methods - Object
+doObjectInspect: aMorph perform: selector context: aContext
+ <pragmaticClass: #Object selectors: #(inspect explore)>
+
+ ^ self pragmatic: aContext forbidden: 'Use #longPrintString instead'
\ No newline at end of file
diff --git a/packages/SimulationStudio-Sandbox.package/RestrictivePragmaticSandbox.class/instance/doToolSetBrowse.perform.args.context..st b/packages/SimulationStudio-Sandbox.package/RestrictivePragmaticSandbox.class/instance/doToolSetBrowse.perform.args.context..st
new file mode 100644
index 0000000..5c5d04b
--- /dev/null
+++ b/packages/SimulationStudio-Sandbox.package/RestrictivePragmaticSandbox.class/instance/doToolSetBrowse.perform.args.context..st
@@ -0,0 +1,6 @@
+pragmatic methods - ToolSet
+doToolSetBrowse: aToolSetClass perform: selector args: args context: aContext
+ <pragmaticClass: #'ToolSet class'>
+
+ self assert: (selector beginsWithAnyOf: #(browse open handle inspect)).
+ ^ self pragmatic: aContext forbidden: 'Don''t use ToolSet in headless context'
\ No newline at end of file
diff --git a/packages/SimulationStudio-Sandbox.package/RestrictivePragmaticSandbox.class/instance/pragmatic.forbidden..st b/packages/SimulationStudio-Sandbox.package/RestrictivePragmaticSandbox.class/instance/pragmatic.forbidden..st
new file mode 100644
index 0000000..fa85914
--- /dev/null
+++ b/packages/SimulationStudio-Sandbox.package/RestrictivePragmaticSandbox.class/instance/pragmatic.forbidden..st
@@ -0,0 +1,5 @@
+private
+pragmatic: aContext forbidden: messageText
+
+ ^ self nextSimulator context: aContext primitiveFailTokenFor:
+ [self nextSimulator context: aContext activateOperationForbidden: messageText]
\ No newline at end of file
diff --git a/packages/SimulationStudio-Sandbox.package/RestrictivePragmaticSandbox.class/instance/pragmaticForbidden..st b/packages/SimulationStudio-Sandbox.package/RestrictivePragmaticSandbox.class/instance/pragmaticForbidden..st
new file mode 100644
index 0000000..eade0e8
--- /dev/null
+++ b/packages/SimulationStudio-Sandbox.package/RestrictivePragmaticSandbox.class/instance/pragmaticForbidden..st
@@ -0,0 +1,4 @@
+private
+pragmaticForbidden: aContext
+
+ ^ self pragmatic: aContext forbidden: 'Operation forbidden'
\ No newline at end of file
diff --git a/packages/SimulationStudio-Sandbox.package/RestrictivePragmaticSandbox.class/methodProperties.json b/packages/SimulationStudio-Sandbox.package/RestrictivePragmaticSandbox.class/methodProperties.json
new file mode 100644
index 0000000..48f5572
--- /dev/null
+++ b/packages/SimulationStudio-Sandbox.package/RestrictivePragmaticSandbox.class/methodProperties.json
@@ -0,0 +1,9 @@
+{
+ "class" : {
+ },
+ "instance" : {
+ "doMorphOpenInWorld:context:" : "ct 1/3/2025 01:32",
+ "doObjectInspect:perform:context:" : "ct 1/3/2025 01:32",
+ "doToolSetBrowse:perform:args:context:" : "ct 1/3/2025 01:35",
+ "pragmatic:forbidden:" : "ct 1/3/2025 01:31",
+ "pragmaticForbidden:" : "ct 1/3/2025 01:27" } }
diff --git a/packages/SimulationStudio-Sandbox.package/RestrictivePragmaticSandbox.class/properties.json b/packages/SimulationStudio-Sandbox.package/RestrictivePragmaticSandbox.class/properties.json
new file mode 100644
index 0000000..0b2feaa
--- /dev/null
+++ b/packages/SimulationStudio-Sandbox.package/RestrictivePragmaticSandbox.class/properties.json
@@ -0,0 +1,14 @@
+{
+ "category" : "SimulationStudio-Sandbox",
+ "classinstvars" : [
+ ],
+ "classvars" : [
+ ],
+ "commentStamp" : "ct 1/3/2025 02:22",
+ "instvars" : [
+ ],
+ "name" : "RestrictivePragmaticSandbox",
+ "pools" : [
+ ],
+ "super" : "PragmaticSandbox",
+ "type" : "normal" }