1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
|
; Part of Scheme 48 1.9. See file COPYING for notices and license.
; Authors: Richard Kelsey, Jonathan Rees, Mike Sperber, Roderic Morris,
; Marcus Crestani, Will Noble
; Access to Posix process environment
(import-dynamic-externals "=scheme48external/posix")
; We multiplex a bunch of these to save typing.
;----------------
; 4.1 Process Identification
(define (get-process-id)
(integer->process-id (posix-get-pid #f)))
(define (get-parent-process-id)
(integer->process-id (posix-get-pid #t)))
;----------------
; 4.2 User Identification and 4.3 Process Groups
(define (get-user-id)
(call-imported-binding-2 posix-get-id #t #t))
(define (get-effective-user-id)
(call-imported-binding-2 posix-get-id #t #f))
(define (get-group-id)
(call-imported-binding-2 posix-get-id #f #t))
(define (get-effective-group-id)
(call-imported-binding-2 posix-get-id #f #f))
(define (set-user-id! user-id)
(call-imported-binding-2 posix-set-id! #t #t user-id))
(define (set-effective-user-id! user-id)
(call-imported-binding-2 posix-set-id! #t #f user-id))
(define (set-group-id! group-id)
(call-imported-binding-2 posix-set-id! #f #t group-id))
(define (set-effective-group-id! group-id)
(call-imported-binding-2 posix-set-id! #f #f group-id))
(import-lambda-definition-2 posix-get-pid (parent?))
(import-definition posix-get-id)
(import-definition posix-set-id! "posix_set_id")
(define (get-groups)
(call-imported-binding-2 posix-get-groups))
(define (get-login-name)
(let ((name (call-imported-binding-2 posix-get-login)))
(if name
(byte-vector->os-string name)
name)))
(import-definition posix-get-groups)
(import-definition posix-get-login)
(import-lambda-definition-2 posix-set-sid ())
;----------------
; 4.4 System Identification
;
; The five values returned by uname().
(import-lambda-definition-2 posix-sys-name (which))
(define (os-name) (posix-sys-name 0))
(define (os-node-name) (posix-sys-name 1))
(define (os-release-name) (posix-sys-name 2))
(define (os-version-name) (posix-sys-name 3))
(define (machine-name) (posix-sys-name 4))
;----------------
; 4.5 Get Process Times
;
;----------------
; 4.6 Environment Variables
; We cheat here by using one type for both the variable names and
; their values. The rules are the same for both, after all.
(define (lookup-environment-variable name)
(cond
((external-lookup-environment-variable (x->os-byte-vector name))
=> x->os-string)
(else #f)))
(define (lookup-environment-variable->string name)
(cond
((lookup-environment-variable name)
=> os-string->string)
(else #f)))
(define (set-environment-variable! name value)
(external-set-environment-variable! (x->os-byte-vector name)
(x->os-byte-vector value)))
(define (environment-alist)
(map (lambda (pair)
(cons (x->os-string (car pair))
(x->os-string (cdr pair))))
(external-environment-alist)))
(define (environment-alist-as-strings)
(map (lambda (pair)
(cons (os-string->string (car pair))
(os-string->string (cdr pair))))
(environment-alist)))
(import-lambda-definition-2 external-lookup-environment-variable (name) "posix_get_env")
(import-lambda-definition-2 external-set-environment-variable! (name value) "posix_set_env")
(import-lambda-definition-2 external-environment-alist () "posix_get_env_alist")
;----------------
; 4.7 Terminal Identification
; See io.scm.
;----------------
; 4.8 Configurable System Variables
|
