fix taint-transparent syntax to lose lexical context

When submodules were introduced, the handling of taint-transparent
syntax changed to keep its lexical context. Restore the original
behavior, which is necessary to protect bindings, and fix taint
handling on submodules.

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

@@ -1,151 +0,0 @@
-#lang scribble/doc
-@(require "mz.rkt")
-
-@title[#:tag "stxcerts"]{Syntax Certificates}
-
-@guideintro["stx-certs"]{syntax certificates}
-
-A @deftech{syntax certificate} combines a @tech{syntax mark} (see
-@secref["transformer-model"]), a @tech{module path index} or symbol
-module name (see @secref["modpathidx"]), an @tech{inspector} (see
-@secref["modprotect"]), and an arbitrary key object. A certificate
-is attached as either an @deftech{active certificate} or an
-@deftech{inactive certificate}.
-
-The @racket[datum->syntax] procedure never transfers an @tech{active
-certificate} from one syntax object to another. The
-@racket[syntax-recertify] procedure can be used to transfer a
-certificate from one syntax object to another, but only if the
-certificate's key is provided, or if a sufficiently powerful inspector
-is provided. Thus, a certificate's inspector serves two roles: it
-determines the certificate's power to grant access, and also allows
-the certificate to be moved arbitrarily by anyone with a more powerful
-inspector.
-
-The expander generates a certificate when it applies a syntax
-transformer. The @tech{syntax mark} in the certificate is fresh, the
-certificate's module reference corresponds to the module that defined
-the @tech{transformer binding}, the inspector is the inspector for the
-module's declaration (see @secref["modprotect"]), and the key
-object is hidden. (Applying the result of
-@racket[syntax-local-certifier] can introduce certificates with other
-keys.) The certificate's mark is applied to both the input and output
-of the syntax transformer, so that it identifies every piece of syntax
-that was introduced by the transformer (see
-@secref["transformer-model"]). The expander attaches this
-certificate to parts of the transformer's result, depending on the
-shape and properties of the result:
-
-@itemize[
-
- @item{If the result has a @indexed-racket['certify-mode] property
-          (see @secref["stxprops"]) that is
-          @indexed-racket['opaque], then the certificate is attached
-          to the immediate syntax object.}
-
- @item{If the result has a @racket['certify-mode] property that is
-          @indexed-racket['transparent], then the certificate is also
-          propagated recursively to syntax object that corresponds to
-          elements of the syntax object's datum as a list (or, more
-          precisely, to the @racket[car]s of the datum as reached by
-          any number of @racket[cdr]s). This recursive propagation
-          uses syntax properties and shapes, as for the immediate
-          attachment.}
-
- @item{If the result has a @racket['certify-mode] property that is
-          @indexed-racket['transparent-binding], then the certificate
-          is attached in a way similar to @racket['transparent], but further
-          treating the syntax object corresponding to the second list
-          element as having a @racket['transparent] value for the
-          @racket['certify-mode] property if it does not already have
-          a @racket['certify-mode] property value.}
-
- @item{If the result has no @racket['certify-mode] property value, but
-          its datum is a pair, and if the syntax object corresponding
-          to the @racket[car] of the pair is an identifier bound to
-          @racket[begin], @racket[module], or
-          @racket[#%plain-module-begin], then the certificate is
-          propagated as if the syntax object had the
-          @racket['transparent] property value.}
-
- @item{If the result has no @racket['certify-mode] property value,
-          but its datum is a pair, and if the syntax object
-          corresponding to the @racket[car] of the pair is an
-          identifier bound to @racket[define-values] or
-          @racket[define-syntaxes], then the certificate is propagated
-          as if the syntax object had the @racket['transparent-binding]
-          property value.}
-
-]
-
-To avoid accidental transfer for a @racket['certify-mode] property
-value, the expander always removes any @racket['certify-mode] property
-on a syntax object that is passed to a syntax transformer.
-
-As the expander attaches a new active certificate to a syntax object,
-it also removes any @tech{inactive certificates} attached to any
-@tech{syntax object} within the one where the certificate is attached,
-and it re-attaches the formerly @tech{inactive certificates} as
-@tech{active certificates} along with the new one.
-
-As the expander processes a form, it accumulates @tech{active
-certificates} that are attached to enclosing forms as part of the
-expansion context:
-
-@itemize[
-
- @item{To check access to an unexported identifier, the expander
-   checks each of the identifier's marks and module bindings; if, for
-   some mark, the identifier's enclosing expressions include a
-   certificate with the mark, the identifier's binding module, and
-   with an inspector that controls the module's invocation (as opposed
-   to the module's declaration; see again @secref["modprotect"]),
-   then the access is allowed. To check access to a protected
-   identifier, only the certificate's mark and inspector are used
-   (i.e., the module that bound the transformer is irrelevant, as long
-   as it was evaluated with a sufficiently powerful inspector). The
-   certificate key is not used in checking references.}
-
- @item{To check access to a locally bound identifier, the expander
-   checks the marks of the binding and reference identifiers; for
-   every mark that they have in common, if the reference identifier
-   has a certificate for the mark from an enclosing expression, the
-   binding identifier must have a certificate for the mark from an
-   enclosing expression, otherwise the reference is disallowed. (The
-   reference identifier can have additional certificates for marks
-   that are not attached to the binding identifier.) The binding
-   module (if any) and the certificate key are not used for checking a
-   local reference.}
-
- @item{When the expander encounters a @racket[quote-syntax] form, it
-   attaches all accumulated @tech{active certificates} from the
-   expression's context to the quoted syntax objects. A certificate
-   for the enclosing module (if any) is also included. The
-   certificates are attached as @tech{inactive certificates} to the
-   immediate syntax object (i.e., not to any nested syntax
-   objects). In addition, any inactive certificates within the quoted
-   syntax object are lifted to the immediate syntax object.}
-
-]
-
-Finally, for the result of @racket[expand] or @racket[local-expand]
-with an empty stop list, certificates are lifted to the outermost
-result expression, except to the degree that @racket['certify-mode]
-property values and bindings like @racket[begin] direct certificates
-to sub-expressions.
-
-
-@defproc[(syntax-recertify [new-stx syntax?]
-                           [old-stx syntax?]
-                           [inspector inspector?]
-                           [key any/c])
-         syntax?]{
-
-Copies certain certificates of @racket[old-stx] to @racket[new-stx]: a
-certificate is copied if its inspector is either @racket[inspector] or
-controlled by @racket[inspector], or if the certificate's key is
-@racket[key]; otherwise the certificate is not copied.  The result is
-a syntax object like @racket[new-stx], but with the copied
-certificates. (The @racket[new-stx] object itself is not modified.)
-Both @tech{active certificates} and @tech{inactive certificates} are
-copied.}

pkgs/racket-pkgs/racket-test/tests/racket/module.rktl

@@ -1107,6 +1107,17 @@
     (parameterize ([current-namespace (module->namespace ''m)])
       (eval '(m)))))
 
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Check a a submodule can be armed:
+
+(test #t
+      syntax?
+      (expand
+       (expand
+        #'(module m racket/base
+            (define-syntax-rule (s) (module x racket/base 10))
+            (s)))))
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (report-errs)

pkgs/racket-pkgs/racket-test/tests/racket/stx.rktl

@@ -1601,6 +1601,17 @@
   (test #t syntax-tainted? (syntax-touch (round-trip (syntax-arm (quote-syntax foo)))))
   (test #t syntax-tainted? (round-trip (syntax-touch (syntax-arm (quote-syntax foo))))))
 
+;; Make sure that a taint-transparent syntax object loses its lexical context:
+(let ([b-stx #'(begin 1)])
+  (test #t free-identifier=? #'begin (datum->syntax b-stx 'begin))
+  (let ([a-b-stx (parameterize ([current-namespace (make-base-namespace)])
+                   (eval '(define-syntax-rule (b e)
+                            (begin e)))
+                   (expand #'(b 1)))])
+    (test #f free-identifier=? #'begin (datum->syntax a-b-stx 'begin))
+    (test #t free-identifier=? #'begin (syntax-case a-b-stx ()
+                                         [(b . _) (datum->syntax #'b 'begin)]))))
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Check that attacks are thwarted via `syntax-local-get-shadower'
 ;; or `make-syntax-delta-introducer':

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/utils/arm.rkt

@@ -5,14 +5,10 @@
 
 ;; For simplicity, protect everything produced by Typed Racket.
 (define (arm stx)
-  (syntax-case stx (module module* #%plain-module-begin
+  (syntax-case stx (#%plain-module-begin
                     #%require #%provide #%declare begin
                     define-values define-syntaxes
                     begin-for-syntax)
-    [(module name initial-import mb)
-     (quasisyntax/loc stx (module name initial-import #,(arm #'mb)))]
-    [(module* name initial-import mb)
-     (quasisyntax/loc stx (module* name initial-import #,(arm #'mb)))]
     [(#%plain-module-begin . _) (syntax-property (syntax-arm stx)
                                                  'taint-mode
                                                  'opaque)]

racket/src/racket/src/fun.c

@@ -1776,8 +1776,6 @@ cert_with_specials(Scheme_Object *code,
         name = SCHEME_STX_CAR(name);
 	if (SCHEME_STX_SYMBOLP(name)) {
 	  if (scheme_stx_module_eq_x(scheme_begin_stx, name, phase)
-              || scheme_stx_module_eq_x(scheme_module_stx, name, phase)
-              || scheme_stx_module_eq_x(scheme_modulestar_stx, name, phase)
               || scheme_stx_module_eq_x(scheme_module_begin_stx, name, phase)) {
 	    trans = 1;
 	    next_cadr_deflt = 0;
@@ -1815,7 +1813,7 @@ cert_with_specials(Scheme_Object *code,
     if (SCHEME_PAIRP(code))
       return v;
 
-    return scheme_datum_to_syntax(v, code, code, 0, 1);
+    return scheme_datum_to_syntax(v, code, scheme_false, 0, 1);
   } else if (SCHEME_STX_NULLP(code))
     return code;
 

racket/src/racket/src/module.c

@@ -7169,7 +7169,8 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env,
                                 Module_Begin_Expand_State *super_bxs,
                                 Scheme_Object *super_phase_shift)
 {
-  Scheme_Object *fm, *nm, *ii, *iidx, *self_modidx, *rmp, *rn_set, *mb_ctx;
+  Scheme_Object *fm, *disarmed_form;
+  Scheme_Object *nm, *ii, *iidx, *self_modidx, *rmp, *rn_set, *mb_ctx;
   Scheme_Module *iim;
   Scheme_Env *menv, *top_env;
   Scheme_Comp_Env *benv;
@@ -7198,7 +7199,9 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env,
   if (!scheme_is_toplevel(env))
     scheme_wrong_syntax(NULL, NULL, form, "not in a module-definition context");
 
-  fm = SCHEME_STX_CDR(form);
+  disarmed_form = scheme_stx_taint_disarm(form, NULL);
+
+  fm = SCHEME_STX_CDR(disarmed_form);
   if (!SCHEME_STX_PAIRP(fm))
     scheme_wrong_syntax(NULL, NULL, form, NULL);
   nm = SCHEME_STX_CAR(fm);
@@ -7418,7 +7421,7 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env,
       if (!SCHEME_STXP(fm))
         fm = scheme_datum_to_syntax(fm, scheme_false, scheme_false, 0, 0);
       fm = scheme_add_rename(fm, rn);
-      mb_ctx = scheme_add_rename(form, rn);
+      mb_ctx = scheme_add_rename(disarmed_form, rn);
     } else {
       if (!SCHEME_STXP(fm))
         fm = scheme_datum_to_syntax(fm, scheme_false, scheme_false, 0, 0);
@@ -7483,7 +7486,7 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env,
       Scheme_Object *mb;
       mb = scheme_datum_to_syntax(module_begin_symbol, form, mb_ctx, 0, 0);
       fm = scheme_make_pair(mb, scheme_make_pair(fm, scheme_null));
-      fm = scheme_datum_to_syntax(fm, form, form, 0, 2);
+      fm = scheme_datum_to_syntax(fm, form, disarmed_form, 0, 2);
       fm = scheme_stx_property(fm, module_name_symbol, scheme_resolved_module_path_value(rmp));
       if (ii) {
         /* Since fm is a newly-created syntax object, we need to re-add renamings: */
@@ -7542,7 +7545,7 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env,
     hints = m->hints;
     m->hints = NULL;
 
-    formname = SCHEME_STX_CAR(form);
+    formname = SCHEME_STX_CAR(disarmed_form);
     fm = cons(formname,
 	      cons(nm,
 		   cons(orig_ii, cons(fm, scheme_null))));