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

security-guard-check-network: fix contract

Browse Source 
CS was correct, but BC and the documentation were too strict.

Closes #1763
This commit is contained in:
Matthew Flatt 2021-04-26 18:10:01 -06:00
parent 5b66a2e590
commit a2d724fff6
3 changed files with 21 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
pkgs/racket-doc/scribblings/foreign/file.scrbl
View File

@ -56,8 +56,8 @@ the same as for @racket[security-guard-check-file].
@defproc[(security-guard-check-network @defproc[(security-guard-check-network
[who symbol?] [who symbol?]
[host string?] [host (or/c string? #f)]
[port (integer-in 1 65535)] [port (or/c (integer-in 1 65535) #f)]
[mode (or/c 'client 'server)]) [mode (or/c 'client 'server)])
void?]{ void?]{

8
pkgs/racket-test-core/tests/racket/file.rktl
View File

@ -2122,7 +2122,9 @@
(sc-run #t #:check security-guard-check-network (sc-run #t #:check security-guard-check-network
"localhost" 500 'client) "localhost" 500 'client)
(sc-run #t #:check security-guard-check-network (sc-run #t #:check security-guard-check-network
"localhost" 500 'server)) "localhost" 500 'server)
(sc-run #t #:check security-guard-check-network
#f #f 'server))
(parameterize ((current-security-guard sg-ro)) (parameterize ((current-security-guard sg-ro))
(sc-run #t "foo.txt" '(read)) (sc-run #t "foo.txt" '(read))
@ -2138,7 +2140,9 @@
(sc-run #t #:check security-guard-check-network (sc-run #t #:check security-guard-check-network
"localhost" 500 'client) "localhost" 500 'client)
(sc-run #f #:check security-guard-check-network (sc-run #f #:check security-guard-check-network
"localhost" 500 'server)) "localhost" 500 'server)
(sc-run #f #:check security-guard-check-network
#f #f 'server))
(parameterize ((current-security-guard sg-priv)) (parameterize ((current-security-guard sg-priv))
(sc-run #t pub-mod '(read)) (sc-run #t pub-mod '(read))

18
racket/src/bc/src/thread.c
View File

@ -8589,22 +8589,26 @@ static Scheme_Object *security_guard_check_network(int argc, Scheme_Object *argv
if (!SCHEME_SYMBOLP(argv[0])) if (!SCHEME_SYMBOLP(argv[0]))
scheme_wrong_contract("security-guard-check-network", "symbol?", 0, argc, argv); scheme_wrong_contract("security-guard-check-network", "symbol?", 0, argc, argv);
if (!SCHEME_CHAR_STRINGP(argv[1])) if (SCHEME_TRUEP(argv[1]) && !SCHEME_CHAR_STRINGP(argv[1]))
scheme_wrong_contract("security-guard-check-network", "string?", 1, argc, argv); scheme_wrong_contract("security-guard-check-network", "(or/c string? #f)", 1, argc, argv);
if (!SCHEME_INTP(argv[2]) if (SCHEME_TRUEP(argv[2])
&& (!SCHEME_INTP(argv[2])
|| (SCHEME_INT_VAL(argv[2]) < 1) || (SCHEME_INT_VAL(argv[2]) < 1)
|| (SCHEME_INT_VAL(argv[2]) > 65535)) || (SCHEME_INT_VAL(argv[2]) > 65535)))
scheme_wrong_contract("security-guard-check-network", "(integer-in 1 65535)", 2, argc, argv); scheme_wrong_contract("security-guard-check-network", "(or/c (integer-in 1 65535) #f)", 2, argc, argv);
if (!SAME_OBJ(argv[3], client_symbol) && !SAME_OBJ(argv[3], server_symbol)) if (!SAME_OBJ(argv[3], client_symbol) && !SAME_OBJ(argv[3], server_symbol))
scheme_wrong_contract("security-guard-check-network", "(or/c 'client'server)", 3, argc, argv); scheme_wrong_contract("security-guard-check-network", "(or/c 'client'server)", 3, argc, argv);
if (SCHEME_TRUEP(argv[1]))
a = scheme_char_string_to_byte_string(argv[1]); a = scheme_char_string_to_byte_string(argv[1]);
else
a = NULL;
scheme_security_check_network(scheme_symbol_val(argv[0]), scheme_security_check_network(scheme_symbol_val(argv[0]),
SCHEME_BYTE_STR_VAL(a), a ? SCHEME_BYTE_STR_VAL(a) : NULL,
SCHEME_INT_VAL(argv[2]), SCHEME_TRUEP(argv[2]) ? SCHEME_INT_VAL(argv[2]) : 0,
SAME_OBJ(argv[3], client_symbol)); SAME_OBJ(argv[3], client_symbol));
return scheme_void; return scheme_void;