With-umask-align for the rest of the syscalls.

This commit is contained in:
mainzelm 2001-07-10 14:52:57 +00:00
parent 7a45d9cc01
commit 75fa4c1852
4 changed files with 25 additions and 17 deletions

View File

@ -328,12 +328,13 @@
;;; replace rts/channel-port.scm begin
(define (open-file fname flags . maybe-mode)
(with-cwd-aligned
(let ((fd (apply open-fdes fname flags maybe-mode))
(access (bitwise-and flags open/access-mask)))
((if (or (= access open/read) (= access open/read+write))
make-input-fdport
make-output-fdport)
fd 0))))
(with-umask-aligned
(let ((fd (apply open-fdes fname flags maybe-mode))
(access (bitwise-and flags open/access-mask)))
((if (or (= access open/read) (= access open/read+write))
make-input-fdport
make-output-fdport)
fd 0)))))
(define (open-input-file fname . maybe-flags)
(let ((flags (:optional maybe-flags 0)))
@ -635,16 +636,17 @@
(define (call-with-mumble-file open close)
(lambda (string proc)
(with-cwd-aligned
(let ((port #f))
(dynamic-wind (lambda ()
(if port
(warn "throwing back into a call-with-...put-file"
string)
(set! port (open string))))
(lambda () (proc port))
(lambda ()
(if port
(close port))))))))
(with-umask-aligned
(let ((port #f))
(dynamic-wind (lambda ()
(if port
(warn "throwing back into a call-with-...put-file"
string)
(set! port (open string))))
(lambda () (proc port))
(lambda ()
(if port
(close port)))))))))
;;; replace rts/channel-port.scm begin
(define call-with-input-file

View File

@ -340,6 +340,8 @@
set-umask
with-umask*
(with-umask :syntax)
with-umask-aligned*
(with-umask-aligned :syntax)
process-chdir
process-cwd

View File

@ -411,6 +411,9 @@
(define-simple-syntax (with-cwd-aligned body ...)
(with-cwd-aligned* (lambda () body ...)))
(define-simple-syntax (with-umask-aligned body ...)
(with-cwd-aligned* (lambda () body ...)))
(define-simple-syntax (with-umask mask . body)
(with-umask* mask (lambda () . body)))

View File

@ -545,7 +545,8 @@
(define (open-fdes path flags . maybe-mode) ; mode defaults to 0666
(with-cwd-aligned
(%open path flags (:optional maybe-mode #o666))))
(with-umask-aligned
(%open path flags (:optional maybe-mode #o666)))))
(define-stubless-foreign pipe-fdes () "scheme_pipe")