Sync up

svn: r12877
2008-12-17 14:28:56 +00:00 · 2008-12-17 14:28:56 +00:00 · 0b1829e250
commit 0b1829e250
parent 236370fd9f 1d85f9ff3c
23 changed files with 101 additions and 45 deletions
--- 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 
--- 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")))
      
--- 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)])
--- 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")
--- 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        (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 |#)))
--- 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) 
--- 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)]{

--- 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")
--- 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")
--- 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")
--- 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")
--- 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")
--- 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")
--- 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))
--- 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 <string.h>
 #else
 #include <strings.h>
--- 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 <string.h>
 #else
 #include <strings.h>
--- 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 <string.h>
+#else
+#include <strings.h>
+#endif

 int
 XpmWriteFileFromBuffer(filename, buffer)
--- 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 <string.h>
+#else
+#include <strings.h>
+#endif

 LFUNC(WriteFile, int, (FILE *file, XpmImage *image, char *name,
 		       XpmInfo *info));
--- a/src/wxxt/contrib/xpm/lib/create.c
+++ b/src/wxxt/contrib/xpm/lib/create.c
@ -40,6 +40,11 @@

 #include "xpmP.h"
 #include <ctype.h>
+#if defined(SYSV) || defined(SVR4) || defined(VMS) || defined(__GNUC__)
+#include <string.h>
+#else
+#include <strings.h>
+#endif

 LFUNC(xpmVisualType, int, (Visual *visual));

--- 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 <ctype.h>
+#if defined(SYSV) || defined(SVR4) || defined(VMS) || defined(__GNUC__)
+#include <string.h>
+#else
+#include <strings.h>
+#endif


 LFUNC(ParseComment, int, (xpmData * mdata));
--- 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 <string.h>
+#else
+#include <strings.h>
+#endif

 LFUNC(AtomMake, xpmHashAtom, (char *name, void *data));
 LFUNC(HashTableGrows, int, (xpmHashTable * table));
--- a/src/wxxt/contrib/xpm/lib/parse.c
+++ b/src/wxxt/contrib/xpm/lib/parse.c
@ -40,6 +40,11 @@

 #include "xpmP.h"
 #include <ctype.h>
+#if defined(SYSV) || defined(SVR4) || defined(VMS) || defined(__GNUC__)
+#include <string.h>
+#else
+#include <strings.h>
+#endif

 LFUNC(ParseValues, int, (xpmData *data, unsigned int *width,
 			 unsigned int *height, unsigned int *ncolors,
--- a/src/wxxt/contrib/xpm/lib/rgb.c
+++ b/src/wxxt/contrib/xpm/lib/rgb.c
@ -44,7 +44,7 @@

 #include "xpmP.h"
 #include <ctype.h>
-#if defined(SYSV) || defined(SVR4) || defined(VMS)
+#if defined(SYSV) || defined(SVR4) || defined(VMS) || defined(__GNUC__)
 #include <string.h>
 #else
 #include <strings.h>