fix: privdrop validates target uid/gid and asserts euid post-drop (P1 #23)

ober

e0f567835e1f399b01277185ddb8530884022763

diff --git a/examples/privdrop_check.ss b/examples/privdrop_check.ss
index 830f100..1a35c13 100644
--- a/examples/privdrop_check.ss
+++ b/examples/privdrop_check.ss
@@ -26,6 +26,7 @@
    "root:x:0:0:root:/root:/bin/sh\n"
    "daemon:x:1:1:daemon:/usr/sbin:/usr/sbin/nologin\n"
    "nobody:x:65534:65534:nobody:/nonexistent:/usr/sbin/nologin\n"
+   "gidroot:x:1000:0:gidroot:/x:/bin/false\n"
    "baduid:x:0x10:20:bad:/x:/bin/false\n"
    "badgid:x:10:-1:bad:/x:/bin/false\n"
    "short:x:10\n"))
@@ -42,12 +43,14 @@
   (lambda (n)
     (set! calls (append calls (list (list tag n))))
     0))
+(def (euid n) (lambda () n))         ;; injected geteuid returning a fixed euid
 
 (let ((r (drop-privileges* "nobody"
                            passwd-text
                            (remember 'setgroups)
                            (remember 'setgid)
-                           (remember 'setuid))))
+                           (remember 'setuid)
+                           (euid 65534))))
   (check "drop result" r '(ok 65534 65534))
   (check "drop call order" calls
          '((setgroups 65534) (setgid 65534) (setuid 65534))))
@@ -57,7 +60,8 @@
                          passwd-text
                          (remember 'setgroups)
                          (remember 'setgid)
-                         (remember 'setuid))
+                         (remember 'setuid)
+                         (euid 65534))
        '(err "user 'ghost' not found"))
 
 (set! calls '())
@@ -69,10 +73,43 @@
                                       (make-who-condition 'setgroups)
                                       (make-message-condition "boom"))))
                            (remember 'setgid)
-                           (remember 'setuid))))
+                           (remember 'setuid)
+                           (euid 65534))))
   (check "drop failure tag" (car r) 'err)
   (check "drop stops on setgroups failure" calls '((setgroups 65534))))
 
+;; ── privilege-drop hardening (P1 #23): don't trust /etc/passwd, verify the drop ──
+;; A compromised passwd mapping the target to uid/gid 0 must be refused (abort),
+;; and a drop whose resulting euid is wrong (or still root) must abort too.
+(check "refuse uid 0 target (aborts)"
+       (try (begin (drop-privileges* "root" passwd-text
+                                     (remember 'setgroups) (remember 'setgid)
+                                     (remember 'setuid) (euid 0))
+                   "no-abort")
+            (catch (e) "aborted"))
+       "aborted")
+(check "refuse gid 0 target (aborts)"
+       (try (begin (drop-privileges* "gidroot" passwd-text
+                                     (remember 'setgroups) (remember 'setgid)
+                                     (remember 'setuid) (euid 1000))
+                   "no-abort")
+            (catch (e) "aborted"))
+       "aborted")
+(check "abort when euid still root after drop"
+       (try (begin (drop-privileges* "nobody" passwd-text
+                                     (remember 'setgroups) (remember 'setgid)
+                                     (remember 'setuid) (euid 0))
+                   "no-abort")
+            (catch (e) "aborted"))
+       "aborted")
+(check "abort when euid != target uid after drop"
+       (try (begin (drop-privileges* "nobody" passwd-text
+                                     (remember 'setgroups) (remember 'setgid)
+                                     (remember 'setuid) (euid 1234))
+                   "no-abort")
+            (catch (e) "aborted"))
+       "aborted")
+
 (if (= failures 0)
     (displayln "OK: privilege drop passwd lookup and call order match secmon agent.")
     (begin (display failures) (displayln " failure(s).") (exit 1)))
diff --git a/jsecmon/privdrop.ss b/jsecmon/privdrop.ss
index d9892b0..75ae0c5 100644
--- a/jsecmon/privdrop.ss
+++ b/jsecmon/privdrop.ss
@@ -18,7 +18,7 @@
                   partition
                   make-date make-time)
           (except (jerboa prelude) meta atom?)
-          (only (std os posix) check-posix posix-setgid posix-setuid))
+          (only (std os posix) check-posix posix-setgid posix-setuid posix-geteuid))
 
   (def (decimal-u32? s)
     (let ((len (string-length s)))
@@ -49,20 +49,31 @@
             ((parse-passwd-line (car lines) username) => (lambda (ids) ids))
             (else (loop (cdr lines))))))
 
-  (def (drop-privileges* username passwd-text setgroups! setgid! setuid!)
+  ;; Drop to `username`'s uid/gid (setgroups -> setgid -> setuid), then verify
+  ;; the drop actually took effect. /etc/passwd is hostile-readable (the host may
+  ;; be compromised), so a target uid/gid of 0 is refused outright, and after the
+  ;; drop we assert geteuid()==uid and !=0 — a drop that leaves us root is a
+  ;; security failure and raises (the agent wrapper aborts on it) rather than
+  ;; returning a soft (err) the caller might warn-and-continue past.
+  (def (drop-privileges* username passwd-text setgroups! setgid! setuid! geteuid)
     (let ((ids (parse-passwd-user passwd-text username)))
-      (if (not ids)
-          (list 'err (string-append "user '" username "' not found"))
-          (let ((uid (car ids))
-                (gid (cdr ids)))
-            (try
-              (begin
-                (setgroups! gid)
-                (setgid! gid)
-                (setuid! uid)
-                (list 'ok uid gid))
-              (catch (e)
-                (list 'err (format "~a" e))))))))
+      (cond
+        ((not ids)
+         (list 'err (string-append "user '" username "' not found")))
+        ((or (= (car ids) 0) (= (cdr ids) 0))
+         (error 'drop-privileges
+           (string-append "refusing to drop to root-equivalent uid/gid for user '" username "'")))
+        (else
+         (let ((uid (car ids)) (gid (cdr ids)))
+           (let ((posix-err (try (begin (setgroups! gid) (setgid! gid) (setuid! uid) #f)
+                                 (catch (e) (format "~a" e)))))
+             (if posix-err
+                 (list 'err posix-err)
+                 (let ((euid (geteuid)))
+                   (if (and (= euid uid) (not (= euid 0)))
+                       (list 'ok uid gid)
+                       (error 'drop-privileges
+                         (format "privilege drop not effective: euid ~a, expected non-zero ~a" euid uid)))))))))))
 
   (def (setgroups-one! gid)
     (let ((groups (make-bytevector 4 0))
@@ -73,11 +84,14 @@
       (check-posix 'setgroups (c-setgroups 1 groups))))
 
   (def (drop-privileges username)
-    (try
-      (drop-privileges* username
-                        (read-file-string "/etc/passwd")
-                        setgroups-one!
-                        posix-setgid
-                        posix-setuid)
-      (catch (e)
-        (list 'err (format "~a" e))))))
+    (let ((passwd (try (read-file-string "/etc/passwd") (catch (e) #f))))
+      (if (not passwd)
+          (list 'err "could not read /etc/passwd")
+          (try (drop-privileges* username passwd
+                                 setgroups-one!
+                                 posix-setgid
+                                 posix-setuid
+                                 posix-geteuid)
+               (catch (e)
+                 (begin (displayln "FATAL: privilege drop verification failed; aborting")
+                        (exit 1))))))))