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

Added forgotten with-resources-aligned to delete-directory, 

read-symlink, set-file-times, and open-directory-stream.
This commit is contained in:
mainzelm 2003-02-07 13:01:54 +00:00
parent 93439648aa
commit 921bb20f23
2 changed files with 33 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
scsh/filesys.scm
View File

@ -119,3 +119,16 @@
(list cwd-resource euid-resource egid-resource)
(lambda ()
(%rename-file old-fname new-fname))))))
(define (read-symlink path)
(with-resources-aligned
(list cwd-resource euid-resource egid-resource)
(lambda ()
(%read-symlink path))))
(define (delete-directory path)
(with-resources-aligned
(list cwd-resource euid-resource egid-resource)
(lambda ()
(%delete-directory path))))

33
scsh/syscalls.scm
View File

@ -243,11 +243,11 @@
(fname (ensure-file-name-is-nondirectory path)))
(%%create-directory fname mode)))
(import-os-error-syscall read-symlink (path) "scsh_readlink")
(import-os-error-syscall %read-symlink (path) "scsh_readlink")
(import-os-error-syscall %rename-file (old-name new-name) "scsh_rename")
(import-os-error-syscall delete-directory (path) "scsh_rmdir")
(import-os-error-syscall %delete-directory (path) "scsh_rmdir")
(import-os-error-syscall %utime (path ac m) "scm_utime")
@ -256,15 +256,18 @@
;;; (SET-FILE-TIMES path [access-time mod-time])
(define (set-file-times path . maybe-times)
(if (pair? maybe-times)
(let* ((access-time (real->exact-integer (car maybe-times)))
(mod-time (if (pair? (cddr maybe-times))
(error "Too many arguments to set-file-times/errno"
(cons path maybe-times))
(real->exact-integer (cadr maybe-times)))))
(%utime path access-time
mod-time ))
(%utime-now path)))
(with-resources-aligned
(list cwd-resource euid-resource egid-resource)
(lambda ()
(if (pair? maybe-times)
(let* ((access-time (real->exact-integer (car maybe-times)))
(mod-time (if (pair? (cddr maybe-times))
(error "Too many arguments to set-file-times/errno"
(cons path maybe-times))
(real->exact-integer (cadr maybe-times)))))
(%utime path access-time
mod-time ))
(%utime-now path)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; STAT
@ -575,8 +578,12 @@
(define-record-resumer type/directory-stream #f)
(define (open-directory-stream name)
(let ((dir (make-directory-stream name
(open-dir name))))
(let ((dir (make-directory-stream
name
(with-resources-aligned
(list cwd-resource euid-resource egid-resource)
(lambda ()
(open-dir name))))))
(add-finalizer! dir close-directory-stream)
dir))