[DRAFT] make-temporary-{file,directory}{,*}: add #:permissions

This commit depends on #3870 and a hypothetical `#:permissions` argument to `copy-file`, where `(copy-file #:permissions #f . args)` would be the default and preserve the current behavior, i.e. copying the permissions of the source file. For more thoughts on changes to `copy-file`, see: <#3870 (comment)> and <#3870 (comment)>. Before merging, it would also need to add tests.
racket · Jan 24, 2022 · 2f6701a · 2f6701a
1 parent fad25e2
commit 2f6701a
Show file tree

Hide file tree

Showing 3 changed files with 82 additions and 26 deletions.
diff --git a/pkgs/racket-doc/scribblings/reference/filesystem.scrbl b/pkgs/racket-doc/scribblings/reference/filesystem.scrbl
@@ -1394,7 +1394,8 @@ will not create it.
                               [#:copy-from copy-from (or/c path-string? #f 'directory) #f]
                               [#:base-dir base-dir (or/c path-string? #f) #f]
                               [compat-copy-from (or/c path-string? #f 'directory) copy-from]
-                              [compat-base-dir (or/c path-string? #f) base-dir])
+                              [compat-base-dir (or/c path-string? #f) base-dir]
+                              [#:permissions permissions (or/c #f (integer-in 0 65535)) #f])
          (and/c path? complete-path?)]{
 
 Creates a new temporary file and returns its path.
@@ -1447,6 +1448,24 @@ then the temporary ``file'' is created as a directory:
 for clarity, prefer @racket[make-temporary-directory] for creating
 temporary directories.
 
+The @racket[permissions] argument determines the initial
+permissions of the temporary file as with
+@racket[open-output-file], @racket[make-directory], or
+@racket[copy-file]. When @racket[permissions] is @racket[#f]
+and @racket[copy-from] is not provided as a path, the
+default permissions limit access to only the creating user,
+which is recommended for security. More specifically, using
+@racket[#f] as @racket[permissions] is equivalent to:
+ @racketblock[
+ (case copy-from
+   [(directory)
+    (bitwise-ior user-read-bit user-write-bit user-execute-bit)]
+   [(#f)
+    (bitwise-ior user-read-bit user-write-bit)]
+   [else
+    #f])
+ ]
+
 When a temporary file is created, it is not opened for reading or
 writing when the path is returned. The client program calling
 @racket[make-temporary-file] is expected to open the file with the
@@ -1464,10 +1483,14 @@ from generating a @racket[template] using the source location.
 @history[
  #:changed "8.4.0.3"
  @elem{Added the @racket[#:copy-from] and @racket[#:base-dir] arguments.}
+ #:changed "8.4.0.4"
+ @elem{Added the @racket[#:permissions] argument and changed
+   the previously-implicit default permissions.}
  ]}
 
 @defproc[(make-temporary-directory [template string? "rkttmp~a"]
-                                   [#:base-dir base-dir (or/c path-string? #f) #f])
+                                   [#:base-dir base-dir (or/c path-string? #f) #f]
+                                   [#:permissions permissions (or/c #f (integer-in 0 65535)) #f])
          (and/c path? complete-path?)]{
 
  Like @racket[make-temporary-file], but
@@ -1482,17 +1505,22 @@ from generating a @racket[template] using the source location.
 
 @history[
  #:added "8.4.0.3"
+ #:changed "8.4.0.4"
+ @elem{Added the @racket[#:permissions] argument and changed
+   the previously-implicit default permissions.}
  ]}
 
 @deftogether[
  (@defproc[(make-temporary-file* [prefix bytes?]
                                  [suffix bytes?]
                                  [#:copy-from copy-from (or/c path-string? #f) #f]
-                                 [#:base-dir base-dir (or/c path-string? #f) #f])
+                                 [#:base-dir base-dir (or/c path-string? #f) #f]
+                                 [#:permissions permissions (or/c #f (integer-in 0 65535)) #f])
            (and/c path? complete-path?)]
    @defproc[(make-temporary-directory* [prefix bytes?]
                                        [suffix bytes?]
-                                       [#:base-dir base-dir (or/c path-string? #f) #f])
+                                       [#:base-dir base-dir (or/c path-string? #f) #f]
+                                       [#:permissions permissions (or/c #f (integer-in 0 65535)) #f])
             (and/c path? complete-path?)])]{
 
  Like @racket[make-temporary-file] and
@@ -1509,6 +1537,9 @@ from generating a @racket[template] using the source location.
 
  @history[
  #:added "8.4.0.3"
+ #:changed "8.4.0.4"
+ @elem{Added the @racket[#:permissions] argument and changed
+   the previously-implicit default permissions.}
  ]}
 
 @defproc[(call-with-atomic-output-file [file path-string?] 

diff --git a/pkgs/racket-test-core/tests/racket/file.rktl b/pkgs/racket-test-core/tests/racket/file.rktl
@@ -359,22 +359,22 @@
 (test 'make-temporary-file object-name make-temporary-file)
 (let-values ([(required accepted) (procedure-keywords make-temporary-file)])
   (test '() 'make-temporary-file-no-required-keywords required)
-  (test '(#:base-dir #:copy-from) 'make-temporary-file-accepts-keywords accepted))
+  (test '(#:base-dir #:copy-from #:permissions) 'make-temporary-file-accepts-keywords accepted))
 (arity-test make-temporary-file* 2 2)
 (test 'make-temporary-file* object-name make-temporary-file*)
 (let-values ([(required accepted) (procedure-keywords make-temporary-file*)])
   (test '() 'make-temporary-file*-no-required-keywords required)
-  (test '(#:base-dir #:copy-from) 'make-temporary-file*-accepts-keywords accepted))
+  (test '(#:base-dir #:copy-from #:permissions) 'make-temporary-file*-accepts-keywords accepted))
 (arity-test make-temporary-directory 0 1)
 (test 'make-temporary-directory object-name make-temporary-directory)
 (let-values ([(required accepted) (procedure-keywords make-temporary-directory)])
   (test '() 'make-temporary-directory-no-required-keywords required)
-  (test '(#:base-dir) 'make-temporary-directory-accepts-keywords accepted))
+  (test '(#:base-dir #:permissions) 'make-temporary-directory-accepts-keywords accepted))
 (arity-test make-temporary-directory* 2 2)
 (test 'make-temporary-directory* object-name make-temporary-directory*)
 (let-values ([(required accepted) (procedure-keywords make-temporary-directory*)])
   (test '() 'make-temporary-directory*-no-required-keywords required)
-  (test '(#:base-dir) 'make-temporary-directory*-accepts-keywords accepted))
+  (test '(#:base-dir #:permissions) 'make-temporary-directory*-accepts-keywords accepted))
 
 ;; tests for using srcloc in templates
 (let ([tf (make-temporary-file)])

diff --git a/racket/collects/racket/file.rkt b/racket/collects/racket/file.rkt
@@ -187,7 +187,16 @@
 ;; various possible errors with the result.
 ;; If the tests pass, it tail-calls `internal-make-temporary-file/directory`.
 
-(define (internal-make-temporary-file/directory who copy-from base-dir make-name)
+(define (internal-make-temporary-file/directory who copy-from base-dir raw-permissions make-name)
+  (define permissions
+    (or raw-permissions
+        (case copy-from
+          [(directory)
+           #o700]
+          [(#f)
+           #o600]
+          [else
+           #f])))
   (define tmpdir (find-system-path 'temp-dir))
   (let loop ([s (current-seconds)]
              [ms (inexact->exact (truncate (current-inexact-milliseconds)))]
@@ -230,9 +239,9 @@
                              (add1 tries)))])
       (if copy-from
           (if (eq? copy-from 'directory)
-              (make-directory pth)
-              (copy-file copy-from pth))
-          (close-output-port (open-output-file pth)))
+              (make-directory pth permissions)
+              (copy-file copy-from pth #:permissions permissions))
+          (close-output-port (open-output-file pth #:permissions permissions)))
       pth)))
 
 (define (check-base-dir who base-dir)
@@ -244,10 +253,16 @@
     (raise-argument-error who "bytes?" x)))
 
 (define (do-make-temporary-file/directory:check-make-name
-         who copy-from base-dir make-name
+         who copy-from base-dir permissions make-name
          #:wrapped-make-name wraped-make-name
          #:complete-with-base-error complete-with-base-error
          #:syntactic-directory-error syntactic-directory-error)
+  ;; check permissions here, since this is the same for all variants
+  (when permissions
+    (unless (and (exact-nonnegative-integer? permissions)
+                 (<= permissions 65535))
+      (raise-argument-error who "(or/c (integer-in 0 65535) #f)" permissions)))
+  ;; check make name
   (define result
     ;; docs promise argument will be a string containing only digits
     (wraped-make-name "0"))
@@ -260,9 +275,9 @@
                         (split-path result)])
             must-be-dir?)
       (syntactic-directory-error result)))
-  (internal-make-temporary-file/directory who copy-from base-dir make-name))
+  (internal-make-temporary-file/directory who copy-from base-dir permissions make-name))
 
-(define (do-make-temporary-file/directory:format who template copy-from base-dir)
+(define (do-make-temporary-file/directory:format who template copy-from base-dir permissions)
   (unless (or (not copy-from)
               (path-string? copy-from)
               (eq? copy-from 'directory))
@@ -278,7 +293,7 @@
     ;; i.e. the result is valid as path, but not for our purposes
     (string-append "given template produced an invalid result;\n " details))
   (do-make-temporary-file/directory:check-make-name
-   who copy-from base-dir make-name
+   who copy-from base-dir permissions make-name
    #:wrapped-make-name
    (λ (digits-str)
      (define result
@@ -320,7 +335,7 @@
       "copy-from" copy-from))))
 
 (define (do-make-temporary-file/directory:bytes-append
-         ctxt prefix suffix copy-from base-dir
+         ctxt prefix suffix copy-from base-dir permissions
          #:directory? directory?)
   (define who
     (if directory?
@@ -344,7 +359,7 @@
     ;; i.e. the result is valid as path, but not for our purposes
     (string-append "given prefix and suffix produced an invalid result;\n " details))
   (do-make-temporary-file/directory:check-make-name
-   who copy-from base-dir
+   who copy-from base-dir permissions
    (λ (digits-str)
      (bytes->path (make-name/bytes digits-str)))
    #:wrapped-make-name
@@ -503,55 +518,65 @@
   (λ ([template "rkttmp~a"]
       #:copy-from [copy-from #f]
       #:base-dir [base-dir #f]
+      #:permissions [permissions #f]
       [compat-copy-from copy-from]
       [compat-base-dir base-dir])
     (do-make-temporary-file/directory:format 'make-temporary-file
-                                             template compat-copy-from compat-base-dir))
+                                             template compat-copy-from compat-base-dir permissions))
   (λ (#:copy-from [copy-from #''#f]
       #:base-dir [base-dir #''#f]
+      #:permissions [permissions #''#f]
       stx proc-id)
     #`(#%app #,proc-id
              '#,(infer-temporary-file-template stx)
              #,copy-from
-             #,base-dir)))
+             #,base-dir
+             #:permissions #,permissions)))
 
 (define-temporary-file/directory-transformer make-temporary-directory
   (λ ([template "rkttmp~a"]
-      #:base-dir [base-dir #f])
+      #:base-dir [base-dir #f]
+      #:permissions [permissions #f])
     (do-make-temporary-file/directory:format 'make-temporary-directory
-                                             template 'directory base-dir))
+                                             template 'directory base-dir permissions))
    (λ (#:base-dir [base-dir #''#f]
+      #:permissions [permissions #''#f]
        stx proc-id)
      #`(#%app #,proc-id
               '#,(infer-temporary-file-template stx)
+              #:permissions #,permissions
               #:base-dir #,base-dir)))
 
 (define-temporary-file/directory-transformer make-temporary-file*
   (λ (#:copy-from [copy-from #f]
       #:base-dir [base-dir #f]
+      #:permissions [permissions #f]
       prefix suffix)
     (do-make-temporary-file/directory:bytes-append
-     #"" prefix suffix copy-from base-dir
+     #"" prefix suffix copy-from base-dir permissions
      #:directory? #f))
   (λ (#:copy-from [copy-from #''#f]
       #:base-dir [base-dir #''#f]
+      #:permissions [permissions #''#f]
       stx proc-id prefix suffix)
     #`(#%app do-make-temporary-file/directory:bytes-append
              #,(infer-temporary-file-context-bytes stx)
-             #,prefix #,suffix #,copy-from #,base-dir
+             #,prefix #,suffix #,copy-from #,base-dir #,permissions
              #:directory? #f)))
 
 (define-temporary-file/directory-transformer make-temporary-directory*
   (λ (#:base-dir [base-dir #f]
+      #:permissions [permissions #f]
       prefix suffix)
     (do-make-temporary-file/directory:bytes-append
-     #"" prefix suffix 'directory base-dir
+     #"" prefix suffix 'directory base-dir permissions
      #:directory? #t))
   (λ (#:base-dir [base-dir #''#f]
+      #:permissions [permissions #''#f]
       stx proc-id prefix suffix)
     #`(#%app do-make-temporary-file/directory:bytes-append
              #,(infer-temporary-file-context-bytes stx)
-             #,prefix #,suffix 'directory #,base-dir
+             #,prefix #,suffix 'directory #,base-dir #,permissions
              #:directory? #t)))