change `impersonate-struct' to require evidence that a field is mutable
When supplying an accessor to redirect, either the corresponding field must be accessible through the current inspector, or a mutator for the same field must be redirected, too. Stevie realized that we need this constraint; otherwise, impersonators can implement mutator-like behavior even when the mutator is otherwise secret.
This commit is contained in:
Matthew Flatt
parent
73ce5a4767
commit
99635ab091
|
|
@ -189,7 +189,10 @@ The protocol for a @racket[redirect-proc] depends on the corresponding
|
|||
@racket[_field-v] that @racket[orig-proc] produces for
|
||||
@racket[v]; it must return a replacement for
|
||||
@racket[_field-v]. The corresponding field must not be
|
||||
immutable.}
|
||||
immutable, and either the field's structure type must be
|
||||
accessible via the current @tech{inspector} or one of the other
|
||||
@racket[orig-proc]s must be a structure-field mutator for the
|
||||
same field.}
|
||||
|
||||
@item{A structure-field mutator: @racket[redirect-proc] must accept
|
||||
two arguments, @racket[v] and the value @racket[_field-v]
|
||||
|
|
|
|||
|
|
@ -414,12 +414,18 @@
|
|||
(define-values (prop:green green? green-ref) (make-struct-type-property 'green 'can-impersonate))
|
||||
(define-struct a ([x #:mutable] y))
|
||||
(define-struct (b a) ([z #:mutable]))
|
||||
(define-struct (c b) ([n #:mutable]) #:transparent)
|
||||
(define-struct p (u) #:property prop:green 'green)
|
||||
(define-struct (q p) (v w))
|
||||
(test #t chaperone?/impersonator (chaperone-struct (make-a 1 2) a-x (lambda (a v) v)))
|
||||
(test #t chaperone?/impersonator (chaperone-struct (make-b 1 2 3) a-x (lambda (a v) v)))
|
||||
(test #t chaperone?/impersonator (chaperone-struct (make-a 1 2) a-x (lambda (a v) v)
|
||||
set-a-x! (lambda (a v) v)))
|
||||
(test #t chaperone?/impersonator (chaperone-struct (make-b 1 2 3) a-x (lambda (a v) v)
|
||||
set-a-x! (lambda (a v) v)))
|
||||
(test #t chaperone?/impersonator (chaperone-struct (make-p 1) green-ref (lambda (a v) v)))
|
||||
(test #t chaperone?/impersonator (chaperone-struct (make-a 1 2) a-x (lambda (a v) v) prop:blue 'blue))
|
||||
(test #t chaperone?/impersonator (chaperone-struct (make-a 1 2) a-x (lambda (a v) v)
|
||||
set-a-x! (lambda (a v) v)
|
||||
prop:blue 'blue))
|
||||
(test #t chaperone?/impersonator (chaperone-struct (make-c 1 2 3 4) c-n (lambda (b v) v)))
|
||||
(when is-chaperone
|
||||
(test #t chaperone?/impersonator (chaperone-struct
|
||||
(chaperone-struct (make-a 1 2) a-x (lambda (a v) v) prop:blue 'blue)
|
||||
|
|
@ -555,10 +561,11 @@
|
|||
([chaperone-procedure impersonate-procedure])
|
||||
(let ()
|
||||
(define (test-sub linear? rev?)
|
||||
(define-struct a (x [y #:mutable]) #:property prop:procedure 0)
|
||||
(define-struct a (x [y #:mutable]) #:property prop:procedure 0)
|
||||
(let* ([a1 (make-a (lambda (x) (list x x)) 10)]
|
||||
[get #f]
|
||||
[a2 (chaperone-struct a1 a-y (lambda (a v) (set! get v) v))]
|
||||
[a2 (chaperone-struct a1 a-y (lambda (a v) (set! get v) v)
|
||||
set-a-y! (lambda (a v) v))]
|
||||
[pre #f]
|
||||
[post #f]
|
||||
[a3 (chaperone-procedure (if linear? a2 a1)
|
||||
|
|
@ -569,7 +576,8 @@
|
|||
r)
|
||||
z)))]
|
||||
[a2 (if rev?
|
||||
(chaperone-struct a3 a-y (lambda (a v) (set! get v) v))
|
||||
(chaperone-struct a3 a-y (lambda (a v) (set! get v) v)
|
||||
set-a-y! (lambda (a v) v))
|
||||
a2)])
|
||||
(test #t a? a1)
|
||||
(test #t a? a2)
|
||||
|
|
|
|||
|
|
@ -4,6 +4,9 @@ Added raise-argument-error, raise-result-error,
|
|||
raise-arguments-error, raise-range-error
|
||||
racket/contract: added procedure-arity-includes/c
|
||||
racket/sandbox: added sandbox-propagate-exceptions
|
||||
Changed impersonate-struct so that accessor impersonation requires
|
||||
work only if the field is accessible via the current impersonator
|
||||
or a mutator for the same field is also impersonated
|
||||
|
||||
Version 5.3.0.8
|
||||
Required modules are instantiated in the order that they are required
|
||||
|
|
|
|||
|
|
@ -5155,10 +5155,10 @@ static Scheme_Object *do_chaperone_struct(const char *name, int is_impersonator,
|
|||
Scheme_Object *val = argv[0], *proc;
|
||||
Scheme_Object *redirects, *prop, *si_chaperone = scheme_false;
|
||||
Struct_Proc_Info *pi;
|
||||
Scheme_Object *a[1];
|
||||
Scheme_Object *a[1], *inspector, *getter_positions = scheme_null;
|
||||
int i, offset, arity, non_applicable_op, repeat_op;
|
||||
const char *kind;
|
||||
Scheme_Hash_Tree *props = NULL, *red_props = NULL;
|
||||
Scheme_Hash_Tree *props = NULL, *red_props = NULL, *setter_positions = NULL;
|
||||
|
||||
if (argc == 1) return argv[0];
|
||||
|
||||
|
|
@ -5175,6 +5175,11 @@ static Scheme_Object *do_chaperone_struct(const char *name, int is_impersonator,
|
|||
redirects = NULL;
|
||||
}
|
||||
|
||||
if (is_impersonator)
|
||||
inspector = scheme_get_param(scheme_current_config(), MZCONFIG_INSPECTOR);
|
||||
else
|
||||
inspector = NULL;
|
||||
|
||||
for (i = 1; i < argc; i++) {
|
||||
proc = argv[i];
|
||||
|
||||
|
|
@ -5254,16 +5259,33 @@ static Scheme_Object *do_chaperone_struct(const char *name, int is_impersonator,
|
|||
repeat_op = 1;
|
||||
else {
|
||||
if (is_impersonator) {
|
||||
intptr_t field_pos;
|
||||
field_pos = pi->field - (pi->struct_type->name_pos
|
||||
? pi->struct_type->parent_types[pi->struct_type->name_pos - 1]->num_slots
|
||||
: 0);
|
||||
/* Must not be an immutable field. */
|
||||
if (stype->immutables) {
|
||||
if (stype->immutables[pi->field - (pi->struct_type->name_pos
|
||||
? pi->struct_type->parent_types[pi->struct_type->name_pos - 1]->num_slots
|
||||
: 0)])
|
||||
if (stype->immutables[field_pos])
|
||||
scheme_contract_error(name,
|
||||
"cannot replace operation for an immutable field",
|
||||
"operation kind", 0, kind,
|
||||
"operation procedure", 1, a[0],
|
||||
NULL);
|
||||
NULL);
|
||||
}
|
||||
if (!offset) {
|
||||
/* impersonating a getter is allowed only if the structure type is
|
||||
transparent or if the setter is also impersonated (which would prove
|
||||
that the code creating the impersonator has suitable access). */
|
||||
if (!scheme_inspector_sees_part(argv[0], inspector, pi->field)) {
|
||||
getter_positions = scheme_make_pair(scheme_make_pair(scheme_make_integer(pi->field), a[0]),
|
||||
getter_positions);
|
||||
}
|
||||
} else {
|
||||
if (!scheme_inspector_sees_part(argv[0], inspector, pi->field)) {
|
||||
if (!setter_positions)
|
||||
setter_positions = scheme_make_hash_tree(0);
|
||||
setter_positions = scheme_hash_tree_set(setter_positions, scheme_make_integer(pi->field), scheme_true);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -5314,6 +5336,25 @@ static Scheme_Object *do_chaperone_struct(const char *name, int is_impersonator,
|
|||
else
|
||||
si_chaperone = proc;
|
||||
}
|
||||
|
||||
if (is_impersonator) {
|
||||
/* For each getter for a non-transparent field, check that a witness
|
||||
setter was provided */
|
||||
getter_positions = scheme_reverse(getter_positions);
|
||||
while (!SCHEME_NULLP(getter_positions)) {
|
||||
prop = SCHEME_CAR(getter_positions);
|
||||
if (!setter_positions
|
||||
|| !scheme_hash_tree_get(setter_positions, SCHEME_CAR(prop))) {
|
||||
scheme_contract_error(name,
|
||||
"accessor redirection for a non-transparent field requires a mutator redirection",
|
||||
"explanaion", 0, "a mutator redirection acts as a witness that access is allowed",
|
||||
"accessor", 1, SCHEME_CDR(prop),
|
||||
"value to impersonate", 1, argv[0],
|
||||
NULL);
|
||||
}
|
||||
getter_positions = SCHEME_CDR(getter_positions);
|
||||
}
|
||||
}
|
||||
|
||||
if (!redirects) {
|
||||
/* a non-structure chaperone */
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user