From 9e69f341b389626739300aaf402d19df9dcb8287 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 24 Jan 2016 19:35:23 -0700 Subject: [PATCH] fix `unsafe-chaperone-procedure` and `...-procedure*` side channel Also, clarify in docs that `unsafe-chaperone-procedure` cannot really work with an argument created via `chaperone-procedure*`. --- .../scribblings/reference/unsafe.scrbl | 55 +++++++++++++------ .../tests/racket/chaperone.rktl | 33 +++++++++++ racket/src/racket/src/fun.c | 20 ++++--- 3 files changed, 81 insertions(+), 27 deletions(-) diff --git a/pkgs/racket-doc/scribblings/reference/unsafe.scrbl b/pkgs/racket-doc/scribblings/reference/unsafe.scrbl index 55d48a3453..907a6f82f0 100644 --- a/pkgs/racket-doc/scribblings/reference/unsafe.scrbl +++ b/pkgs/racket-doc/scribblings/reference/unsafe.scrbl @@ -441,20 +441,36 @@ fixnum).} [prop impersonator-property?] [prop-val any] ... ...) (and/c procedure? impersonator?)]{ - Like @racket[impersonate-procedure], except it assumes that @racket[replacement-proc] - is already properly wrapping @racket[proc] and so when the procedure that - @racket[unsafe-impersonate-procedure] produces is invoked, the - @racket[replacement-proc] is invoked directly, ignoring @racket[proc]. - In addition, it does not specially handle @racket[impersonator-prop:application-mark], - instead just treating it as an ordinary property if it is supplied as one of the - @racket[prop] arguments. - - This procedure is unsafe only in how it assumes @racket[replacement-proc] is - a proper wrapper for @racket[proc]. It otherwise does all of the checking - that @racket[impersonate-procedure] does. + Like @racket[impersonate-procedure], but assumes that + @racket[replacement-proc] calls @racket[proc] itself. When the result + of @racket[unsafe-impersonate-procedure] is applied to arguments, the + arguments are passed on to @racket[replacement-proc] directly, + ignoring @racket[proc]. At the same time, @racket[impersonator-of?] + reports @racket[#t] when given the result of + @racket[unsafe-impersonate-procedure] and @racket[proc]. - As an example, this function: + If @racket[proc] is itself an impersonator that is derived from + @racket[impersonate-procedure*] or @racket[chaperone-procedure*], + beware that @racket[replacement-proc] will not be able to call it + correctly. Specifically, the impersonator produced by + @racket[unsafe-impersonate-procedure] will not get passed to a + wrapper procedure that was supplied to + @racket[impersonate-procedure*] or @racket[chaperone-procedure*] to + generate @racket[proc]. + + Finally, unlike @racket[impersonate-procedure], + @racket[unsafe-impersonate-procedure] does not specially handle + @racket[impersonator-prop:application-mark] as a @racket[prop]. + + The unsafety of @racket[unsafe-impersonate-procedure] is limited to + the above differences from @racket[impersonate-procedure]. The + contracts on the arguments of @racket[unsafe-impersonate-procedure] are + checked when the arguments are supplied. + + As an example, assuming that @racket[f] accepts a single argument and + is not derived from @racket[impersonate-procedure*] or + @racket[chaperone-procedure*], then @racketblock[(λ (f) (unsafe-impersonate-procedure f @@ -462,7 +478,7 @@ fixnum).} (if (number? x) (error 'no-numbers!) (f x)))))] - is equivalent to this one: + is equivalent to @racketblock[(λ (f) (impersonate-procedure f @@ -470,17 +486,16 @@ fixnum).} (if (number? x) (error 'no-numbers!) x))))] - (except that some error messages start with @litchar{unsafe-impersonate-procedure} - instead of @litchar{impersonate-procedure}). - Similarly the two procedures @racket[_wrap-f1] and + Similarly, with the same assumptions about @racket[f], the following + two procedures @racket[_wrap-f1] and @racket[_wrap-f2] are almost equivalent; they differ only in the error message produced when their arguments are functions that return multiple values (and that they update different global variables). The version using @racket[unsafe-impersonate-procedure] will signal an error in the @racket[let] expression about multiple - value return, whereas the one using @racket[impersonate-procedure] signals - an error from @racket[impersonate-procedure] about multiple value return. + return svalue, whereas the one using @racket[impersonate-procedure] signals + an error from @racket[impersonate-procedure] about multiple return values. @racketblock[(define log1-args '()) (define log1-results '()) (define wrap-f1 @@ -516,6 +531,10 @@ fixnum).} [prop-val any] ... ...) (and/c procedure? chaperone?)]{ Like @racket[unsafe-impersonate-procedure], but creates a @tech{chaperone}. + Since @racket[wrapper-proc] will be called in lieu of @racket[proc], + @racket[wrapper-proc] is assumed to return a chaperone of the value that + @racket[proc] would return. + @history[#:added "6.4.0.4"] } diff --git a/pkgs/racket-test-core/tests/racket/chaperone.rktl b/pkgs/racket-test-core/tests/racket/chaperone.rktl index fe076c9fa2..0ad8518824 100644 --- a/pkgs/racket-test-core/tests/racket/chaperone.rktl +++ b/pkgs/racket-test-core/tests/racket/chaperone.rktl @@ -2386,6 +2386,39 @@ (define cf (unsafe-chaperone-procedure pf (lambda (x) x))) (err/rt-test (cf) (λ (x) (regexp-match #rx"^pf:" (exn-message x))))) +;; Make sure `unsafe-chaperone-procedure` doesn't propagate a bogus +;; identity to a `chaperone-procedure*` wrapper: +(let () + (define found-prop? #f) + + (define (f1 x) x) + + (define-values (prop:p prop:p? prop:get-p) + (make-impersonator-property 'p)) + + (define (mk*) + (chaperone-procedure* + f1 + (λ (f x) + (when (prop:p? f) + (set! found-prop? #t)) + x))) + + (define f2 (mk*)) + (define f2x (mk*)) + + (define f3 (unsafe-chaperone-procedure f2 f2)) + (define f3x (unsafe-chaperone-procedure f2 (lambda (v) + (f2x v) + (f2 v)))) + + (define f4 (chaperone-procedure f3 #f prop:p 1234)) + + (test 1 f4 1) + (test #f values found-prop?) + (test 1 f3x 1) + (test #f values found-prop?)) + ;; ---------------------------------------- (let () diff --git a/racket/src/racket/src/fun.c b/racket/src/racket/src/fun.c index abbcf8e0d5..0c14b8d5c0 100644 --- a/racket/src/racket/src/fun.c +++ b/racket/src/racket/src/fun.c @@ -3627,15 +3627,17 @@ static Scheme_Object *do_chaperone_procedure(const char *name, const char *whati if (is_unsafe || SCHEME_FALSEP(argv[1])) SCHEME_CHAPERONE_FLAGS(px) |= SCHEME_PROC_CHAPERONE_CALL_DIRECT; - /* If there's a `pass_self` chaperone in px->prev, then we'll need - to pass the self proc along. */ - for (val = px->prev; SCHEME_P_CHAPERONEP(val); val = ((Scheme_Chaperone *)val)->prev) { - px2 = (Scheme_Chaperone *)val; - if (SCHEME_VECTORP(px2->redirects) && (SCHEME_VEC_SIZE(px2->redirects) & 0x1)) { - if ((SCHEME_VEC_SIZE(px2->redirects) > 3) - || SCHEME_IMMUTABLEP(px2->redirects)) - SCHEME_SET_IMMUTABLE(px->redirects); - break; + if (!is_unsafe) { + /* If there's a `pass_self` chaperone in px->prev, then we'll need + to pass the self proc along. */ + for (val = px->prev; SCHEME_P_CHAPERONEP(val); val = ((Scheme_Chaperone *)val)->prev) { + px2 = (Scheme_Chaperone *)val; + if (SCHEME_VECTORP(px2->redirects) && (SCHEME_VEC_SIZE(px2->redirects) & 0x1)) { + if ((SCHEME_VEC_SIZE(px2->redirects) > 3) + || SCHEME_IMMUTABLEP(px2->redirects)) + SCHEME_SET_IMMUTABLE(px->redirects); + break; + } } }