~ chicken-core (chicken-5) 517d98bc03d13925d8ea4bc6be477689616a13b2

commit 517d98bc03d13925d8ea4bc6be477689616a13b2
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Thu Dec 16 18:59:10 2010 +0100
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Thu Dec 16 18:59:10 2010 +0100

    added implementation for CR 424 - seems to do something, but needs verification

diff --git a/manual/Unit posix b/manual/Unit posix
index 59861bef..a9c586dc 100644
--- a/manual/Unit posix	
+++ b/manual/Unit posix	
@@ -529,6 +529,19 @@ the user- and group-ids {{UID}} and {{GID}} (which should be
 exact integers) using the {{chown()}} system call.
 
 
+==== file-creation-mode
+
+<procedure>(file-creation-mode MODE)</procedure>
+
+Returns the initial file permissions used for newly created files
+(as with {{umask(2)}}. You can set the mode by executing
+
+  (set! (file-creation-mode) MODE)
+
+where {{MODE}} is a bitwise combination of one or more of
+the {{perm/...}} flags.
+
+
 === Processes
 
 ==== current-process-id
@@ -1212,6 +1225,7 @@ always returns {{0}}, {{0}}.
 ; {{file-close}} : {{close}}
 ; {{file-access-time}} : {{stat}}
 ; {{file-change-time}} : {{stat}}
+; {{file-creation-mode}} : {{umask}}
 ; {{file-modification-time}} : {{stat}}
 ; {{file-execute-access?}} : {{access}}
 ; {{file-open}} : {{open}}
diff --git a/posix-common.scm b/posix-common.scm
index 89617683..4b755a43 100644
--- a/posix-common.scm
+++ b/posix-common.scm
@@ -361,3 +361,16 @@ EOF
 			 (follow-symlinks #t))
 	    (##sys#find-files dir test action seed limit follow-symlinks dotfiles 'find-files))
 	  args))))
+
+
+;;; umask
+
+(define file-creation-mode
+  (getter-with-setter
+   (lambda ()
+     (let ((um (##core#inline "C_umask" 0)))
+       (##core#inline "C_umask" um)
+       um))
+   (lambda (um)
+     (##core#inline "C_umask" um))
+   "(file-creation-mode mode)"))
diff --git a/posix.import.scm b/posix.import.scm
index 2118ccb9..3414b79e 100644
--- a/posix.import.scm
+++ b/posix.import.scm
@@ -99,6 +99,7 @@
    fifo?
    file-access-time
    file-change-time
+   file-creation-mode
    file-close
    file-control
    file-execute-access?
diff --git a/posixunix.scm b/posixunix.scm
index 847394fa..a9fa2f8a 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -199,6 +199,7 @@ static C_TLS struct stat C_statbuf;
 #define C_test_access(fn, m)     C_fix(access((char *)C_data_pointer(fn), C_unfix(m)))
 #define C_close(fd)         C_fix(close(C_unfix(fd)))
 #define C_sleep             sleep
+#define C_umask(m)          C_fix(umask(C_unfix(m)))
 
 #define C_lstat(fn)         C_fix(lstat((char *)C_data_pointer(fn), &C_statbuf))
 
diff --git a/posixwin.scm b/posixwin.scm
index 0d012da2..f4de4ad7 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -304,6 +304,8 @@ C_free_arg_string(char **where) {
 
 #define C_flushall()	    C_fix(_flushall())
 
+#define C_umask(m)          C_fix(_umask(C_unfix(m)))
+
 #define C_ctime(n)	    (C_secs = (n), ctime(&C_secs))
 
 #define C_tm_set_08(v) \
diff --git a/types.db b/types.db
index 0bbf362d..94488841 100644
--- a/types.db
+++ b/types.db
@@ -776,6 +776,7 @@
 (file-change-time (procedure file-change-time ((or string fixnum)) number))
 (file-close (procedure file-close (fixnum) undefined))
 (file-control (procedure file-control (fixnum fixnum #!optional fixnum) fixnum))
+(file-creation-mode (procedure file-creation-mode () fixnum))
 (file-execute-access? (procedure file-execute-access? (string) boolean))
 (file-link (procedure file-link (string string) undefined))
 (file-lock (procedure file-lock (port #!optional fixnum *) (struct lock)))