blob: 672c1e9d304fcc4d52286ee1dd62a83c549f36df (
about) (
plain)
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
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
|
(define-module (language python module resource)
#:use-module (system foreign)
#:use-module (rnrs bytevectors)
#:use-module (oop pf-objects)
#:use-module (language python exceptions)
#:use-module (language python list)
#:use-module (language python module errno)
#:use-module (language python try)
#:export (RLIM_INFINITY RLIMIT_CORE RLIMIT_CPU RLIMIT_FSIZE RLIMIT_DATA
RLIMIT_STACK RLIMIT_RSS RLIMIT_NPROC RLIMIT_NOFILE
RLIMIT_MEMLOCK RLIMIT_AS RLIMIT_LOCKS
RLIMIT_MSGQUEUE RLIMIT_NICE RLIMIT_RTPRIO
RLIMIT_RTTIME RLIMIT_SIGPENDING
getrlimit setrlimit prlimit
RUSAGE_SELF RUSAGE_CHILDREN RUSAGE_BOTH RUSAGE_THREAD
getrusage getpagesize
ResUsage
))
(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
(define-syntax-rule (ca code)
(catch #t
(lambda () code)
(lambda x (raise error x))))
(define-syntax-rule (rm code (m . mm) ...)
(let ((r (ca code)))
(if (< r 0)
(let ((e (errno)))
(cond
((= e m) mm) ...
(else
(raise OSError (pylist-ref errorcode e) ((@ (guile) strerror) e)))))
(values))))
(define-syntax-rule (defineu f x)
(define f
(catch #t
(lambda () x)
(lambda z
(let ((message (format #f "could not define ~a" 'f)))
(warn message)
(lambda z (error message)))))))
(define RLIM_INFINITY #xffffffffffffffff)
(define RLIMIT_CORE 4)
(define RLIMIT_CPU 0)
(define RLIMIT_FSIZE 1)
(define RLIMIT_DATA 2)
(define RLIMIT_STACK 3)
(define RLIMIT_RSS 5)
(define RLIMIT_NPROC 6)
(define RLIMIT_NOFILE 7)
(define RLIMIT_MEMLOCK 8)
(define RLIMIT_AS 9)
(define RLIMIT_LOCKS 10)
(define RLIMIT_MSGQUEUE 12)
(define RLIMIT_NICE 13)
(define RLIMIT_RTPRIO 14)
(define RLIMIT_RTTIME 15)
(define RLIMIT_SIGPENDING 11)
(define getrlimit #f)
(defineu getrlimit
(let ((f (pointer->procedure int
(dynamic-func "getrlimit" (dynamic-link))
(list int '*))))
(lambda (resource)
(let* ((v (make-bytevector 16))
(vp (bytevector->pointer v)))
(rm (f resource vp) (EINVAL (raise ValueError "wrong resource")))
(list (bytevector-u64-ref v 0 (native-endianness))
(bytevector-u64-ref v 8 (native-endianness)))))))
(define setrlimit #f)
(defineu setrlimit
(let ((f (pointer->procedure int
(dynamic-func "setrlimit" (dynamic-link))
(list int '*))))
(lambda (resource limits)
(let* ((v (make-bytevector 16))
(vp (bytevector->pointer v)))
(bytevector-u64-set! v 0 (pylist-ref limits 0) (native-endianness))
(bytevector-u64-set! v 8 (pylist-ref limits 1) (native-endianness))
(rm (f resource vp)
(EINVAL (raise ValueError "wrong resource"))
(EPERM (raise ValueError "wrong permission")))
(values)))))
(define prlimit #f)
(defineu prlimit
(let ((f (pointer->procedure int
(dynamic-func "prlimit" (dynamic-link))
(list int int '* '*))))
(lambda* (pid resource #:optional (limits None))
(let* ((vnew (make-bytevector 16))
(vold (make-bytevector 16))
(vpnew (bytevector->pointer vnew))
(vpold (bytevector->pointer vold)))
(if (not (equal? limits None))
(begin
(bytevector-u64-set! vnew 0 (pylist-ref limits 0)
(native-endianness))
(bytevector-u64-set! vnew 8 (pylist-ref limits 1)
(native-endianness))))
(rm (f pid resource
(if (eq? limits None)
(make-pointer 0)
vpnew)
vpold)
(EINVAL (raise ValueError "wrong resource"))
(ESRCH (raise ProcessLookupError "prlimit"))
(EPERM (raise PermissionError "prlimit")))
(list (bytevector-u64-ref vold 0 (native-endianness))
(bytevector-u64-ref vold 8 (native-endianness)))))))
(define RUSAGE_SELF 0)
(define RUSAGE_CHILDREN -1)
(define RUSAGE_BOTH -2)
(define RUSAGE_THREAD 1)
(define-python-class ResUsage ()
(define __init__
(lambda (self v)
(define i 0)
(define-syntax-rule (gettime k)
(let ((x1 (bytevector-u64-ref v i (native-endianness)))
(x2 (bytevector-u64-ref v (+ i 8) (native-endianness))))
(set! i (+ i (* 8 2)))
(set self k (+ (* x1 1.0) (/ (* x2 1.0) 1000000)))))
(define-syntax-rule (s k)
(begin
(set self k (bytevector-u64-ref v i (native-endianness)))
(set! i (+ i 8))))
(gettime 'ru_utime)
(gettime 'ru_stime)
(s 'ru_maxrss)
(s 'ru_ixrss )
(s 'ru_idrss )
(s 'ru_isrss )
(s 'ru_minflt)
(s 'ru_majflt)
(s 'ru_nswap)
(s 'ru_inblock)
(s 'ru_outblock)
(s 'ru_msgsnd)
(s 'ru_msgrcv)
(s 'ru_nsignals)
(s 'ru_nvcsw)
(s 'ru_nivcsw))))
(define getrusage #f)
(defineu getrusage
(let ((f (pointer->procedure int
(dynamic-func "getrusage" (dynamic-link))
(list int '*))))
(lambda (who)
(let* ((v (make-bytevector 160))
(vp (bytevector->pointer v)))
(rm (f who vp)
(EINVAL (raise ValueError "wrong who in getrusage")))
(ResUsage v)))))
(define getpagesize #f)
(defineu getpagesize
(let ((f (pointer->procedure int
(dynamic-func "getpagesize" (dynamic-link))
'())))
(lambda ()
(rm (f)))))
|
