From 88ba80b8d1d84bda2e074161852ba978c6d0de3e Mon Sep 17 00:00:00 2001 From: Peter Bex Date: Mon, 30 Apr 2018 19:00:49 +0200 Subject: [PATCH 5/5] Refactor chicken.process-context.posix so it no longer refers to chicken.posix Again, similar to the previous commit and also very straightforward. This is the last module to convert; the export list of chicken.posix is now empty! --- posix-common.scm | 15 +++++++------ posix.scm | 64 +++++++++++++++++++++++++------------------------------- posixunix.scm | 10 ++++----- posixwin.scm | 23 +++++++++----------- types.db | 37 ++++++++++++++++---------------- 5 files changed, 72 insertions(+), 77 deletions(-) diff --git a/posix-common.scm b/posix-common.scm index 35dd99b8..ea8cf78d 100644 --- a/posix-common.scm +++ b/posix-common.scm @@ -499,16 +499,19 @@ EOF ;;; Set or get current directory by file descriptor: -(define (change-directory* fd) - (##sys#check-fixnum fd 'change-directory*) - (unless (fx= 0 (##core#inline "C_fchdir" fd)) - (posix-error #:file-error 'change-directory* "cannot change current directory" fd)) - fd) +(set! chicken.process-context.posix#change-directory* + (lambda (fd) + (##sys#check-fixnum fd 'change-directory*) + (unless (fx= 0 (##core#inline "C_fchdir" fd)) + (posix-error #:file-error 'change-directory* "cannot change current directory" fd)) + fd)) (set! ##sys#change-directory-hook (let ((cd ##sys#change-directory-hook)) (lambda (dir) - ((if (fixnum? dir) change-directory* cd) dir)))) + ((if (fixnum? dir) + chicken.process-context.posix#change-directory* + cd) dir)))) ;;; umask diff --git a/posix.scm b/posix.scm index 2d74fb54..6ef41dfb 100644 --- a/posix.scm +++ b/posix.scm @@ -317,16 +317,36 @@ ) ; chicken.process.signal -;; This module really does nothing. It is used to keep all the posix -;; stuff in one place, in a clean namespace. The included file will -;; set! values from the modules defined above. -(module chicken.posix - (change-directory* create-session +(module chicken.process-context.posix + (change-directory* set-root-directory! current-effective-group-id current-effective-user-id - current-effective-user-name current-group-id current-process-id - current-user-id current-user-name - parent-process-id process-group-id - set-root-directory!) + current-group-id current-process-id current-user-id + parent-process-id current-user-name + current-effective-user-name create-session + process-group-id user-information) + +(import scheme) + +(define change-directory*) +(define set-root-directory!) +(define current-effective-group-id) +(define current-effective-user-id) +(define current-group-id) +(define current-process-id) +(define current-user-id) +(define parent-process-id) +(define current-user-name) +(define current-effective-user-name) +(define create-session) +(define process-group-id) +(define user-information) +) ; chicken.process-context.posix + + +;; This module really exports nothing. It is used to keep all the +;; posix stuff in one place, in a clean namespace. The included file +;; will set! values from the modules defined above. +(module chicken.posix () (import scheme chicken.base @@ -392,29 +412,3 @@ (define errno/wouldblock _ewouldblock) (define errno/xdev _exdev) ) ; chicken.errno - - -(module chicken.process-context.posix - (change-directory* set-root-directory! - current-effective-group-id current-effective-user-id - current-group-id current-process-id current-user-id - parent-process-id current-user-name - current-effective-user-name create-session - process-group-id user-information) - -(import scheme) - -(define change-directory* chicken.posix#change-directory*) -(define set-root-directory! chicken.posix#set-root-directory!) -(define current-effective-group-id chicken.posix#current-effective-group-id) -(define current-effective-user-id chicken.posix#current-effective-user-id) -(define current-group-id chicken.posix#current-group-id) -(define current-process-id chicken.posix#current-process-id) -(define current-user-id chicken.posix#current-user-id) -(define parent-process-id chicken.posix#parent-process-id) -(define current-user-name chicken.posix#current-user-name) -(define current-effective-user-name chicken.posix#current-effective-user-name) -(define create-session chicken.posix#create-session) -(define process-group-id chicken.posix#process-group-id) -(define user-information chicken.posix#user-information) -) ; chicken.process-context.posix diff --git a/posixunix.scm b/posixunix.scm index 157a2cff..3fd30dbd 100644 --- a/posixunix.scm +++ b/posixunix.scm @@ -612,7 +612,7 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime) (lambda (id) (when (fx< (##core#inline "C_setuid" id) 0) (##sys#update-errno) - (##sys#error 'set-user-id! "cannot set user ID" id) ) ) + (##sys#error 'current-user-id!-setter "cannot set user ID" id) ) ) "(current-user-id)")) (define current-effective-user-id @@ -631,7 +631,7 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime) (lambda (id) (when (fx< (##core#inline "C_setgid" id) 0) (##sys#update-errno) - (##sys#error 'set-user-id! "cannot set group ID" id) ) ) + (##sys#error 'current-group-id!-setter "cannot set group ID" id) ) ) "(current-group-id)") ) (define current-effective-group-id @@ -709,11 +709,11 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime) (##sys#error 'process-group-id "cannot retrieve process group ID" pid) ) a)) (lambda (pid pgid) - (##sys#check-fixnum pid 'set-process-group-id!) - (##sys#check-fixnum pgid 'set-process-group-id!) + (##sys#check-fixnum pid 'process-group) + (##sys#check-fixnum pgid 'process-group) (when (fx< (##core#inline "C_setpgid" pid pgid) 0) (##sys#update-errno) - (##sys#error 'set-process-group-id! "cannot set process group ID" pid pgid) ) ) + (##sys#error 'process-group "cannot set process group ID" pid pgid) ) ) "(process-group-id pid)")) diff --git a/posixwin.scm b/posixwin.scm index 28932fae..fef66b8f 100644 --- a/posixwin.scm +++ b/posixwin.scm @@ -875,13 +875,13 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime) (define-unimplemented chown) ; covers set-file-group! and set-file-owner! (set!-unimplemented chicken.file.posix#create-fifo) -(define-unimplemented create-session) +(set!-unimplemented chicken.process-context.posix#create-session) (set!-unimplemented chicken.file.posix#create-symbolic-link) -(define-unimplemented current-effective-group-id) -(define-unimplemented current-effective-user-id) -(define-unimplemented current-effective-user-name) -(define-unimplemented current-group-id) -(define-unimplemented current-user-id) +(set!-unimplemented chicken.process-context.posix#current-effective-group-id) +(set!-unimplemented chicken.process-context.posix#current-effective-user-id) +(set!-unimplemented chicken.process-context.posix#current-effective-user-name) +(set!-unimplemented chicken.process-context.posix#current-group-id) +(set!-unimplemented chicken.process-context.posix#current-user-id) (set!-unimplemented chicken.file.posix#file-control) (set!-unimplemented chicken.file.posix#file-link) (set!-unimplemented chicken.file.posix#file-lock) @@ -890,22 +890,19 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime) (set!-unimplemented chicken.file.posix#file-test-lock) (set!-unimplemented chicken.file.posix#file-truncate) (set!-unimplemented chicken.file.posix#file-unlock) -(define-unimplemented parent-process-id) +(set!-unimplemented chicken.process-context.posix#parent-process-id) (set!-unimplemented chicken.process#process-fork) -(define-unimplemented process-group-id) +(set!-unimplemented chicken.process-context.posix#process-group-id) (set!-unimplemented chicken.process#process-signal) (set!-unimplemented chicken.file.posix#read-symbolic-link) (set!-unimplemented chicken.process.signal#set-alarm!) -(define-unimplemented set-group-id!) -(define-unimplemented set-process-group-id!) -(define-unimplemented set-root-directory!) +(set!-unimplemented chicken.process-context.posix#set-root-directory!) (set!-unimplemented chicken.process.signal#set-signal-mask!) -(define-unimplemented set-user-id!) (set!-unimplemented chicken.process.signal#signal-mask) (set!-unimplemented chicken.process.signal#signal-mask!) (set!-unimplemented chicken.process.signal#signal-masked?) (set!-unimplemented chicken.process.signal#signal-unmask!) -(define-unimplemented user-information) +(set!-unimplemented chicken.process-context.posix#user-information) (set!-unimplemented chicken.time.posix#utc-time->seconds) (set!-unimplemented chicken.time.posix#string->time) diff --git a/types.db b/types.db index b890b52b..69f6209f 100644 --- a/types.db +++ b/types.db @@ -1923,6 +1923,25 @@ (chicken.process-context#set-environment-variable! (#(procedure #:clean #:enforce) chicken.process-context#set-environment-variable! (string string) undefined)) (chicken.process-context#unset-environment-variable! (#(procedure #:clean #:enforce) chicken.process-context#unset-environment-variable! (string) undefined)) +;; process-context.posix + +(chicken.process-context.posix#change-directory* (#(procedure #:clean #:enforce) chicken.process-context.posix#change-directory* (fixnum) fixnum)) +(chicken.process-context.posix#create-session (#(procedure #:clean) chicken.process-context.posix#create-session () fixnum)) + +(chicken.process-context.posix#current-effective-group-id (#(procedure #:clean) chicken.process-context.posix#current-effective-group-id () fixnum)) +(chicken.process-context.posix#current-effective-user-id (#(procedure #:clean) chicken.process-context.posix#current-effective-user-id () fixnum)) +(chicken.process-context.posix#current-effective-user-name (#(procedure #:clean) chicken.process-context.posix#current-effective-user-name () string)) +(chicken.process-context.posix#current-group-id (#(procedure #:clean) chicken.process-context.posix#current-group-id () fixnum)) +(chicken.process-context.posix#current-process-id (#(procedure #:clean) chicken.process-context.posix#current-process-id () fixnum)) +(chicken.process-context.posix#current-user-id (#(procedure #:clean) chicken.process-context.posix#current-user-id () fixnum)) +(chicken.process-context.posix#current-user-name (#(procedure #:clean) chicken.process-context.posix#current-user-name () string)) +(chicken.process-context.posix#parent-process-id (#(procedure #:clean) chicken.process-context.posix#parent-process-id () fixnum)) + +(chicken.process-context.posix#process-group-id (#(procedure #:clean #:enforce) chicken.process-context.posix#process-group-id () fixnum)) +(chicken.process-context.posix#set-root-directory! (#(procedure #:clean #:enforce) chicken.process-context.posix#set-root-directory! (string) undefined)) +(chicken.process-context.posix#user-information (#(procedure #:clean #:enforce) chicken.process-context.posix#user-information ((or string fixnum) #!optional *) *)) + + ;; file.posix (chicken.file.posix#create-fifo (#(procedure #:clean #:enforce) chicken.file.posix#create-fifo (string #!optional fixnum) undefined)) @@ -2033,24 +2052,6 @@ (chicken.time.posix#string->time (#(procedure #:clean #:enforce) chicken.time.posix#string->time (string #!optional string) (vector fixnum fixnum fixnum fixnum fixnum fixnum fixnum fixnum boolean fixnum))) (chicken.time.posix#time->string (#(procedure #:clean #:enforce) chicken.time.posix#time->string ((vector fixnum fixnum fixnum fixnum fixnum fixnum fixnum fixnum boolean fixnum) #!optional string) string)) -;; posix - -(chicken.posix#change-directory* (#(procedure #:clean #:enforce) chicken.posix#change-directory* (fixnum) fixnum)) -(chicken.posix#create-session (#(procedure #:clean) chicken.posix#create-session () fixnum)) - -(chicken.posix#current-effective-group-id (#(procedure #:clean) chicken.posix#current-effective-group-id () fixnum)) -(chicken.posix#current-effective-user-id (#(procedure #:clean) chicken.posix#current-effective-user-id () fixnum)) -(chicken.posix#current-effective-user-name (#(procedure #:clean) chicken.posix#current-effective-user-name () string)) -(chicken.posix#current-group-id (#(procedure #:clean) chicken.posix#current-group-id () fixnum)) -(chicken.posix#current-process-id (#(procedure #:clean) chicken.posix#current-process-id () fixnum)) -(chicken.posix#current-user-id (#(procedure #:clean) chicken.posix#current-user-id () fixnum)) -(chicken.posix#current-user-name (#(procedure #:clean) chicken.posix#current-user-name () string)) -(chicken.posix#parent-process-id (#(procedure #:clean) chicken.posix#parent-process-id () fixnum)) - -(chicken.posix#process-group-id (#(procedure #:clean #:enforce) chicken.posix#process-group-id () fixnum)) -(chicken.posix#set-root-directory! (#(procedure #:clean #:enforce) chicken.posix#set-root-directory! (string) undefined)) -(chicken.posix#user-information (#(procedure #:clean #:enforce) chicken.posix#user-information ((or string fixnum) #!optional *) *)) - ;; process (chicken.process#process-execute -- 2.11.0