fix taint behavior of some syntax operations

`syntax-local-get-shadower' and
 `syntax-make-delta-introducer' both taint their
 results when a given syntax object is tainted
(cherry picked from commit 4307bcace5)

collects/scribblings/reference/stx-trans.scrbl

@@ -623,6 +623,9 @@ Thus, the result is an identifier corresponding to the innermost
 shadowing of @racket[id-stx] in the current context if it is shadowed,
 and a module-contextless version of @racket[id-stx] otherwise.
 
+If @racket[id-stx] is @tech{tainted} or @tech{armed}, then the
+resulting identifier is @tech{tainted}.
+
 @transform-time[]}
 
 
@@ -699,7 +702,11 @@ instance of @racket[_orig-id], so that it captures uses with the same
 lexical context as the use of @racket[_m-id].
 
 More typically, however, @racket[syntax-local-make-delta-introducer]
-should be used, since it cooperates with @tech{rename transformers}.}
+should be used, since it cooperates with @tech{rename transformers}.
+
+If @racket[ext-stx] is @tech{tainted} or @tech{armed}, then an
+identifier result from the created procedure is @tech{tainted}.}
+
 
 @defproc[(syntax-local-make-delta-introducer [id identifier?])
          (identifier? . -> . identifier?)]{

collects/tests/racket/stx.rktl

@@ -1526,6 +1526,37 @@
   (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))))))
 
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Check that attacks are thwarted via `syntax-local-get-shadower'
+;; or `make-syntax-delta-introducer':
+
+(module secret-value-42 racket
+   (define secret 42)
+   (define-syntax-rule (m) (even? secret))
+   (provide m))
+(require 'secret-value-42)
+
+(define-syntax (evil-via-shadower stx)
+  (syntax-case stx ()
+    [(_ e)
+     (let* ([ee (local-expand #'e 'expression null)]
+            [id (with-syntax ([(app f x) ee]) #'f)]
+            [okid (syntax-local-get-shadower id)])
+       #`(let ([#,okid values])
+           #,ee))]))
+
+(define-syntax (evil-via-delta-introducer stx)
+  (syntax-case stx ()
+    [(_ e)
+     (let* ([ee (local-expand #'e 'expression null)]
+            [id (with-syntax ([(app f x) ee]) #'f)]
+            [okid ((make-syntax-delta-introducer id #'e) #'even?)])
+       #`(let ([#,okid values])
+           #,ee))]))
+
+(syntax-test #'(evil-via-shadower (m)))
+(syntax-test #'(evil-via-delta-introducer (m)))
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (report-errs)

src/racket/src/env.c

@@ -2088,6 +2088,10 @@ local_get_shadower(int argc, Scheme_Object *argv[])
     sym = scheme_stx_strip_module_context(sym);
     /* Add current module context, if any */
     sym = local_module_introduce(1, &sym);
+
+    if (!scheme_stx_is_clean(orig_sym))
+      sym = scheme_stx_taint(sym);
+
     return sym;
   }
 
@@ -2102,6 +2106,9 @@ local_get_shadower(int argc, Scheme_Object *argv[])
 
     result = scheme_add_rename(result, rn);
 
+    if (!scheme_stx_is_clean(orig_sym))
+      result = scheme_stx_taint(result);
+
     return result;
   }
 }

src/racket/src/syntax.c

@@ -7970,7 +7970,7 @@ Scheme_Object *scheme_transfer_srcloc(Scheme_Object *to, Scheme_Object *from)
 
 static Scheme_Object *delta_introducer(int argc, struct Scheme_Object *argv[], Scheme_Object *p)
 {
-  Scheme_Object *r, *delta;
+  Scheme_Object *r, *delta, *taint_p;
 
   r = argv[0];
 
@@ -7978,11 +7978,15 @@ static Scheme_Object *delta_introducer(int argc, struct Scheme_Object *argv[], S
     scheme_wrong_type("delta-introducer", "syntax", 0, argc, argv);
 
   delta = SCHEME_PRIM_CLOSURE_ELS(p)[0];
+  taint_p = SCHEME_PRIM_CLOSURE_ELS(p)[1];
 
   for(; !SCHEME_NULLP(delta); delta = SCHEME_CDR(delta)) {
     r = scheme_add_remove_mark(r, SCHEME_CAR(delta));
   }
 
+  if (SCHEME_TRUEP(taint_p))
+    r = scheme_stx_taint(r);
+
   return r;
 }
 
@@ -8018,7 +8022,7 @@ static Scheme_Object *extract_phase(const char *who, int pos, int argc, Scheme_O
 
 Scheme_Object *scheme_syntax_make_transfer_intro(int argc, Scheme_Object **argv)
 {
-  Scheme_Object *orig_m1, *m1, *m2, *delta, *a[1];
+  Scheme_Object *orig_m1, *m1, *m2, *delta, *a[2];
   int l1, l2;
   Scheme_Object *phase;
 
@@ -8091,8 +8095,12 @@ Scheme_Object *scheme_syntax_make_transfer_intro(int argc, Scheme_Object **argv)
   }
 
   a[0] = delta;
+  if (scheme_stx_is_clean(argv[0]))
+    a[1] = scheme_false;
+  else
+    a[2] = scheme_true;
 
-  return scheme_make_prim_closure_w_arity(delta_introducer, 1, a, "delta-introducer", 1, 1);
+  return scheme_make_prim_closure_w_arity(delta_introducer, 2, a, "delta-introducer", 1, 1);
 }
 
 static Scheme_Object *bound_eq(int argc, Scheme_Object **argv)