permissions.ss
#lang scheme/base

(require scheme/foreign)
(unsafe!)

(define *lib* (ffi-lib #f))
(define setuid (get-ffi-obj "setreuid" *lib* (_fun (uid) ::
                                                   (uid : _int)
                                                   (_int = uid)
                                                   -> _int)))

(define ffi-chown (get-ffi-obj "chown" *lib* (_fun (path uid gid) ::
                                                   (path : _string)
                                                   (uid : _int)
                                                   (gid : _int)
                                                   -> _int)))

(define ffi-chmod (get-ffi-obj "chmod" *lib* (_fun (path mode) ::
                                               (path : _string)
                                               (mode : _int)
                                               -> _int)))

(define (drop-permissions [uid #f])
  (let ((uid (or uid (string->number (getenv "UID")))))
    (let ((result (setuid uid)))
      (when (< result 0)
        (error "setuid failed")))))

(define (chown path uid [gid #f])
  (let ((result (ffi-chown path uid (if gid gid -1))))
    (when (< result 0)
      (error "chown failed"))))

(define (chmod path mode)
  (let ([result (ffi-chmod path mode)])
    (when (< result 0)
      (error "chmod failed"))))

(provide drop-permissions chown chmod)