Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-13 16:07:35 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

adding initial host system module

Browse source
This commit is contained in:
Alex Shinn 2009-12-26 23:48:43 +09:00
parent e9d6f1857a
commit 2534e81d5b
2 changed files with 49 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
lib/chibi/system.module Normal file
View file

@ -0,0 +1,15 @@
(define-module (chibi system)
(export user-information user-name user-password
user-id user-group-id user-gecos user-home user-shell
current-user-id current-group-id
current-effective-user-id current-effective-group-id
set-current-user-id! set-current-effective-user-id!
set-current-group-id! set-current-effective-group-id!
current-session-id create-session
set-root-directory!)
(import-immutable (scheme))
(include-shared "system")
;;(include "system.scm")
)

34
lib/chibi/system.stub Normal file
View file

@ -0,0 +1,34 @@
(c-system-include "unistd.h")
(c-system-include "pwd.h")
(c-system-include "sys/types.h")
(define-c-struct passwd
predicate: user?
(string pw_name user-name)
(string pw_passwd user-password)
(uid_t pw_uid user-id)
(gid_t pw_gid user-group-id)
(string pw_gecos user-gecos)
(string pw_dir user-home)
(string pw_shell user-shell))
(define-c uid_t (current-user-id "getuid") ())
(define-c gid_t (current-group-id "getgid") ())
(define-c uid_t (current-effective-user-id "geteuid") ())
(define-c gid_t (current-effective-group-id "getegid") ())
(define-c errno (set-current-user-id! "setuid") (uid_t))
(define-c errno (set-current-effective-user-id! "seteuid") (uid_t))
(define-c errno (set-current-group-id! "setgid") (gid_t))
(define-c errno (set-current-effective-group-id! "setegid") (gid_t))
(define-c pid_t (current-session-id "getsid") ((default 0 pid_t)))
(define-c pid_t (create-session "setsid") ())
(define-c errno (set-root-directory! "chroot") (string))
;; (define-c errno getpwuid_r
;; (uid_t (result passwd) (result (array char arg3))
;; (value 256 int) (result pointer passwd)))