1 files changed, 163 insertions, 0 deletions
diff --git a/modules/language/python/module/resource.scm b/modules/language/python/module/resource.scm
new file mode 100644
index 0000000..200127e
--- /dev/null
+++ b/modules/language/python/module/resource.scm
@@ -0,0 +1,163 @@
+(define-module (language python module resource)
+  #:use-module (system foreign)
+  #:use-module (rnrs bytevectors)
+  #:use-module (language python exceptions)
+  #:use-module (language python module errno)
+  #:use-module (language python try)
+  #:use-module (language python list)
+  #: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 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
+  (let ((f (pointer->procedure int
+                               (dynamic-func "getrlimit" (dynamic-link))
+                               (int '*))))
+    (lambda (resource)
+      (let* ((v  (make-bytevector 16))
+             (vp (bytevector->pointer v)))
+        (rm (f res vp) (EINVAL (raise ValueError "wrong resource")))
+        (list (bytevector-u64-ref v 0 (native-endianess))
+              (bytevector-u64-ref v 1 (native-endianess)))))))
+
+(define setrlimit
+  (let ((f (pointer->procedure int
+                               (dynamic-func "setrlimit" (dynamic-link))
+                               (int '*))))
+    (lambda (resource limits)
+      (let* ((v  (make-bytevector 16))
+             (vp (bytevector->pointer v)))
+        (bytevector-u64-set! v 0 (pylist-ref limits 0) (native-endianess))
+        (bytevector-u64-set! v 1 (pylist-ref limits 1) (native-endianess))
+        (rm (f resource vp)
+            (EINVAL (raise ValueError "wrong resource"))
+            (EPERM  (raise ValueError "wrong permission")))
+        (values)))))
+
+(define prlimit
+  (let ((f (pointer->procedure int
+                               (dynamic-func "prlimit" (dynamic-link))
+                               (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-endianess))
+              (bytevector-u64-set! vnew 1 (pylist-ref limits 1)
+                                   (native-endianess))))
+        (rm (f pid resource
+               (if (eq? limits None)
+                   (adress-pointer 0)
+                   vpnew)
+               vpold)
+            (EINVAL (raise ValueError "wrong resource"))
+            (ESRCH  (raise ProcessLookupError "prlimit"))
+            (EPERM  (raise PermissionError "prlimit")))
+        
+        (list (bytevector-u64-ref vold 0 (native-endianess))
+              (bytevector-u64-ref vold 1 (native-endianess)))))))
+
+        
+(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-endianess)))
+              (x2 (bytevector-u64-ref v (+ i 1) (native-endianess))))
+          (set! i (+ i 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-endianess)))
+          (set! i (+ i 1))))
+      (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
+  (let ((f (pointer->procedure int
+                               (dynamic-func "getrusage" (dynamic-link))
+                               (int '*))))
+    (lambda (who)
+      (let* ((v  (make-bytevector 160))
+             (vp (bytevector->pointer)))
+        
+        (rm (f who vp)
+            (EINVAL (raise ValueError "wrong who in getrusage")))
+
+        (ResUsage v)))))
+
+(define getpagesize
+  (let ((f (pointer->procedure int
+                               (dynamic-func "getpagesize" (dynamic-link))
+                               ())))
+    (lambda ()
+      (rm (f)))))
+