change datum->syntax treatment of code inspectors

Change `datum->syntax` so that it limits the transfer of a code
inspector from a source syntax object; the code inspector is kept only
if a macro is being expanded and the macro has the same code inspector
(or, more generally, the weaker of the two code inspectors is
preserved).

This change is a kind of defense-in-depth to prevent the use of
unarmed syntax with `datum->syntax` to access unexported bindings from
the module where a syntax object originates.

The general approach is Ryan's idea. This particular implementation is
a simplification of the general idea, and we'll see whether it's
worakble and sufficient.

pkgs/racket-doc/scribblings/guide/namespaces.scrbl

@@ -519,3 +519,56 @@ DrRacket's @onscreen{Check Syntax} tool cannot tell that the second
 @racket[good] is a reference to the first, and the unbound reference
 to @racket[bad] is reported only at run time instead of rejected
 syntactically.
+
+@;------------------------------------------------------------------------
+@section[#:tag "code-inspectors+protect"]{Code Inspectors for Trusted and Untrusted Code}
+
+@deftech{Code inspectors} provide the mechanism for determining which
+modules are trusted to use functions like @racket[module->namespace]
+or unsafe modules like @racket[ffi/unsafe]. When a module is declared,
+the value of @racket[current-code-inspector] is associated to the
+module declaration. When a module is instantiated (i.e., when the body
+of the declaration is actually executed), a sub-inspector is created
+to guard the module's exports. Access to the module's @tech{protected}
+exports requires a code inspector that is stronger (i.e., higher in
+the inspector hierarchy) than the module's instantiation inspector;
+note that a module's declaration inspector is always stronger than its
+instantiation inspector, so modules are declared with the same code
+inspector can access each other's exports.
+
+To distinguish between trusted an untrusted code, load trusted code
+first, then set @racket[current-code-inspector] to the result of
+@racket[(make-inspector (current-code-inspector))] to install a weaker
+inspector, and finally load untrusted code with the weaker inspector
+in place. The weaker inspector should stay in place when any untrusted
+code is run. If necessary, trusted code can restore the original
+inspector temporarily during the dynamic extent of trusted code (as
+long as it does not call back into untrusted code).
+
+Syntax-object constants within a module, such as literal identifiers
+in a template, retain the inspector of their source module. In this
+way, a macro from a trusted module can be used within an untrusted
+module, and @tech{protected} identifiers in the macro expansion still
+work, even through they ultimately appear in an untrusted module.
+Typically, such identifiers should be @tech{arm}ed, so that they
+cannot be extracted from the macro expansion and abused by untrusted
+code.
+
+When @racket[datum->syntax] is used to transfer the context of a
+syntax object to another, then it may taint the resulting syntax
+object. Even if the source syntax object is not @tech{arm}ed, however,
+the resulting syntax object may have limited access to bindings;
+@racket[datum->syntax] will not transfer an inspector from the source
+syntax object unless @racket[datum->syntax] is called during the
+expansion of a macro whose module's declaration-time code inspector.
+More generally, @racket[datum->syntax] chooses the strongest inspector
+that is the same or weaker than the inspector of the currently
+expanding macro's module and the source syntax object's inspector.
+
+Compiled code from a @filepath{.zo} file is inherently untrustworthy,
+unfortunately, since it can be synthesized by means other than
+@racket[compile]. When compiled code is written to a @filepath{.zo}
+file, syntax-object constants within the compiled code lose their
+inspectors. All syntax-object constants within compiled code acquire
+the enclosing module's declaration-time inspector when the code is
+loaded.

pkgs/racket-doc/scribblings/guide/syntax-taints.scrbl

@@ -1,13 +1,15 @@
 #lang scribble/doc
 @(require scribble/manual scribble/eval "guide-utils.rkt")
 
-@title[#:tag "stx-certs" #:style 'quiet]{Syntax Taints}
+@title[#:tag "stx-certs" #:style 'quiet]{Code Inspectors and Syntax Taints}
 
-A use of a macro can expand into a use of an identifier that is not
-exported from the module that binds the macro. In general, such an
-identifier must not be extracted from the expanded expression and used
-in a different context, because using the identifier in a different
-context may break invariants of the macro's module.
+Modules often contain definitions that are meant only for use within
+the same module and not exported with @racket[provide]. Still, a use
+of a macro defined in the module can expand into a reference of an
+unexported identifier. In general, such an identifier must not be
+extracted from the expanded expression and used in a different
+context, because using the identifier in a different context may break
+invariants of the macro's module.
 
 For example, the following module exports a macro @racket[go] that
 expands to a use of @racket[unchecked-go]:
@@ -23,8 +25,8 @@ racket
 
 (define-syntax (go stx)
   (syntax-case stx ()
-   [(_ x)
-    #'(unchecked-go 8 x)]))
+    [(_ x)
+     #'(unchecked-go 8 x)]))
 ]
 
 If the reference to @racket[unchecked-go] is extracted from the
@@ -34,15 +36,33 @@ expression, @racket[(unchecked-go #f 'a)], leading to disaster. The
 references to an unexported identifier, even when no macro expansion
 includes a reference to the identifier.
 
-To prevent such abuses of unexported identifiers, the @racket[go]
-macro must explicitly protect its expansion by using
-@racket[syntax-protect]:
+Ultimately, protection of a module's private bindings depends on
+changing the current @tech{code inspector} by setting the
+@racket[current-code-inspector] parameter. That's because a code
+inspector controls access to a module's internal state through
+functions like @racket[module->namespace]. The current code inspector
+also gates access to the exports of unsafe modules like
+@racketmodname[racket/unsafe/ops].
+
+To some extent, a code inspector also constrains access to bindings
+via @racket[datum->syntax] (see @secref["code-inspectors+protect"]),
+but a code inspector does not control the use of @racket[expand] or
+@racket[local-expand]. To prevent misuse of its module's bindings and
+imports in general, a macro should enable syntax @deftech{taints} via
+@racket[syntax-protect] on its result syntax object.
+
+@;------------------------------------------------------------------------
+@section[#:tag "syntax-protect"]{Using @racket[syntax-protect] for Macro Results}
+
+To prevent abuses of unexported identifiers, the @racket[go] macro
+from the preceding example must explicitly protect its expansion by
+using @racket[syntax-protect]:
 
 @racketblock[
 (define-syntax (go stx)
   (syntax-case stx ()
-   [(_ x)
-    (syntax-protect #'(unchecked-go 8 x))]))
+    [(_ x)
+     (syntax-protect #'(unchecked-go 8 x))]))
 ]
 
 The @racket[syntax-protect] function causes any syntax object that is
@@ -51,7 +71,7 @@ macro expander rejects tainted identifiers, so attempting to extract
 @racket[unchecked-go] from the expansion of @racket[(go 'a)] produces
 an identifier that cannot be used to construct a new expression (or, at
 least, not one that the macro expander will accept). The
-@racket[syntax-rules], @racket[syntax-id-rule], and
+@racket[syntax-rules], @racket[syntax-id-rules], and
 @racket[define-syntax-rule] forms automatically protect their
 expansion results.
 
@@ -183,9 +203,9 @@ into a transformer's result.
 
 Tools that are intended to be privileged (such as a debugging
 transformer) must disarm dye packs in expanded programs.  Privilege is
-granted through @deftech{code inspectors}. Each dye pack records an
+granted through @tech{code inspectors}. Each dye pack records an
 inspector, and a syntax object can be disarmed using a sufficiently
-powerful inspector.
+strong inspector.
 
 When a module is declared, the declaration captures the current value
 of the @racket[current-code-inspector] parameter.  The captured
@@ -194,7 +214,7 @@ transformer that is defined within the module. A tool can disarm the
 resulting syntax object by supplying @racket[syntax-disarm] with
 an inspector that is the same or a super-inspector of the module's
 inspector. Untrusted code is ultimately run after setting
-@racket[current-code-inspector] to a less powerful inspector (after
+@racket[current-code-inspector] to a weaker inspector (after
 trusted code, such as debugging tools, have been loaded).
 
 With this arrangement, macro-generating macros require some care,
@@ -259,40 +279,21 @@ racket
 ]
 
 @;------------------------------------------------------------------------
-@section[#:tag "code-inspectors+protect"]{Protected Exports}
+@section[#:tag "protect-out"]{Protected Exports}
 
 Sometimes, a module needs to export bindings to some modules---other
 modules that are at the same trust level as the exporting module---but
 prevent access from untrusted modules. Such exports should use the
 @racket[protect-out] form in @racket[provide]. For example,
-@racket[ffi/unsafe] exports all of its unsafe bindings as
+@racketmodname[ffi/unsafe] exports all of its unsafe bindings as
 @deftech{protected} in this sense.
 
-Code inspectors, again, provide the mechanism for determining which
-modules are trusted and which are untrusted. When a module is
-declared, the value of @racket[current-code-inspector] is associated
-to the module declaration. When a module is instantiated (i.e., when the
-body of the declaration is actually executed), a sub-inspector is
-created to guard the module's exports. Access to the module's
-@tech{protected} exports requires a code inspector higher in the
-inspector hierarchy than the module's instantiation inspector; note
-that a module's declaration inspector is always higher than its
-instantiation inspector, so modules are declared with the same code
-inspector can access each other's exports.
+Only modules loaded with an equally strong code inspector as an
+exporting module can use protected bindings from the exporting module.
+Operations like @racket[dynamic-require] are granted access depending
+on the current code inspector as determined by
+@racket[current-code-inspector].
 
-Syntax-object constants within a module, such as literal identifiers
-in a template, retain the inspector of their source module. In this
-way, a macro from a trusted module can be used within an untrusted
-module, and @tech{protected} identifiers in the macro expansion still
-work, even through they ultimately appear in an untrusted
-module. Naturally, such identifiers should be @tech{arm}ed, so that
-they cannot be extracted from the macro expansion and abused by
-untrusted code.
-
-Compiled code from a @filepath{.zo} file is inherently untrustworthy,
-unfortunately, since it can be synthesized by means other than
-@racket[compile]. When compiled code is written to a @filepath{.zo}
-file, syntax-object constants within the compiled code lose their
-inspectors. All syntax-object constants within compiled code acquire
-the enclosing module's declaration-time inspector when the code is
-loaded.
+When a module re-exports a protected binding, it does not need to use
+@racket[protect-out] again. Access is always determined by the code
+inspector of the module that originally defines a protected binding.

pkgs/racket-doc/scribblings/reference/code-inspectors.scrbl

@@ -5,7 +5,8 @@
 
 In the same way that inspectors control access to structure fields
 (see @secref["inspectors"]), inspectors also control access to
-@tech{module bindings}. The default inspector for @tech{module
+@tech{module bindings}. Inspectors used this way are @deftech{code
+inspectors}. The default code inspector for @tech{module
 bindings} is determined by the @racket[current-code-inspector]
 parameter, instead of the @racket[current-inspector] parameter.
 

pkgs/racket-doc/scribblings/reference/stx-ops.scrbl

@@ -247,7 +247,12 @@ is a pair, vector, box, immutable @tech{hash table}, or immutable
 @tech{prefab} structure, recursively converted values are not given
 properties. If @racket[ctxt] is @tech{tainted} or
 @tech{armed}, then the resulting syntax object from
-@racket[datum->syntax] is @tech{tainted}.
+@racket[datum->syntax] is @tech{tainted}. The @tech{code inspector}
+of @racket[ctxt], if any, is compared to the code inspector of the
+module for the macro currently being transformed, if any; if both
+inspectors are available and if one is the same as or inferior to the
+other, then the result syntax has the same/inferior inspector,
+otherwise it has no code inspector.
 
 Any of @racket[ctxt], @racket[srcloc], or @racket[prop] can be
 @racket[#f], in which case the resulting syntax has no lexical

pkgs/racket-test-core/tests/racket/modprot.rktl

@@ -400,4 +400,63 @@
 
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(parameterize ([current-namespace (make-base-namespace)])
+  (define strong (current-code-inspector))
+  (define weak (make-inspector (current-code-inspector)))
+
+  (eval '(module A racket/base ;; A is controlled by strong, not by weak
+           (require (for-syntax racket/base))
+           (define s1 #'secret-val)
+           (define secret-val 'secret)
+           (define-syntax (A-identity stx)
+             (syntax-case stx ()
+               [(_ id) #`(quote-syntax #,(datum->syntax #'id 'secret-val))]))
+           (provide s1 A-identity)))
+
+  (eval '(require 'A))
+
+  (define s1 (eval 's1))
+
+  (define (get-id s)
+    (syntax-case s () [(_ id) #'id]))
+
+  (define s2 (get-id (expand `(A-identity ,s1))))
+  (define s2-weak1 (parameterize ([current-code-inspector weak])
+                     ;; Ends up with no inspector, since we're not
+                     ;; in a macro expansion:
+                     (datum->syntax s1 'secret-val)))
+  (define s2-weak2 (parameterize ([current-code-inspector weak])
+                     ;; Ends up with weak inspector, since no inspector
+                     ;; on `s2-weak1 turns into a weak inspector:
+                     (get-id (expand `(A-identity ,s2-weak1)))))
+
+  (define s3-weak
+    (parameterize ((current-code-inspector strong))
+      ;; Doesn't get strong inspector back:
+      (datum->syntax s2-weak1 'secret-val)))
+
+  (parameterize ([current-code-inspector weak])
+    (test 'secret eval s1)
+    (test 'secret eval s2)
+    (err/rt-test (eval s2-weak1) exn:fail:syntax?)
+    (err/rt-test (eval s2-weak2) exn:fail:syntax?)
+    (err/rt-test (eval s3-weak) exn:fail:syntax?))
+
+  (parameterize ([current-code-inspector strong])
+    (test 'secret eval s1)
+    (test 'secret eval s2)
+    (test 'secret eval s2-weak1)
+    (err/rt-test (eval s2-weak2) exn:fail:syntax?)
+    (test 'secret eval s3-weak))
+
+  (parameterize ([current-code-inspector weak])
+    (let ([s4-weak
+           ;; Try to get `struct` to synthesize a `secret-val`
+           ;; that has the `racket/base` inspector:
+           (syntax-case (expand (datum->syntax s1 '(struct secret (val)))) ()
+             [(_ a b (_ (_ _ _ c) . _) . _) #'c])])
+      (err/rt-test (eval s4-weak) exn:fail:syntax?))))
+
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (report-errs)

racket/src/expander/syntax/binding.rkt

@@ -302,7 +302,7 @@
                                       #:non-source? non-source?))]))
 
 (define (syntax-set-inspector s insp)
-  ;; This inspector merging is also implemented via propagations in "syntax.rkt"
+  ;; This inspector merging is also implemented via propagations in "scope.rkt"
   (struct-copy syntax s
                [inspector (or (syntax-inspector s)
                               insp)]

racket/src/expander/syntax/syntax.rkt

@@ -3,9 +3,11 @@
          "../compile/serialize-state.rkt"
          "../common/set.rkt"
          "../common/inline.rkt"
+         "../namespace/inspector.rkt"
          "preserved.rkt"
          "tamper.rkt"
-         "datum-map.rkt")
+         "datum-map.rkt"
+         "weaker-inspector.rkt")
 
 (provide
  (struct-out syntax) ; includes `syntax?`
@@ -188,6 +190,7 @@
   (cond
    [(syntax? s) s]
    [else
+    (define insp (if (syntax? s) 'not-needed (current-module-code-inspector)))
     (define (wrap content)
       (syntax content
               (if stx-c
@@ -204,8 +207,9 @@
                   empty-mpi-shifts)
               (and stx-l (syntax-srcloc stx-l))
               empty-props
-              (and stx-c
-                   (syntax-inspector stx-c))))
+              (and insp
+                   stx-c
+                   (weaker-inspector insp (syntax-inspector stx-c)))))
     (define result-s
       (non-syntax-map s
                       (lambda (tail? x) (if tail? x (wrap x)))

racket/src/expander/syntax/weaker-inspector.rkt

@@ -0,0 +1,13 @@
+#lang racket/base
+(require "../common/inline.rkt")
+
+(provide weaker-inspector)
+
+(define-inline (weaker-inspector a b)
+  (cond
+    [(eq? a b) a]
+    [(not a) #f]
+    [(not b) #f]
+    [(inspector-superior? a b) b]
+    [(inspector-superior? b a) a]
+    [else #f]))

racket/src/racket/src/startup.inc

@@ -4950,6 +4950,11 @@ static const char *startup_source =
 "(pop-syntax-context!)"
 "(lambda(state_0)"
 "(begin(let-values(((b_0)(serialize-state-syntax-context state_0)))(set-box! b_0(cdr(unbox b_0)))))))"
+"(define-values(root-tag)(unsafe-root-continuation-prompt-tag))"
+"(define-values(default-val.1$2) #f)"
+"(define-values"
+"(current-module-code-inspector)"
+"(lambda()(begin(continuation-mark-set-first #f current-module-code-inspector default-val.1$2 root-tag))))"
 "(define-values"
 "(immutable-prefab-struct-key)"
 "(lambda(v_0)"
@@ -5808,6 +5813,8 @@ static const char *startup_source =
 "(if(syntax?$1 s_0)"
 "(let-values() s_0)"
 "(let-values()"
+"(let-values(((insp_0)"
+"(if(syntax?$1 s_0) 'not-needed(current-module-code-inspector))))"
 "(let-values(((wrap_0)"
 "(lambda(content_0)"
 "(begin"
@@ -5826,7 +5833,23 @@ static const char *startup_source =
 "(if stx-c_0(syntax-mpi-shifts stx-c_0) empty-mpi-shifts)"
 "(if stx-l_0(syntax-srcloc stx-l_0) #f)"
 " empty-props"
-"(if stx-c_0(syntax-inspector stx-c_0) #f))))))"
+"(if insp_0"
+"(if stx-c_0"
+"(let-values(((a_0) insp_0)"
+"((b_0)(syntax-inspector stx-c_0)))"
+"(if(eq? a_0 b_0)"
+"(let-values() a_0)"
+"(if(not a_0)"
+"(let-values() #f)"
+"(if(not b_0)"
+"(let-values() #f)"
+"(if(inspector-superior? a_0 b_0)"
+"(let-values() b_0)"
+"(if(inspector-superior? b_0 a_0)"
+"(let-values() a_0)"
+"(let-values() #f)))))))"
+" #f)"
+" #f))))))"
 "(let-values(((result-s_0)"
 "(let-values(((s_1) s_0)"
 "((f_0)"
@@ -5866,7 +5889,10 @@ static const char *startup_source =
 " tail?_0"
 "(cons"
 "(loop_0 #f(car s_3) depth_0)"
-"(loop_0 #t(cdr s_3) depth_0))))"
+"(loop_0"
+" #t"
+"(cdr s_3)"
+" depth_0))))"
 "(if(symbol? s_3)"
 "(let-values()(f_1 #f s_3))"
 "(if(boolean? s_3)"
@@ -5898,7 +5924,9 @@ static const char *startup_source =
 "(gf_0 tail?_1 s_4))"
 " seen_1))"
 "(let-values()"
-"(gf_0 #f s_3))))))))))))))"
+"(gf_0"
+" #f"
+" s_3))))))))))))))"
 " loop_0)"
 " #f"
 " s_2"
@@ -5916,8 +5944,8 @@ static const char *startup_source =
 "(syntax-srcloc the-struct_0)"
 " props19_0"
 "(syntax-inspector the-struct_0)))"
-"                                            (raise-argument-error 'struct-copy \"syntax?\" the-struct_0)))"
-" result-s_0))))))))))))))"
+"                                              (raise-argument-error 'struct-copy \"syntax?\" the-struct_0)))"
+" result-s_0)))))))))))))))"
 "(case-lambda"
 "((stx-c_0 s_0)(begin 'datum->syntax(datum->syntax6_0 stx-c_0 s_0 #f #f)))"
 "((stx-c_0 s_0 stx-l_0 stx-p3_0)(datum->syntax6_0 stx-c_0 s_0 stx-l_0 stx-p3_0))"
@@ -15478,7 +15506,6 @@ static const char *startup_source =
 "(if(syntax-tainted?$1 id_0)"
 "        (let-values () (raise-syntax-error$1 #f \"cannot use identifier tainted by macro transformation\" id_0))"
 "(void)))))"
-"(define-values(root-tag)(unsafe-root-continuation-prompt-tag))"
 "(define-values(cons-ish)(lambda(a_0 b_0)(begin(if(null? b_0) a_0(cons a_0 b_0)))))"
 "(define-values"
 "(free-id-set)"
@@ -15953,10 +15980,10 @@ static const char *startup_source =
 "(expand-context/outer-current-use-scopes the-struct_0)"
 "(expand-context/outer-name the-struct_0)))"
 "            (raise-argument-error 'struct-copy \"expand-context/outer?\" the-struct_0)))))))"
-"(define-values(default-val.1$2) #f)"
+"(define-values(default-val.1$1) #f)"
 "(define-values"
 "(current-expand-context)"
-"(lambda()(begin(continuation-mark-set-first #f current-expand-context default-val.1$2 root-tag))))"
+"(lambda()(begin(continuation-mark-set-first #f current-expand-context default-val.1$1 root-tag))))"
 "(define-values"
 "(get-current-expand-context18.1)"
 "(lambda(fail-ok?15_0 who17_0)"
@@ -16750,10 +16777,6 @@ static const char *startup_source =
 "(define-values"
 "(syntax-remove-taint-dispatch-properties)"
 "(lambda(s_0)(begin(1/syntax-property-remove(1/syntax-property-remove s_0 'taint-mode) 'certify-mode))))"
-"(define-values(default-val.1$1) #f)"
-"(define-values"
-"(current-module-code-inspector)"
-"(lambda()(begin(continuation-mark-set-first #f current-module-code-inspector default-val.1$1 root-tag))))"
 "(define-values"
 "(syntax-debug-info$1)"
 "(lambda(s_0 phase_0 all-bindings?_0)"