suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fix local member info leak due to opaque class/c

Browse Source 
Prior to this change, the use of opaque class contracts
could reveal the printed names of local members names
in a class.
This commit is contained in:
Asumu Takikawa 2012-04-25 00:31:13 -04:00
parent 5e4b9e3aca
commit 841b190ef7
2 changed files with 52 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/racket/private/class-internal.rkt
View File

@ -2580,7 +2580,9 @@
(when (class/c-opaque? ctc)
(for ([m (in-hash-keys method-ht)])
(unless (memq m (class/c-methods ctc))
(fail "method ~a not specified in contract" m))))
(if (not (symbol-interned? m))
(fail "some local member not specified in contract")
(fail "method ~a not specified in contract" m)))))
(for ([m (class/c-inherits ctc)])
(unless (hash-ref method-ht m #f)
(fail "no public method ~a" m)))
@ -2641,7 +2643,9 @@
(when (class/c-opaque? ctc)
(for ([f (in-hash-keys field-ht)])
(unless (memq f (class/c-fields ctc))
(fail "field ~a not specified in contract" f))))
(if (not (symbol-interned? f))
(fail "some local member not specified in contract")
(fail "field ~a not specified in contract" f)))))
(for ([f (class/c-inherit-fields ctc)])
(unless (hash-ref field-ht f #f)
(fail "no public field ~a" f)))))

47
collects/tests/racket/contract-test.rktl
View File

@ -6503,7 +6503,26 @@
(class object% (super-new) (define/public (m x) 3) (define/public (n) 4))
'pos
'neg))
(test/pos-blame
'class/c-first-order-opaque-method-3
'(let ()
(define-local-member-name n)
(contract (class/c #:opaque [m (-> any/c number? number?)])
(class object% (super-new) (define/public (m x) 3) (define/public (n) 4))
'pos
'neg)))
(test/pos-blame
'class/c-first-order-opaque-method-4
'(contract
(class/c #:opaque [m (-> any/c number? number?)])
(let ()
(define-local-member-name n)
(class object% (super-new) (define/public (m x) 3) (define/public (n) 4)))
'pos
'neg))
(test/pos-blame
'class/c-first-order-field-1
'(contract (class/c (field [n number?]))
@ -6545,6 +6564,15 @@
(class object% (super-new) (field [m 5] [n 3]))
'pos
'neg))
(test/pos-blame
'class/c-first-order-opaque-field-2
'(contract (class/c #:opaque (field [m number?]))
(let ()
(define-local-member-name n)
(class object% (super-new) (field [m 5] [n 3])))
'pos
'neg))
;; No true first-order tests here, other than just to make
;; sure they're accepted. For init-field, we can at least
@ -6678,6 +6706,23 @@
'pos
'neg))
(test/pos-blame
'class/c-first-order-opaque-super-3
'(contract (class/c #:opaque)
(class (let ()
(define-local-member-name m)
(class object% (super-new) (define/public (m) 3)))
(super-new))
'pos
'neg))
(test/spec-passed
'class/c-first-order-opaque-super-4
'(contract (class/c #:opaque (super m) m)
(class (class object% (super-new) (define/public (m) 3)) (super-new))
'pos
'neg))
(test/pos-blame
'class/c-first-order-inner-1
'(contract (class/c (inner [m (-> any/c number? number?)]))