repair chainges to ffi/file

Bring back the exported `_file/guard`, `_file/r`, and `_file/rw`;
restore/move tests in "file.rktl" test suite; and add docs for new
functions.

pkgs/racket-doc/scribblings/foreign/file.scrbl

@@ -21,6 +21,7 @@ behalf the security check is performed; it is passed to the security
 guard to use in access-denied errors.
 }
 
+
 @defproc[(_file/guard [perms (listof (or/c 'read 'write 'execute 'delete 'exists))]
                       [who symbol? '_file/guard])
          ctype?]{
@@ -36,6 +37,33 @@ security guard grants access on the resulting complete path with
 @defthing[_file/r ctype?]
 @defthing[_file/rw ctype?]]]{
 
-Equivalent to @racket[(_file/guard '(read))] and @racket[(_file/guard
-'(read write))], respectively.
-}
+Equivalent to @racket[(_file/guard '(read) '_file/r)] and
+@racket[(_file/guard '(read write) '_file/rw)], respectively.}
+
+
+@defproc[(security-guard-check-file-link
+           [who symbol?]
+           [path path-string?]
+           [dest path-string?])
+         void?]{
+
+Checks whether @racket[(current-security-guard)] permits link creation
+of @racket[path] as a link @racket[dest]. The symbol @racket[who] is
+the same as for @racket[security-guard-check-file].
+
+@history[#:added "6.9.0.5"]}
+
+
+@defproc[(security-guard-check-network
+           [who symbol?]
+           [host string?]
+           [port (integer-in 1 65535)]
+           [mode (or/c 'client 'server)])
+         void?]{
+
+Checks whether @racket[(current-security-guard)] permits network
+accesst at @racket[host] and @racket[port] in server or client
+mode as specified by @racket[mode]. The symbol @racket[who] is the
+same as for @racket[security-guard-check-file].
+
+@history[#:added "6.9.0.5"]}

pkgs/racket-test-core/tests/racket/file.rktl

@@ -1,5 +1,7 @@
 
 (load-relative "loadtest.rktl")
+(require ffi/file
+         ffi/unsafe)
 
 (Section 'file)
 
@@ -1653,6 +1655,101 @@
 (parameterize ([current-security-guard (make-file-sg '())])
   (test #f regexp-match? "unknown machine" (system-type 'machine)))
 
+
+;; The `ffi/file` library - - - - - - - - - - - - - - - - - - -
+
+(let ()
+  (define pub-mod (collection-file-path "list.rkt" "racket"))
+  (define priv-mod (collection-file-path "stx.rkt" "racket/private"))
+
+  (define sg0 (current-security-guard))
+
+  (define sg-ro
+    (make-security-guard
+     sg0
+     (lambda (who path modes)
+       (when (or (memq 'write modes) (memq 'delete modes))
+         (error who "write/delete not allowed")))
+     (lambda (who host port mode)
+       (unless (eq? mode 'client)
+         (error who "servers not allowed")))
+     (lambda (who path to)
+       (unless (equal? (path->string to) "chain")
+         (error who "only chain links allowed")))))
+
+  (define sg-priv
+    (make-security-guard
+     sg0
+     (lambda (who path modes)
+       (when (and path (regexp-match #rx"private" (path->string path)))
+         (error who "no access to private paths: ~e" path)))
+     void void))
+
+  (define (mk-fun modes)
+    ;; receives path pointer, casts as int, who cares
+    (get-ffi-obj "scheme_make_integer_value" (ffi-lib #f)
+                 (_fun (path) ::
+                       (path : (_file/guard modes 'me))
+                       -> _scheme)))
+  
+  (define (fun path modes)
+    ((mk-fun modes) path))
+
+  (define ok-exn? 
+    (lambda (x)
+      (and (exn:fail? x)
+           (regexp-match #rx"^me: " (exn-message x)))))
+
+  (define (sc-run #:check [security-guard-check security-guard-check-file]
+                  ok? . args)
+    (if ok?
+        (begin
+          (apply test (void) security-guard-check 'me args)
+          (when (eq? security-guard-check security-guard-check-file)
+            (test (void) void (apply fun args))))
+        (begin
+          (err/rt-test (apply security-guard-check 'me args) ok-exn?)
+          (when (eq? security-guard-check security-guard-check-file)
+            (err/rt-test (apply fun args) ok-exn?)))))
+
+  (parameterize ((current-security-guard sg0))
+    (sc-run #t "foo.txt" '(read))
+    (sc-run #t "bar.txt" '(write delete))
+    (sc-run #t pub-mod '(read))
+    (sc-run #t pub-mod '(write))
+    (sc-run #t priv-mod '(read))
+    (sc-run #t priv-mod '(read write delete))
+    (sc-run #t #:check security-guard-check-file-link
+            priv-mod "chain")
+    (sc-run #t #:check security-guard-check-file-link
+            priv-mod "other")
+    (sc-run #t #:check security-guard-check-network
+            "localhost" 500 'client)
+    (sc-run #t #:check security-guard-check-network
+            "localhost" 500 'server))
+
+  (parameterize ((current-security-guard sg-ro))
+    (sc-run #t "foo.txt" '(read))
+    (sc-run #f "bar.txt" '(write delete))
+    (sc-run #t pub-mod '(read))
+    (sc-run #f pub-mod '(write))
+    (sc-run #t priv-mod '(read))
+    (sc-run #f priv-mod '(read write delete))
+    (sc-run #t #:check security-guard-check-file-link
+            priv-mod "chain")
+    (sc-run #f #:check security-guard-check-file-link
+            priv-mod "other")
+    (sc-run #t #:check security-guard-check-network
+            "localhost" 500 'client)
+    (sc-run #f #:check security-guard-check-network
+            "localhost" 500 'server))
+
+  (parameterize ((current-security-guard sg-priv))
+    (sc-run #t pub-mod '(read))
+    (sc-run #t pub-mod '(write))
+    (sc-run #f priv-mod '(read))
+    (sc-run #f priv-mod '(read write delete))))
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Check `in-directory'
 

racket/collects/ffi/file.rkt

@@ -1,9 +1,28 @@
 #lang racket/base
-(require (only-in '#%paramz
+(require ffi/unsafe
+         (only-in '#%paramz
                   security-guard-check-file
                   security-guard-check-file-link
                   security-guard-check-network))
 
 (provide security-guard-check-file
          security-guard-check-file-link
-         security-guard-check-network)
+         security-guard-check-network
+
+         _file/guard
+         _file/r
+         _file/rw)
+
+(define (_file/guard modes [who '_file/guard])
+  (unless (symbol? who)
+    (raise-argument-error '_file/guard "symbol?" who))
+  (make-ctype
+   _path
+   (lambda (p)
+     (let ([cp (cleanse-path (path->complete-path p))])
+       (security-guard-check-file who cp modes)
+       cp))
+   #f))
+
+(define _file/r (_file/guard '(read) '_file/r))
+(define _file/rw (_file/guard '(read write) '_file/rw))

racket/src/racket/src/thread.c

@@ -8735,13 +8735,16 @@ static Scheme_Object *security_guard_check_network(int argc, Scheme_Object *argv
       || (SCHEME_INT_VAL(argv[2]) < 1)
       || (SCHEME_INT_VAL(argv[2]) > 65535))
     scheme_wrong_contract("security-guard-check-network", "(integer-in 1 65535)", 2, argc, argv);
+  
+  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);
 
   a = scheme_char_string_to_byte_string(argv[1]);
   
   scheme_security_check_network(scheme_symbol_val(argv[0]),
                                 SCHEME_BYTE_STR_VAL(a),
                                 SCHEME_INT_VAL(argv[2]),
-                                SCHEME_TRUEP(argv[3]));
+                                SAME_OBJ(argv[3], client_symbol));
 
   return scheme_void;
 }