+ user-effective-uid and -gid per thread.

+ alignments for euid- and egid-resource
+ argument to chdir is now optional and defaults to (home-dir)

scsh/filesys.scm

@@ -54,7 +54,7 @@
 		      ;;; broken exception system
 			(else (list err syscall fname)))))
 		(with-resources-aligned 
-		 (list cwd-resource umask-resource)
+		 (list cwd-resource umask-resource euid-resource egid-resource)
 		 (lambda ()
 		   (makeit fname)))
 		#f))))
@@ -116,6 +116,6 @@
 		 (y-or-n? (string-append "rename-file:" new-fname
 					 " already exists. Delete"))))
 	(with-resources-aligned 
-	 (list cwd-resource)
+	 (list cwd-resource euid-resource egid-resource)
 	 (lambda ()
 	   (%rename-file old-fname new-fname))))))

scsh/scsh-interfaces.scm

@@ -374,7 +374,14 @@
 	  user-supplementary-gids
 	  set-uid
 	  set-gid
-	  set-effective-gid
+	  set-user-effective-uid
+	  set-user-effective-gid
+	  with-user-effective-uid*
+	  with-user-effective-gid*
+	  ((with-user-effective-uid 
+	    with-user-effective-gid):syntax)
+	  euid-resource
+	  egid-resource
 
 	  system-name
 	  process-times

scsh/scsh.scm

@@ -179,11 +179,12 @@
     (if (not (string=? thread-cwd (cwd-cache)))
 	(change-and-cache-cwd thread-cwd))))
 
-(define (chdir cwd)
+(define (chdir . maybe-dir)
+  (let ((dir (:optional maybe-dir (home-dir))))
     (with-lock cwd-lock
       (lambda ()
-      (change-and-cache-cwd cwd)
+	(change-and-cache-cwd dir)
-      (thread-set-cwd! (cwd-cache)))))
+	(thread-set-cwd! (cwd-cache))))))
 
 (define-record-type resource :resource
   (make-resource align! lock)
@@ -212,7 +213,7 @@
 ;;  (with-cwd-aligned (really-delete-file fname)))
 
 (define cwd-reinitializer
-  (make-reinitializer (lambda () (warn "calling resumer") (initialize-cwd))))
+  (make-reinitializer (lambda () (initialize-cwd))))
 
 
 (initialize-cwd)
@@ -255,11 +256,6 @@
 	     (umask-cache)))))
     (let-umask changed-umask thunk)))
 
