From f74dc2b8c78bd373fc9d20e419b9fb5cb7a6d570 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Tue, 16 Dec 2008 20:29:17 +0000 Subject: [PATCH 1/5] Added `call-with-trusted-sandbox-configuration', and used in scribble and in tests. svn: r12871 --- collects/scheme/sandbox.ss | 13 ++++++++ collects/scribble/eval.ss | 15 ++++----- collects/scribblings/reference/sandbox.scrbl | 35 +++++++++++++++----- collects/tests/mzscheme/testing.ss | 15 ++++----- 4 files changed, 52 insertions(+), 26 deletions(-) diff --git a/collects/scheme/sandbox.ss b/collects/scheme/sandbox.ss index a1e2ab7191..5b2424e81f 100644 --- a/collects/scheme/sandbox.ss +++ b/collects/scheme/sandbox.ss @@ -25,6 +25,7 @@ sandbox-make-logger sandbox-memory-limit sandbox-eval-limits + call-with-trusted-sandbox-configuration evaluator-alive? kill-evaluator break-evaluator @@ -63,6 +64,18 @@ (define sandbox-propagate-breaks (make-parameter #t)) (define sandbox-coverage-enabled (make-parameter #f)) +(define (call-with-trusted-sandbox-configuration thunk) + (parameterize ([sandbox-propagate-breaks #t] + [sandbox-override-collection-paths '()] + [sandbox-security-guard current-security-guard] + [sandbox-exit-handler (current-exit-handler)] + [sandbox-make-inspector current-inspector] + [sandbox-make-code-inspector current-code-inspector] + [sandbox-make-logger current-logger] + [sandbox-memory-limit #f] + [sandbox-eval-limits #f]) + (thunk))) + (define sandbox-namespace-specs (make-parameter `(,(mz/mr make-base-namespace make-gui-namespace) #| no modules here by default |#))) diff --git a/collects/scribble/eval.ss b/collects/scribble/eval.ss index 5c2b193c2d..bfac65d473 100644 --- a/collects/scribble/eval.ss +++ b/collects/scribble/eval.ss @@ -239,19 +239,16 @@ [else stx])) (define (make-base-eval) - (parameterize ([sandbox-security-guard (current-security-guard)] - [sandbox-output 'string] - [sandbox-error-output 'string] - [sandbox-eval-limits #f] - [sandbox-memory-limit #f] - [sandbox-make-inspector current-inspector] - [sandbox-make-code-inspector current-code-inspector]) - (make-evaluator '(begin (require scheme/base))))) + (call-with-trusted-sandbox-configuration + (lambda () + (parameterize ([sandbox-output 'string] + [sandbox-error-output 'string]) + (make-evaluator '(begin (require scheme/base))))))) (define (close-eval e) (kill-evaluator e) "") - + (define (do-plain-eval ev s catching-exns?) (call-with-values (lambda () ((scribble-eval-handler) diff --git a/collects/scribblings/reference/sandbox.scrbl b/collects/scribblings/reference/sandbox.scrbl index ef33f7ffd4..a9ef74c6a3 100644 --- a/collects/scribblings/reference/sandbox.scrbl +++ b/collects/scribblings/reference/sandbox.scrbl @@ -16,12 +16,11 @@ The @schememodname[scheme/sandbox] module provides utilities for creating ``sandboxed'' evaluators, which are configured in a particular way and can have restricted resources (memory and time), -filesystem access, and network access. The common use case for this -module is for a restricted sandboxed environment, so the defaults are -set up to make it safe. For other uses you will likely need to change -mane of these settings. +filesystem and network access, and much. Sandboxed evaluators can be +configured through numerous parameters --- and the defaults are set +for the common use case where sandboxes are very limited. -@defproc*[([(make-evaluator [language (or/c module-path? +@defproc*[([(make-evaluator [language (or/c module-path? (list/c 'special symbol?) (cons/c 'begin list?))] [input-program any/c] ... @@ -260,9 +259,29 @@ either @scheme['time] or @scheme['memory].} @section{Customizing Evaluators} -The evaluators that @scheme[make-evaluator] creates can be customized -via several parameters. These parameters affect newly created -evaluators; changing them has no effect on already-running evaluators. +The sandboxed evaluators that @scheme[make-evaluator] creates can be +customized via many parameters. Most of the configuration parameters +affect newly created evaluators; changing them has no effect on +already-running evaluators. + +The default configuration options are set for a very restricted +sandboxed environment --- one that is safe to make publicly available. +Further customizations might be needed in case more privileges are +needed, or if you want tighter restrictions. Another useful approach +for customizing an evaluator is to begin with a relatively +unrestricted configuration and add the desired restrictions. This is +possible by the @scheme[call-with-trusted-sandbox-configuration] +function. + +@defproc[(call-with-trusted-sandbox-configuration [thunk (-> any)]) + any]{ + +Invokes the @scheme[thunk] in a context where sandbox configuration +parameters are set for minimal restrictions. More specifically, there +are no memory or time limits, and the existing existing inspectors, +security guard, exit handler, and logger are used. (Note that the I/O +ports settings are not included.)} + @defparam[sandbox-init-hook thunk (-> any)]{ diff --git a/collects/tests/mzscheme/testing.ss b/collects/tests/mzscheme/testing.ss index 9ba18ea5c5..cb60a31e5a 100644 --- a/collects/tests/mzscheme/testing.ss +++ b/collects/tests/mzscheme/testing.ss @@ -78,15 +78,12 @@ transcript. (define (load-in-sandbox file) (define-syntax-rule (S id) (dynamic-require 'scheme/sandbox 'id)) - (let ([e (parameterize ([(S sandbox-security-guard) (current-security-guard)] - [(S sandbox-input) current-input-port] - [(S sandbox-output) current-output-port] - [(S sandbox-error-output) current-error-port] - [(S sandbox-make-inspector) current-inspector] - [(S sandbox-make-code-inspector) current-code-inspector] - [(S sandbox-memory-limit) 100] ; 100mb per box - [(S sandbox-eval-limits) #f]) - ((S make-evaluator) '(begin) #:requires (list 'scheme)))]) + (let ([e ((S call-with-trusted-sandbox-configuration) + (parameterize ([(S sandbox-input) current-input-port] + [(S sandbox-output) current-output-port] + [(S sandbox-error-output) current-error-port] + [(S sandbox-memory-limit) 100]) ; 100mb per box + ((S make-evaluator) '(begin) #:requires (list 'scheme))))]) (e `(load-relative "testing.ss")) (e `(define real-error-port (quote ,real-error-port))) (e `(define Section-prefix ,Section-prefix)) From aa749bfe1f82fe0a145462435ca5a1772d7b0d21 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Tue, 16 Dec 2008 20:57:52 +0000 Subject: [PATCH 2/5] changed the memory limits in drscheme to match the new way they work svn: r12873 --- collects/drscheme/private/main.ss | 4 ++-- collects/drscheme/private/rep.ss | 6 +++--- collects/drscheme/private/unit.ss | 8 ++++---- collects/string-constants/english-string-constants.ss | 2 +- collects/string-constants/french-string-constants.ss | 2 +- collects/string-constants/german-string-constants.ss | 2 +- collects/string-constants/japanese-string-constants.ss | 2 +- .../simplified-chinese-string-constants.ss | 2 +- .../traditional-chinese-string-constants.ss | 2 +- 9 files changed, 15 insertions(+), 15 deletions(-) diff --git a/collects/drscheme/private/main.ss b/collects/drscheme/private/main.ss index f42f04ab56..5f766ce8f5 100644 --- a/collects/drscheme/private/main.ss +++ b/collects/drscheme/private/main.ss @@ -94,10 +94,10 @@ (number? (car x)) (number? (cdr x)))))) -(preferences:set-default 'drscheme:memory-limit (* 1024 1024 128) +(preferences:set-default 'drscheme:child-only-memory-limit (* 1024 1024 64) (λ (x) (or (boolean? x) (integer? x) - (x . >= . (* 1024 1024 100))))) + (x . >= . (* 1024 1024 1))))) (preferences:set-default 'drscheme:recent-language-names null diff --git a/collects/drscheme/private/rep.ss b/collects/drscheme/private/rep.ss index 08442e7a83..96af29feff 100644 --- a/collects/drscheme/private/rep.ss +++ b/collects/drscheme/private/rep.ss @@ -867,7 +867,7 @@ TODO (memory-killed-thread #f) (user-custodian #f) (custodian-limit (and (custodian-memory-accounting-available?) - (preferences:get 'drscheme:memory-limit))) + (preferences:get 'drscheme:child-only-memory-limit))) (user-eventspace-box (make-weak-box #f)) (user-namespace-box (make-weak-box #f)) (user-eventspace-main-thread #f) @@ -925,7 +925,7 @@ TODO (field (need-interaction-cleanup? #f)) (define/private (no-user-evaluation-message frame exit-code memory-killed?) - (let* ([new-limit (and custodian-limit (+ (* 1024 1024 128) custodian-limit))] + (let* ([new-limit (and custodian-limit (+ (* 1024 1024 32) custodian-limit))] [ans (message-box/custom (string-constant evaluation-terminated) (string-append @@ -953,7 +953,7 @@ TODO )]) (when (equal? ans 3) (set-custodian-limit new-limit) - (preferences:set 'drscheme:memory-limit new-limit)) + (preferences:set 'drscheme:child-only-memory-limit new-limit)) (set-insertion-point (last-position)) (insert-warning "\nInteractions disabled"))) diff --git a/collects/drscheme/private/unit.ss b/collects/drscheme/private/unit.ss index b523730f1f..9e943f22bf 100644 --- a/collects/drscheme/private/unit.ss +++ b/collects/drscheme/private/unit.ss @@ -3292,10 +3292,10 @@ module browser threading seems wrong. (when num (cond [(eq? num #t) - (preferences:set 'drscheme:memory-limit #f) + (preferences:set 'drscheme:child-only-memory-limit #f) (send interactions-text set-custodian-limit #f)] [else - (preferences:set 'drscheme:memory-limit + (preferences:set 'drscheme:child-only-memory-limit (* 1024 1024 num)) (send interactions-text set-custodian-limit (* 1024 1024 num))]))))])) @@ -3844,7 +3844,7 @@ module browser threading seems wrong. [parent hp] [init-value (if current-limit (format "~a" current-limit) - "128")] + "64")] [stretchable-width #f] [min-width 100] [callback @@ -3886,7 +3886,7 @@ module browser threading seems wrong. (let* ([n (string->number (send txt get-text))]) (and n (integer? n) - (100 . <= . n)))) + (1 . <= . n)))) (define (background sd) (let ([txt (send tb get-editor)]) diff --git a/collects/string-constants/english-string-constants.ss b/collects/string-constants/english-string-constants.ss index 4278e0fb52..efeed1ebf2 100644 --- a/collects/string-constants/english-string-constants.ss +++ b/collects/string-constants/english-string-constants.ss @@ -862,7 +862,7 @@ please adhere to these guidelines: (force-quit-menu-item-help-string "Uses custodian-shutdown-all to abort the current evaluation") (limit-memory-menu-item-label "Limit Memory...") (limit-memory-msg-1 "The limit will take effect the next time the program") - (limit-memory-msg-2 "is Run, and it must be at least 100 megabytes.") + (limit-memory-msg-2 "is Run, and it must be at least one megabyte.") (limit-memory-unlimited "Unlimited") (limit-memory-limited "Limited") (limit-memory-megabytes "Megabytes") diff --git a/collects/string-constants/french-string-constants.ss b/collects/string-constants/french-string-constants.ss index 7cb51c1c99..017ee9b754 100644 --- a/collects/string-constants/french-string-constants.ss +++ b/collects/string-constants/french-string-constants.ss @@ -859,7 +859,7 @@ (force-quit-menu-item-help-string "Utilise custodian-shutdown-all pour terminer toute l'évaluation courante") (limit-memory-menu-item-label "Limiter la mémoire...") (limit-memory-msg-1 "La limite prendra effet à la prochaine exécution du programme.") - (limit-memory-msg-2 "Elle doit être d'au moins 100 megaoctets.") + (limit-memory-msg-2 "Elle doit être d'au moins 1 megaoctet.") (limit-memory-unlimited "Illimitée") (limit-memory-limited "Limitée") (limit-memory-megabytes "Megaoctets") diff --git a/collects/string-constants/german-string-constants.ss b/collects/string-constants/german-string-constants.ss index b3112612d7..94dce2899e 100644 --- a/collects/string-constants/german-string-constants.ss +++ b/collects/string-constants/german-string-constants.ss @@ -763,7 +763,7 @@ (force-quit-menu-item-help-string "Benutzt custodian-shutdown-all, um die Auswertung abzubrechen") (limit-memory-menu-item-label "Speicherverbrauch einschränken...") (limit-memory-msg-1 "Das Limit wird beim nächsten Programmstart aktiv") - (limit-memory-msg-2 "und muß mindestens 100 Megabytes betragen.") + (limit-memory-msg-2 "und muß mindestens 1 Megabyte betragen.") (limit-memory-unlimited "nicht einschränken") (limit-memory-limited "einschränken") (limit-memory-megabytes "Megabytes") diff --git a/collects/string-constants/japanese-string-constants.ss b/collects/string-constants/japanese-string-constants.ss index 3f3c64b0a2..376c2d2b48 100644 --- a/collects/string-constants/japanese-string-constants.ss +++ b/collects/string-constants/japanese-string-constants.ss @@ -805,7 +805,7 @@ please adhere to these guidelines: (kill-menu-item-help-string "現在の評価を強制終了します") (limit-memory-menu-item-label "メモリを制限する...") (limit-memory-msg-1 "ここで指定したメモリ制限値は、プログラムを次に実行するときに有効になります。") - (limit-memory-msg-2 "制限値は 100MB 以上にしてください。") + (limit-memory-msg-2 "制限値は 1MB 以上にしてください。") (limit-memory-unlimited "制限しない") (limit-memory-limited "制限する") (limit-memory-megabytes "MB") diff --git a/collects/string-constants/simplified-chinese-string-constants.ss b/collects/string-constants/simplified-chinese-string-constants.ss index 68d0b2d1e3..7a53c24015 100644 --- a/collects/string-constants/simplified-chinese-string-constants.ss +++ b/collects/string-constants/simplified-chinese-string-constants.ss @@ -780,7 +780,7 @@ (force-quit-menu-item-help-string "使用custodian-shutdown-all退出当前计算") (limit-memory-menu-item-label "限制内存使用...") (limit-memory-msg-1 "内存限制会在下一次运行") - (limit-memory-msg-2 "时生效。内存限制最低值为100megabytes.") + (limit-memory-msg-2 "时生效。内存限制最低值为1megabyte.") (limit-memory-unlimited "无限制") (limit-memory-limited "限制") (limit-memory-megabytes "Megabytes") diff --git a/collects/string-constants/traditional-chinese-string-constants.ss b/collects/string-constants/traditional-chinese-string-constants.ss index edfb95a6e0..5ae4839493 100644 --- a/collects/string-constants/traditional-chinese-string-constants.ss +++ b/collects/string-constants/traditional-chinese-string-constants.ss @@ -779,7 +779,7 @@ (force-quit-menu-item-help-string "使用custodian-shutdown-all退出当前计算") (limit-memory-menu-item-label "限制内存使用...") (limit-memory-msg-1 "内存限制会在下一次运行") - (limit-memory-msg-2 "时生效。内存限制最低值为100megabytes.") + (limit-memory-msg-2 "时生效。内存限制最低值为1megabyte.") (limit-memory-unlimited "无限制") (limit-memory-limited "限制") (limit-memory-megabytes "Megabytes") From efd7446b0943f00342a3b4401815ae675dc2d7dc Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 17 Dec 2008 00:04:20 +0000 Subject: [PATCH 3/5] current-exit-handler => exit-handler svn: r12874 --- collects/scheme/sandbox.ss | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/collects/scheme/sandbox.ss b/collects/scheme/sandbox.ss index 5b2424e81f..cb8d297294 100644 --- a/collects/scheme/sandbox.ss +++ b/collects/scheme/sandbox.ss @@ -68,7 +68,7 @@ (parameterize ([sandbox-propagate-breaks #t] [sandbox-override-collection-paths '()] [sandbox-security-guard current-security-guard] - [sandbox-exit-handler (current-exit-handler)] + [sandbox-exit-handler (exit-handler)] [sandbox-make-inspector current-inspector] [sandbox-make-code-inspector current-code-inspector] [sandbox-make-logger current-logger] From ed7713751a021a6f57ef89c8bf86194e2fad568d Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Wed, 17 Dec 2008 08:50:11 +0000 Subject: [PATCH 4/5] Welcome to a new PLT day. svn: r12875 --- collects/repos-time-stamp/stamp.ss | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/collects/repos-time-stamp/stamp.ss b/collects/repos-time-stamp/stamp.ss index 1d6e8fc546..c0fa768946 100644 --- a/collects/repos-time-stamp/stamp.ss +++ b/collects/repos-time-stamp/stamp.ss @@ -1 +1 @@ -#lang scheme/base (provide stamp) (define stamp "16dec2008") +#lang scheme/base (provide stamp) (define stamp "17dec2008") From 1d85f9ff3c9ea929e26567d0ec65b6fba5bb383a Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 17 Dec 2008 13:05:35 +0000 Subject: [PATCH 5/5] patch for better #includes in XPM src from Michal Vyskocil svn: r12876 --- src/wxxt/contrib/xpm/lib/CrBufFrI.c | 2 +- src/wxxt/contrib/xpm/lib/CrDatFrI.c | 2 +- src/wxxt/contrib/xpm/lib/WrFFrBuf.c | 5 +++++ src/wxxt/contrib/xpm/lib/WrFFrI.c | 5 +++++ src/wxxt/contrib/xpm/lib/create.c | 5 +++++ src/wxxt/contrib/xpm/lib/data.c | 5 +++++ src/wxxt/contrib/xpm/lib/hashtab.c | 5 +++++ src/wxxt/contrib/xpm/lib/parse.c | 5 +++++ src/wxxt/contrib/xpm/lib/rgb.c | 2 +- 9 files changed, 33 insertions(+), 3 deletions(-) diff --git a/src/wxxt/contrib/xpm/lib/CrBufFrI.c b/src/wxxt/contrib/xpm/lib/CrBufFrI.c index e7d5da4fa4..3399ba5189 100644 --- a/src/wxxt/contrib/xpm/lib/CrBufFrI.c +++ b/src/wxxt/contrib/xpm/lib/CrBufFrI.c @@ -36,7 +36,7 @@ \*****************************************************************************/ #include "xpmP.h" -#if defined(SYSV) || defined(SVR4) || defined(VMS) +#if defined(SYSV) || defined(SVR4) || defined(VMS) || defined(__GNUC__) #include #else #include diff --git a/src/wxxt/contrib/xpm/lib/CrDatFrI.c b/src/wxxt/contrib/xpm/lib/CrDatFrI.c index e97fed715e..ca898d120a 100644 --- a/src/wxxt/contrib/xpm/lib/CrDatFrI.c +++ b/src/wxxt/contrib/xpm/lib/CrDatFrI.c @@ -33,7 +33,7 @@ \*****************************************************************************/ #include "xpmP.h" -#if defined(SYSV) || defined(SVR4) || defined(VMS) +#if defined(SYSV) || defined(SVR4) || defined(VMS) || defined(__GNUC__) #include #else #include diff --git a/src/wxxt/contrib/xpm/lib/WrFFrBuf.c b/src/wxxt/contrib/xpm/lib/WrFFrBuf.c index 5f47f52f12..d758232745 100644 --- a/src/wxxt/contrib/xpm/lib/WrFFrBuf.c +++ b/src/wxxt/contrib/xpm/lib/WrFFrBuf.c @@ -33,6 +33,11 @@ \*****************************************************************************/ #include "xpmP.h" +#if defined(SYSV) || defined(SVR4) || defined(VMS) || defined(__GNUC__) +#include +#else +#include +#endif int XpmWriteFileFromBuffer(filename, buffer) diff --git a/src/wxxt/contrib/xpm/lib/WrFFrI.c b/src/wxxt/contrib/xpm/lib/WrFFrI.c index 3d6f8a1cd9..7a004d9dce 100644 --- a/src/wxxt/contrib/xpm/lib/WrFFrI.c +++ b/src/wxxt/contrib/xpm/lib/WrFFrI.c @@ -33,6 +33,11 @@ \*****************************************************************************/ #include "xpmP.h" +#if defined(SYSV) || defined(SVR4) || defined(VMS) || defined(__GNUC__) +#include +#else +#include +#endif LFUNC(WriteFile, int, (FILE *file, XpmImage *image, char *name, XpmInfo *info)); diff --git a/src/wxxt/contrib/xpm/lib/create.c b/src/wxxt/contrib/xpm/lib/create.c index 2b30f9df37..ced1e0a254 100644 --- a/src/wxxt/contrib/xpm/lib/create.c +++ b/src/wxxt/contrib/xpm/lib/create.c @@ -40,6 +40,11 @@ #include "xpmP.h" #include +#if defined(SYSV) || defined(SVR4) || defined(VMS) || defined(__GNUC__) +#include +#else +#include +#endif LFUNC(xpmVisualType, int, (Visual *visual)); diff --git a/src/wxxt/contrib/xpm/lib/data.c b/src/wxxt/contrib/xpm/lib/data.c index 1667b485b1..351068a8e0 100644 --- a/src/wxxt/contrib/xpm/lib/data.c +++ b/src/wxxt/contrib/xpm/lib/data.c @@ -39,6 +39,11 @@ static char *RCS_Version = "$XpmVersion: 3.4g $"; #include "xpmP.h" #include +#if defined(SYSV) || defined(SVR4) || defined(VMS) || defined(__GNUC__) +#include +#else +#include +#endif LFUNC(ParseComment, int, (xpmData * mdata)); diff --git a/src/wxxt/contrib/xpm/lib/hashtab.c b/src/wxxt/contrib/xpm/lib/hashtab.c index 790203bfe8..4d76aa5aa3 100644 --- a/src/wxxt/contrib/xpm/lib/hashtab.c +++ b/src/wxxt/contrib/xpm/lib/hashtab.c @@ -34,6 +34,11 @@ \*****************************************************************************/ #include "xpmP.h" +#if defined(SYSV) || defined(SVR4) || defined(VMS) || defined(__GNUC__) +#include +#else +#include +#endif LFUNC(AtomMake, xpmHashAtom, (char *name, void *data)); LFUNC(HashTableGrows, int, (xpmHashTable * table)); diff --git a/src/wxxt/contrib/xpm/lib/parse.c b/src/wxxt/contrib/xpm/lib/parse.c index 3612313189..d847365e5e 100644 --- a/src/wxxt/contrib/xpm/lib/parse.c +++ b/src/wxxt/contrib/xpm/lib/parse.c @@ -40,6 +40,11 @@ #include "xpmP.h" #include +#if defined(SYSV) || defined(SVR4) || defined(VMS) || defined(__GNUC__) +#include +#else +#include +#endif LFUNC(ParseValues, int, (xpmData *data, unsigned int *width, unsigned int *height, unsigned int *ncolors, diff --git a/src/wxxt/contrib/xpm/lib/rgb.c b/src/wxxt/contrib/xpm/lib/rgb.c index 114b30f47d..0984b27764 100644 --- a/src/wxxt/contrib/xpm/lib/rgb.c +++ b/src/wxxt/contrib/xpm/lib/rgb.c @@ -44,7 +44,7 @@ #include "xpmP.h" #include -#if defined(SYSV) || defined(SVR4) || defined(VMS) +#if defined(SYSV) || defined(SVR4) || defined(VMS) || defined(__GNUC__) #include #else #include