scsh-conservatory
/
scsh-0.6
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
scsh/newports.scm
View File

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

2
scsh/scsh-interfaces.scm
View File

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

3
scsh/scsh.scm
View File

@ -411,6 +411,9 @@
(define-simple-syntax (with-cwd-aligned body ...) (define-simple-syntax (with-cwd-aligned body ...)
(with-cwd-aligned* (lambda () 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) (define-simple-syntax (with-umask mask . body)
(with-umask* mask (lambda () . body))) (with-umask* mask (lambda () . body)))

3
scsh/syscalls.scm
View File

@ -545,7 +545,8 @@
(define (open-fdes path flags . maybe-mode) ; mode defaults to 0666 (define (open-fdes path flags . maybe-mode) ; mode defaults to 0666
(with-cwd-aligned (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") (define-stubless-foreign pipe-fdes () "scheme_pipe")