-;; Align the value of the Unix umask with scsh's value.
-;; Since another thread could disalign, this call and
-;; any ensuring syscall that relies upon it should
-;; be "glued together" with the umask lock.
-
 (define (align-umask!)
   (let ((thread-umask (umask)))
     (if (not (= thread-umask (umask-cache)))
@@ -273,22 +269,102 @@
 
 (define umask-resource (make-resource align-umask! umask-lock))
 
-;; example syscall
-;; (define (exported-delete-file fname)
-;;  (with-cwd-aligned (really-delete-file fname)))
-
 (define umask-reinitializer
-  (make-reinitializer (lambda () (warn "calling resumer") (initialize-umask))))
+  (make-reinitializer (lambda () (initialize-umask))))
 
 
 (initialize-umask)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; effective uid and gid per thread
 
+(define-syntax make-Xid-resource 
+  (syntax-rules ()
+    ((make-Xid-resource 
+      process-user-effective-Xid set-process-user-effective-Xid
+      process-set-Xid set-Xid
+      align-eXid! eXid-resource
+      user-effective-Xid set-user-effective-Xid with-user-effective-Xid*)
+     (begin
+       (define *eXid-cache* 'uninitialized)
+       (define eXid-lock (make-lock))
+     
+       (define (initialize-eXid)
+	 (set! *eXid-cache* (process-user-effective-Xid))
+	 (set! $eXid
+	       (make-preserved-thread-fluid
+		(eXid-cache))))
+
+       (define (eXid-cache)
+	 *eXid-cache*)
+
+;; Actually do the syscall and update the cache
+;; assumes the resource lock obtained
+       (define (change-and-cache-eXid new-eXid)
+	 (set-process-user-effective-Xid new-eXid)
+	 (set! *eXid-cache* (process-user-effective-Xid)))
+
+;; The thread-specific eXid: A thread fluid
+
+       (define $eXid 'empty-eXid-value)
+
+       (define (user-effective-Xid) (thread-fluid $eXid))
+       (define (thread-set-eXid! new-eXid) (set-thread-fluid! $eXid new-eXid))
+       (define (let-eXid new-eXid thunk)
+	 (let-thread-fluid $eXid new-eXid thunk))
+
+;; set-Xid will affect the effective X id
+       (define (set-Xid Xid)
+	 (with-lock eXid-lock
+	   (lambda ()
+	     (process-set-Xid Xid)
+	     (set! *eXid-cache* (process-user-effective-Xid)))))
+
+       (define (with-user-effective-Xid* new-eXid thunk)
+	 (let ((changed-eXid
+		(with-lock eXid-lock
+		  (lambda ()
+		    (change-and-cache-eXid new-eXid)
+		    (eXid-cache)))))
+	   (let-eXid changed-eXid thunk)))
+
+       (define (align-eXid!)
+	 (let ((thread-eXid (user-effective-Xid)))
+	   (if (not (= thread-eXid (eXid-cache)))
+	       (change-and-cache-eXid thread-eXid))))
+
+       (define (set-user-effective-Xid new-eXid)
+	 (with-lock eXid-lock
+	   (lambda ()
+	     (change-and-cache-eXid new-eXid)
+	     (thread-set-eXid! (eXid-cache)))))
+
+       (define eXid-resource (make-resource align-eXid! eXid-lock))
+
+       (define eXid-reinitializer
+	 (make-reinitializer (lambda () (initialize-eXid))))
+
+       (initialize-eXid)
+       ))))
+
+(make-Xid-resource 
+ process-user-effective-uid set-process-user-effective-uid
+ process-set-uid set-uid
+ align-euid! euid-resource
+ user-effective-uid set-user-effective-uid with-user-effective-uid*)
+
+(make-Xid-resource 
+ process-user-effective-gid set-process-user-effective-gid
+ process-set-gid set-gid
+ align-egid! egid-resource
+ user-effective-gid set-user-effective-gid with-user-effective-gid*)
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; ensure S48 is aligned too
 
 (set-with-fs-context-aligned*! 
  (lambda (thunk)
-   (with-resources-aligned (list cwd-resource umask-resource) thunk)))
+   (with-resources-aligned 
+    (list cwd-resource umask-resource euid-resource egid-resource) 
+    thunk)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Environment per thread
@@ -326,11 +402,6 @@
       (change-and-cache-env env)))
   (let-env env thunk))
 
-;; Align the value of the Unix env with scsh's value.
-;; Since another thread could disalign, this call and
-;; any ensuring syscall that relies upon it should
-;; be "glued together" with the env lock.
-
 (define (align-env!)
   (let ((res (thread-read-env)))
     (if (not (env=? res (env-cache)))
@@ -344,10 +415,6 @@
 
 (define environ-resource (make-resource align-env! env-lock))
 
-;; example syscall
-;; (define (exported-delete-file fname)
-;;  (with-cwd-aligned (really-delete-file fname)))
-
 (define env-reinitializer
   (make-reinitializer install-env))
 
@@ -519,6 +586,11 @@
 (define-simple-syntax (with-total-env env . body)
   (with-total-env* `env (lambda () . body)))
 
+(define-simple-syntax (with-user-effective-uid uid . body)
+  (with-user-effective-uid* uid (lambda () . body)))
+
+(define-simple-syntax (with-user-effective-gid gid . body)
+  (with-user-effective-gid* gid (lambda () . body)))
 
 (define (call/temp-file writer user)
   (let ((fname #f))
@@ -947,7 +1019,8 @@
 
 (define (exec/env prog env . arglist)
   (flush-all-ports)
-  (with-resources-aligned (list environ-resource cwd-resource umask-resource)
+  (with-resources-aligned 
+   (list environ-resource cwd-resource umask-resource euid-resource egid-resource)
    (lambda ()
      (%exec prog (cons prog arglist) env))))
 
@@ -964,7 +1037,7 @@
 (define (exec-path/env prog env . arglist)
   (flush-all-ports)
   (with-resources-aligned 
-   (list environ-resource cwd-resource umask-resource)
+   (list environ-resource cwd-resource umask-resource euid-resource egid-resource)
    (lambda ()
      (let ((prog (stringify prog)))
        (if (string-index prog #\/)

scsh/syscalls.scm

@@ -15,7 +15,7 @@
 ;;; You can't throw an error within a handler
 ;;;
 
-;;; Move this to somewhere else as soon as Marc published his SRFI
+;;; Move this to somewhere else as soon as Marc has published his SRFI
 (define (continuation-capture receiver)
   ((call-with-current-continuation
     (lambda (cont)
@@ -111,22 +111,22 @@
 
 (import-os-error-syscall user-gid  () "scsh_getgid")
 
-(import-os-error-syscall user-effective-gid () "scsh_getegid")
+(import-os-error-syscall process-user-effective-gid () "scsh_getegid")
 
-(import-os-error-syscall set-gid (gid) "scsh_setgid")
+(import-os-error-syscall process-set-gid (gid) "scsh_setgid")
 
-(import-os-error-syscall set-effective-gid (gid) "scsh_setegid")
+(import-os-error-syscall set-process-user-effective-gid (gid) "scsh_setegid")
 
 (import-os-error-syscall user-supplementary-gids () "get_groups")
 
 ;;; UID
 (import-os-error-syscall user-uid  () "scsh_getuid")
 
-(import-os-error-syscall user-effective-uid () "scsh_geteuid")
+(import-os-error-syscall process-user-effective-uid () "scsh_geteuid")
 
-(import-os-error-syscall set-uid (uid) "scsh_setuid")
+(import-os-error-syscall process-set-uid (uid) "scsh_setuid")
 
-(import-os-error-syscall set-effective-uid (uid) "scsh_seteuid")
+(import-os-error-syscall set-process-user-effective-uid (uid) "scsh_seteuid")
 
 (import-os-error-syscall %user-login-name () "my_username")
  
@@ -184,7 +184,8 @@
 
 (define (generic-file-op thing fd-op fname-op)
   (if (string? thing) 
-      (with-resources-aligned (list cwd-resource) (lambda () (fname-op thing)))
+      (with-resources-aligned (list cwd-resource euid-resource egid-resource) 
+			      (lambda () (fname-op thing)))
       (call/fdes thing fd-op)))
 
 
@@ -341,7 +342,8 @@
 (import-os-error-syscall %delete-file (path) "scsh_unlink")
 
 (define (delete-file path)
-  (with-resources-aligned (list cwd-resource) (lambda () (%delete-file path))))
+  (with-resources-aligned (list cwd-resource euid-resource egid-resource) 
+			  (lambda () (%delete-file path))))
 
 (import-os-error-syscall %sync-file (fd) "scsh_fsync")
 
@@ -384,7 +386,7 @@
 
 (define (open-fdes path flags . maybe-mode) ; mode defaults to 0666
     (with-resources-aligned 
-     (list cwd-resource umask-resource)
+     (list cwd-resource umask-resource euid-resource egid-resource)
      (lambda ()
       (%open path flags (:optional maybe-mode #o666)))))
 
@@ -535,7 +537,7 @@
 
 (define (directory-files . args)
   (with-resources-aligned
-   (list cwd-resource)
+   (list cwd-resource euid-resource egid-resource)
    (lambda ()
      (let-optionals args ((dir       ".")
 			  (dotfiles? #f))