Extract limit value parsers
ober
1f69971a7251b6de8fb7e03ecc46edf0fd66f1a3
--- a/docs/limits-followup.md +++ b/docs/limits-followup.md @@ -196,6 +196,10 @@ Implemented: - `limit-policy`. - `limit-policy-set!`. +- Reusable user-facing limit parsers: + `limit-parse-bytes`, `limit-parse-cpu-seconds`, `limit-parse-time-ms`, + `limit-parse-mem-fraction`, `limit-parse-pids`, + `limit-parse-resolved`, and `limit-parse-value`. - `limit-policy-install!`. - support statuses for setrlimit-backed and parent-side limits. - `limit-policy-plan` for preflight decisions. @@ -216,7 +220,8 @@ Missing or incomplete: - `RLIMIT_NPROC` is known to be user-wide or otherwise not tree-local on some systems. The module reports `degraded` for pids on Linux, but tests need to assert this behavior. -- There are no dedicated tests for each limit kind. +- Dedicated tests now cover the reusable value parsers. The setrlimit-backed + installer still needs per-kind platform tests. Required next work: --- a/lib/std/os/limits.ss +++ b/lib/std/os/limits.ss @@ -44,6 +44,14 @@ limit-policy-set! limit-policy-get limit-policy-pairs + limit-kind-strings + limit-parse-bytes + limit-parse-cpu-seconds + limit-parse-time-ms + limit-parse-mem-fraction + limit-parse-pids + limit-parse-resolved + limit-parse-value limit-policy-install! limit-policy-plan limit-policy-explain @@ -76,6 +84,128 @@ (defstruct limit-policy (entries)) ;; entries: alist (kind . value) + ;; ---------- User-facing value parsers ---------- + + (def limit-kind-strings '("mem" "cpu" "pids" "time" "fsize" "out")) + + (def (digit-char? c) + (and (char>=? c #\0) (char<=? c #\9))) + + (def (positive-exact-number? v) + (and v (exact? v) (positive? v))) + + (def (limit-parse-bytes s) + ;; Parse "2g", "512m", "1k", "1024" to integer bytes. Suffixes are + ;; binary units; bare integer means bytes. + (cond + [(or (not (string? s)) (= 0 (string-length s))) #f] + [else + (let* ([n (string-length s)] + [last (string-ref s (- n 1))]) + (cond + [(digit-char? last) + (let ([v (string->number s)]) + (and (positive-exact-number? v) v))] + [else + (let* ([num (string->number (substring s 0 (- n 1)))] + [mul (case last + [(#\k #\K) 1024] + [(#\m #\M) (* 1024 1024)] + [(#\g #\G) (* 1024 1024 1024)] + [(#\t #\T) (* 1024 1024 1024 1024)] + [else #f])]) + (and (positive-exact-number? num) mul (* num mul)))]))])) + + (def (limit-parse-cpu-seconds s) + ;; Parse "30" / "30s" to seconds. "m"/"h" multiply. + (cond + [(or (not (string? s)) (= 0 (string-length s))) #f] + [else + (let* ([n (string-length s)] + [last (string-ref s (- n 1))]) + (cond + [(digit-char? last) + (let ([v (string->number s)]) + (and (positive-exact-number? v) v))] + [else + (let ([num (string->number (substring s 0 (- n 1)))]) + (cond + [(not (positive-exact-number? num)) #f] + [(char=? last #\s) num] + [(char=? last #\m) (* num 60)] + [(char=? last #\h) (* num 60 60)] + [else #f]))]))])) + + (def (limit-parse-time-ms s) + ;; Parse "200" (ms), "30s", "5m", or "1h" to integer ms. + (cond + [(or (not (string? s)) (= 0 (string-length s))) #f] + [else + (let* ([n (string-length s)] + [last (string-ref s (- n 1))]) + (cond + [(digit-char? last) + (let ([v (string->number s)]) + (and v (exact? v) (>= v 0) v))] + [else + (let ([num (string->number (substring s 0 (- n 1)))]) + (cond + [(not num) #f] + [(char=? last #\s) (* num 1000)] + [(char=? last #\m) (* num 60 1000)] + [(char=? last #\h) (* num 60 60 1000)] + [else #f]))]))])) + + (def (limit-parse-mem-fraction s) + ;; Parse "30%" or "0.5" into a fraction in (0..1]. + (cond + [(or (not (string? s)) (= 0 (string-length s))) #f] + [else + (let* ([n (string-length s)] + [last (string-ref s (- n 1))]) + (cond + [(char=? last #\%) + (let ([num (string->number (substring s 0 (- n 1)))]) + (cond + [(or (not num) (<= num 0) (> num 100)) #f] + [else (/ num 100.0)]))] + [else + (let ([num (string->number s)]) + (cond + [(or (not num) (<= num 0) (> num 1)) #f] + [else (exact->inexact num)]))]))])) + + (def (limit-parse-pids s) + (cond + [(or (not (string? s)) (= 0 (string-length s))) #f] + [else + (let ([v (string->number s)]) + (and (positive-exact-number? v) v))])) + + (def (limit-parse-resolved kind value) + ;; Resolve jsh-style kind strings to numeric values accepted by the + ;; launcher/supervisor layer. + (cond + [(or (not (string? kind)) (not (string? value))) #f] + [(string=? kind "mem") + (or (limit-parse-mem-fraction value) + (limit-parse-bytes value))] + [(string=? kind "cpu") (limit-parse-cpu-seconds value)] + [(string=? kind "pids") (limit-parse-pids value)] + [(string=? kind "fsize") (limit-parse-bytes value)] + [(string=? kind "out") (limit-parse-bytes value)] + [(string=? kind "time") (limit-parse-time-ms value)] + [else #f])) + + (def (limit-parse-value kind value) + ;; Returns canonical value string on success, #f on failure. + (cond + [(or (not (string? kind)) (not (string? value))) #f] + [(= 0 (string-length value)) #f] + [(not (member kind limit-kind-strings)) #f] + [(not (limit-parse-resolved kind value)) #f] + [else value])) + (def (limit-policy) (make-limit-policy '())) --- a/tests/test-limits-primitives.ss +++ b/tests/test-limits-primitives.ss @@ -82,6 +82,37 @@ (printf "--- limits primitives tests ---~%") +;; ===== limit value parsing ===== +(printf "[limits parse]~%") + +(test "limit-parse-bytes bare" + (limit-parse-bytes "1024") + 1024) +(test "limit-parse-bytes suffix" + (limit-parse-bytes "2g") + (* 2 1024 1024 1024)) +(test "limit-parse-bytes rejects fraction" + (limit-parse-bytes "1.5g") + #f) +(test "limit-parse-cpu-seconds suffix" + (limit-parse-cpu-seconds "5m") + (* 5 60)) +(test "limit-parse-time-ms suffix" + (limit-parse-time-ms "30s") + 30000) +(test "limit-parse-mem-fraction percent" + (limit-parse-mem-fraction "30%") + 0.3) +(test "limit-parse-pids positive integer" + (limit-parse-pids "16") + 16) +(test "limit-parse-resolved fsize" + (limit-parse-resolved "fsize" "1m") + (* 1024 1024)) +(test "limit-parse-value rejects unknown kind" + (limit-parse-value "bogus" "1") + #f) + ;; ===== supervise: signal status math ===== ;; sleep + SIGTERM via timeout should produce signal=15, status=143. ;; (Some macOS sandbox shims kill via SIGKILL; accept either.)