Update of /cvsroot/scsh/scsh-0.6/scsh
In directory usw-pr-cvs1:/tmp/cvs-serv20472
Modified Files:
newports.scm scsh-interfaces.scm scsh.scm syscalls.scm
Log Message:
With-umask-align for the rest of the syscalls.
Index: newports.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/newports.scm,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -r1.11 -r1.12
*** newports.scm 2001/07/07 19:29:29 1.11
--- newports.scm 2001/07/10 14:52:57 1.12
***************
*** 329,338 ****
(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))))
(define (open-input-file fname . maybe-flags)
--- 329,339 ----
(define (open-file fname flags . maybe-mode)
(with-cwd-aligned
! (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)
***************
*** 636,649 ****
(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))))))))
;;; replace rts/channel-port.scm begin
--- 637,651 ----
(lambda (string proc)
(with-cwd-aligned
! (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
Index: scsh-interfaces.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/scsh-interfaces.scm,v
retrieving revision 1.22
retrieving revision 1.23
diff -C2 -r1.22 -r1.23
*** scsh-interfaces.scm 2001/07/09 18:29:26 1.22
--- scsh-interfaces.scm 2001/07/10 14:52:57 1.23
***************
*** 341,344 ****
--- 341,346 ----
with-umask*
(with-umask :syntax)
+ with-umask-aligned*
+ (with-umask-aligned :syntax)
process-chdir
Index: scsh.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/scsh.scm,v
retrieving revision 1.16
retrieving revision 1.17
diff -C2 -r1.16 -r1.17
*** scsh.scm 2001/07/09 21:23:04 1.16
--- scsh.scm 2001/07/10 14:52:57 1.17
***************
*** 412,415 ****
--- 412,418 ----
(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)))
Index: syscalls.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/syscalls.scm,v
retrieving revision 1.22
retrieving revision 1.23
diff -C2 -r1.22 -r1.23
*** syscalls.scm 2001/07/09 21:23:04 1.22
--- syscalls.scm 2001/07/10 14:52:57 1.23
***************
*** 546,550 ****
(define (open-fdes path flags . maybe-mode) ; mode defaults to 0666
(with-cwd-aligned
! (%open path flags (:optional maybe-mode #o666))))
--- 546,551 ----
(define (open-fdes path flags . maybe-mode) ; mode defaults to 0666
(with-cwd-aligned
! (with-umask-aligned
! (%open path flags (:optional maybe-mode #o666)))))
|