path: root/modules/language/python/module/os.scm

(define-module (language python module os)
  #:use-module (ice-9 match)
  #:use-module (ice-9 ftw)
  #:use-module (system foreign)
  #:use-module (oop pf-objects)
  #:use-module (oop goops)
  #:use-module (rnrs bytevectors)
  #:use-module (language python for)
  #:use-module ((language python module python) #:select (open))
  #:use-module (language python try)
  #:use-module (language python module stat)
  #:use-module (language python exceptions)
  #:use-module (language python yield)
  #:use-module (language python string)
  #:use-module (language python bytes)
  #:use-module (language python list)
  #:export (error name ctermid environ environb chdir fchdir getcwd
                  fsencode fdencode fspath PathLike getenv getenvb
                  get_exec_path getgid getegid geteuid
                  getgroups getgrouplist getlogin getpgid getpgrp getpid
                  getppid PRIO_PROCESS PRIO_PRGRP PRIO_USER getpriority
                  getresgid getuid initgroups putenv setegid seteuid
                  setgid setgroups setpgrp setpgid setpriority setregid
                  setresgid setreuid setresuid getsid setsid setuid strerr
                  umask  uname  unsetenv
                  
                  path curdir pardir sep extsep altsep pathsep linesep defpath
                  devnull

                  dopen close closerange device_encoding dup dup2 fchmod fchown
                  fdatasync fpathconf fstat fstatvfs fsynch ftruncate isatty
                  F_LOCK F_TLOCK F_ULOCK F_TEST lockf
                  SEEK_SET SEEK_CUR SEEK_END SEEK_DATA SEEK_HOLE lseek
                  open O_RDONLY O_WRONLY O_RDWR O_APPEND O_CREAT O_EXCL
                  O_TRUNC O_SYNC O_NDELAY O_NONBLOCK O_NOCTTY O_LARGEFILE
                  O_NOTRANS O_DSYNC O_RSYNC O_CLOEXEC O_PATH O_DIRECTORY
                  O_NOFOLLOW O_DIRECT O_NOATIME O_ASYNC O_TMPFILE
                  openpty pipe pipe2 posix_fallocate
                  posix_fadvise POSIX_FADV_NORMAL POSIX_FADV_RANDOM
                  POSIX_FADV_SEQUENTIAL POSIX_FADV_WILLNEED
                  POSIX_FADV_DONTNEED POSIX_FADV_NOREUSE
                  pread pwrite read sendfile set_blocking get_blocking
                  set_blocking readv write writev set_inheritable
                  get_inheritable

                  getxattr listxattr removexattr setxattr XATTR_SIZE_MAX
                  XATTR_CREATE XATTR_REPLACE

                  abort
                  excl excle execlp execlpe excv excve execvp execvpe

                  _exit
                  EX_OK EX_USAGE EX_DATAERR EX_NOINPUT EX_NOUSER EX_NOHOST
                  EX_UNAVAILABLE EX_SOFTWARE EX_OSERR EX_OSFILE EX_CANTCREAT
                  EX_IOERR EX_TEMPFAIL EX_PROTOCOL

                  spawnl spawnle spawnlp spawnlpe spawnv spawnve spawnvp
                  spawnvpe

                  P_WAIT P_NOWAIT P_NOWAIT0

                  ))

(define error OSError)
(define errno
  (let ((f (dynamic-pointer "errno" (dynamic-link))))
    (lambda ()
      (pointer-address (dereference-pointer f)))))
      
(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)
  (let ((r (ca code)))
    (if (< r 0)
        (raise error (errno) ((@ (guile) strerror) (errno)))
        (values))))

(define-syntax guile
  (syntax-rules ()
    ((_ (x ...) code)        (guile (x ...) code code))
    ((_ (x ...) code1 code2)
     (define code1 (lambda (x ...) (ca ((@ (guile) code2 x ...))))))
    ((_ code) (guile code code))
    ((_ code1 code2)
     (define code1 (lambda x (ca (apply (@ (guile) code2 x))))))))


(define path   "posixpath")
(define curdir ".")
(define pardir "..")
(define sep    "/")
(define extsep ".")
(define altsep  None)
(define pathsep ":")
(define linesep "\n")
(define defpath "/usr/bin")
(define devnull "/dev/null")

(define name  "posix")
(guile ctermid)

(define-values (environ environb)
  (let ()
    (define e (dereference-pointer (dynamic-pointer "environ" (dynamic-link))))
    (define (get-envs)
      (let lp ((e e))
        (let ((*e  (dereference-pointer e)))
          (if (null-pointer? *e)
              '()
              (cons
               (pointer->string *e)
               (lp (make-pointer (+ (pointer-address e) 8))))))))
    
    (define (getkw)
      (let lp ((es (get-envs)))
        (if (pair? es)
            (let ((x (string-split (car es) #\=)))
              (let ((k (car x))
                    (v (string-join (cdr x) "=")))
                (cons (cons k v) (lp (cdr es)))))
            '())))

    (define-python-class Env ()
      (define __init__
        (lambda (self) (values)))

      (define __getitem__
        (lambda (self k)
          (let ((r ((@ (guile) getenv) (slot-ref (pystring k) 'str))))
            (if r r (raise IndexError)))))

      (define __setitem__
        (lambda (self k v) 
          (putenv (slot-ref (pystring (+ k "=" v)) 'str))))

      (define __delitem__
        (lambda (self k)
          (putenv (slot-ref (pystring k) 'str))))
      
      (define __iter__
        (lambda (self)
          ((make-generator ()
             (lambda (yield)
               (for ((x : (getkw))) ()
                    (yield (car x) (cdr x)))))))))

    (define-python-class Envb ()
      (define __init__
        (lambda (self) (values)))

      (define __getitem__
        (lambda (self k)
          (let ((r (bytes ((@ (guile) getenv) (slot-ref (string k) 'str)))))
            (if r r (raise IndexError)))))

      (define __setitem__
        (lambda (self k v) 
          (putenv (slot-ref (string (+ k "=" v)) 'str))))

      (define __delitem__
        (lambda (self k)
          (putenv (slot-ref (string k) 'str))))
      
      (define __iter__
        (lambda (self)
          ((make-generator ()
             (lambda (yield)
               (for ((x : (getkw))) ()
                    (yield (car x) (cdr x)))))))))
    
    
    (values (Env) (Envb))))


(guile (path) chdir)

(define (fchdir fd)
  (error "not implemented"))

(guile () getcwd)

(define (fsencode fn)
  (error "not implemented"))
(define (fsdecode fn)
  (error "not implemented"))

(define-method (fspath (pth <string>      )) pth)
(define-method (fspath (pth <py-string>   )) pth)
(define-method (fspath (pth <py-bytes>    )) pth)
(define-method (fspath (pth <py-bytearray>)) pth)
(define-method (fspath (pth <p>           ))
  (aif it (ref pth '__fspath__)
       (it)
       (next-method)))

(define-python-class PathLike ()
  (define __fspath__
    (lambda (self) (error "not implemented"))))


(define* (getenv key #:key (default None))
  (try
   (lambda ()
     (pylist-ref environ key))
   (#:except IndexError => (lambda x default))))

(define* (getenvb key #:key (default None))
  (try
   (lambda ()
     (pylist-ref environb key))
   (#:except IndexError => (lambda x default))))

(define* (get_exec_path #:key (env #f))
  (define (f s)
    (let ((s (slot-ref (string s) 'str)))
      (string-split str ":")))      
  (if env
      (f (pylist-ref env     "PATH"))
      (f (pylist-ref environ "PATH"))))
      
(guile () getgid)
(guile () getegid)
(guile () geteuid)
  
(define (getgrouplist user group)
  (error "not impllemeneted"))

(guile () getgroups)

(guile getlogin)

(define getpgid
  (let ((f (pointer->procedure int
                               (dynamic-func "getpgid" (dynamic-link))
                               (list int))))
    (lambda (pid)
      (rm (f pid)))))

  
(guile getpgrp)
(guile getpid)
(guile getppid)

(define PRIO_PROCESS (@ (guile) PRIO_PROCESS))
(define PRIO_PRGRP   (@ (guile) PRIO_PRGRP))
(define PRIO_USER    (@ (guile) PRIO_USER))

(guile getpriority)

(define getresgid
  (let* ((f  (pointer->procedure
              void
              (dynamic-func "getresgid" (dynamic-link))
              '(* * *))))
         
    (lambda ()
      (let* ((a  (make-bytevector 8))
             (ap (bytevector->pointer a)) 
             (b (make-bytevector 8))
             (bp (bytevector->pointer b)) 
             (c (make-bytevector 8))
             (cp (bytevector->pointer c)))
        (rm (f ap bp cp))
        (list
         (bytevector-u16-ref a 0 (native-endianness))
         (bytevector-u16-ref b 0 (native-endianness))
         (bytevector-u16-ref c 0 (native-endianness)))))))

(guile getuid)

(define initgroup
  (let ((f (pointer->procedure
            'int
            (dynamic-func "initgroups" (dynamic-link))
            '(* int))))
         
    (lambda (user group)
      (rm (string->pointer user) group))))

(define (putenv key value)
  (pylist-set! environ key value))

(guile setegid)
(guile seteuid)
(guile setgid)

(guile setgroups)
(define setpgrp
  (let ((f (pointer->procedure 'int
                               (dynamic-func "setpgrp" (dynamic-link))
                               '())))
    (lambda ()
      (rm (f)))))

(guile setpgid)
(guile setpriority)

(define setregid
  (let ((f (pointer->procedure 'int
                               (dynamic-func "setregid" (dynamic-link))
                               '(int int))))
    (lambda (a b)
      (rm (f a b)))))

(define setresgid
  (let ((f (pointer->procedure 'int
                               (dynamic-func "setresgid" (dynamic-link))
                               '(int int int))))
    (lambda (a b c)
      (rm (f a b c)))))

(define setreuid
  (let ((f (pointer->procedure 'int
                               (dynamic-func "setreuid" (dynamic-link))
                               '(int int))))
    (lambda (a b)
      (rm (f a b)))))

(define setresuid
  (let ((f (pointer->procedure 'int
                               (dynamic-func "setresuid" (dynamic-link))
                               '(int int int))))
    (lambda (a b c)
      (rm (f a b c)))))

(guile getsid)
(guile setsid)
(guile setuid)
(guile strerror)
(guile umask)
(guile uname)
(guile unsetenv)

;; File descriptor operations
(define fdopen open)

(define close
  (lambda (fd)
    (ca (close-fd fd))))

(define (closerange fd_low fd_high)
  (for ((i : (range low high))) ()
       (try:
        (lambda () (close i))
        (#:except OSError => (lambda (x) (values))))))

(define device_encoding (lambda (fd) (error "not implemented")))

(guile (fd) dup)

(define dup2
  (let ((f (pointer->procedure 'int
                               (dynamic-func "dup3" (dynamic-link))
                               '(int int int))))
    (lambda* (fd fd2 #:optional (inheritable? #t))
      (if inheritable?
          (rm (f fd fd2 O_CLOEXEC))
          (ca ((@ (guile) dup2) fd fd2))))))
      
(guile (fd mode) fchmod)
(guile (fd uid gid) fchown)


(define (fdatasync fd) (error "not implemented"))
(define (fpathconf fd name) (error "not implemented"))

(define-syntax-rule (concat a ... stx)
  (datum->syntax
   stx
   (string->symbol
    (string-append
     a ...
     (symbol->string
      (syntax->datum stx))))))

(define-syntax statset
  (lambda (x)
    (syntax-case x ()
      ((_ (m ...) self scm)
       #'(begin (statset 1 m self scm) ...))
      ((_ 1 (m mm) self scm)
       (with-syntax ((mem  (concat "st_" #'mm))
                     (smem (concat "stat:" #'m)))
         #'(set self 'mem (smem scm)))))))
      ((_ 1 m self scm)
       (statset 1 (m m) self scm))))

(define-python-class stat_result ()
  (define __init__
     (lambda (self scm)
       (ca
        (begin
          (statset (mode ino dev nlink uid gid size atime mtime ctime
                         (atimensec atime_ns)
                         (mtimensec mtime_ns)
                         (ctimensec ctime_ns)
                         blksize blocks perms rdev type)
                   self scm)
          (if stat-float-times
           (begin
             (set self 'atime (* (ref self 'atime) 1.0))
             (set self 'mtime (* (ref self 'mtime) 1.0))
             (set self 'ctime (* (ref self 'ctime) 1.0))
             (set self 'atime_ns (/ (ref self 'atime_ns) 1000000000.0))
             (set self 'mtime_ns (/ (ref self 'mtime_ns) 1000000000.0))
             (set self 'ctime_ns (/ (ref self 'ctime_ns) 1000000000.0)))))))))
        
(name-object stat_result)
       
(define (fstat fd)
  (stat_result (stat fd)))

(define (fstatvfs fd) (error "not implemented"))

(guile (fd) fsynch fsync)

(guil (fd len) ftruncate truncate-file)

(guile (fd) isatty isatty?)

(define F_LOCK  1)
(define F_TLOCK 2)
(define F_ULOCK 0)
(define F_TEST  3)
(define lockf
  (let ((f (pointer->procedure 'int
                               (dynamic-func "lockf" (dynamic-link))
                               '(int int long))))
    (lambda (fd op len)
      (rm (f fd op len)))))



(define SEEK_SET  #x0)
(define SEEK_CUR  #x1)
(define SEEK_END  #x2)
(define SEEK_DATA #x3)
(define SEEK_HOLE #x4)

(define lseek 
  (let ((f (pointer->procedure 'int
                               (dynamic-func "lseek" (dynamic-link))
                               '(int long int))))
    (lambda (fd pos how)      
      (rm (f fd pos how)))))

(define open
  (let ((f (pointer->procedure 'int
                               (dynamic-func "openat" (dynamic-link))
                               '(int * int int))))

    (lambda* (path flags mode #:optional (dir_fd None))
      (if (eq? dir_fd None)
          (ca (open-fdes path flags mode))
          (rm (f dir_fd (string->pointer path) flags mode))))))
        

(define-syntax-rule (mko O) (define O (@ (guile) O)))
(mko O_RDONLY)
(mko O_WRONLY)
(mko O_RDWR)
(mko O_APPEND)
(mko O_CREAT)
(mko O_EXCL)
(mko O_TRUNC)

;;unix
(mko O_SYNC)
(mko O_NDELAY)
(mko O_NONBLOCK)
(mko O_NOCTTY)

;;
(mko O_LARGEFILE)
(mko O_NOTRANS)

(define O_DSYNC     #o10000)
(define O_RSYNC     O_SYNC)
(define O_CLOEXEC   #o2000000)
(define O_PATH      #o10000000)
(define O_DIRECTORY #o200000)
(define O_NOFOLLOW  #o400000)
(define O_DIRECT    #o40000)
(define O_NOATIME   #o1000000)
(define O_ASYNC     #o20000)
(define O_TMPFILE   (logior #o20000000 O_DIRECTORY))

(define openpty (lambda x (error "not implemented")))

(define pipe
  (let ((x (ca (@ (guile) pipe))))
    (values (car x) (cdr x))))

(define pipe2
  (let ((f (pointer->procedure 'int
                               (dynamic-func "pipe2" (dynamic-link))
                               '(int * int))))
    (lambda (flags)
      (let* ((a  (make-bytevector 16))
             (ap (bytevector->pointer a)))
        (rm (f ap flags))
        (values (bytevector-s32-ref a 0 (native-endianness))
                (bytevector-s32-ref a 1 (native-endianness)))))))


(define posix_fallocate
  (let ((f (pointer->procedure 'int
                               (dynamic-func "posix_fallocate" (dynamic-link))
                               '(int long long))))
    (lambda (fd off len)
      (rm (f fd off len)))))

(define posix_fadvise
   (let ((f (pointer->procedure 'int
                               (dynamic-func "posix_fadvise" (dynamic-link))
                               '(int long long int))))
    (lambda (fd off len advice)
      (rm (f fd off len advice)))))

(define POSIX_FADV_NORMAL     0)
(define POSIX_FADV_RANDOM     1)
(define POSIX_FADV_SEQUENTIAL 2)
(define POSIX_FADV_WILLNEED   3)
(define POSIX_FADV_DONTNEED   4)
(define POSIX_FADV_NOREUSE    5)

(define pread
  (let ((f (pointer->procedure 'int
                               (dynamic-func "pread" (dynamic-link))
                               '(int * long long))))
    (lambda (fd size offset)
      (let* ((a  (make-bytevector size))
             (ap (bytevector->pointer a)))
        (let ((n (rm (f fd ap size offset))))
          (if (= n 0)
              (make-bytevector 0)
              (let ((o (make <bytevector>)))
                (slot-set! o 'n (size))
                (slot-set! o 'size n)
                (slot-set! o 'bv   a)
                o)))))))

(define pwrite
  (let ((f (pointer->procedure 'int
                               (dynamic-func "pwrite" (dynamic-link))
                               '(int * long long))))
  
    (lambda (fd a offset)
      (let* ((ap (bytevector->pointer a)))
        (rm (f fd ap size offset))))))

(define read
  (let ((f (pointer->procedure 'int
                               (dynamic-func "read" (dynamic-link))
                               '(int * long))))
    (lambda (fd size)
      (let* ((a  (make-bytevector size))
             (ap (bytevector->pointer a)))
        (let ((n (rm (f fd ap size))))
          (if (= n 0)
              (make-bytevector 0)
              (let ((o (make <bytevector>)))
                (slot-set! o 'n (size))
                (slot-set! o 'size n)
                (slot-set! o 'bv   a)
                o)))))))

(define (sendfile out in offset count)
  (ca
   (if (eq? count None)
       ((@ (guile) sendfile out in count))
       ((@ (guile) sendfile out in count offset)))))

(define F_GETFL 3)
(define fcntl2 (pointer->procedure 'int
                                   (dynamic-func "fcntl" (dynamic-link))
                                   '(int int)))
(define fcntl3 (pointer->procedure 'int
                                   (dynamic-func "fcntl" (dynamic-link))
                                   '(int int INT)))

(define (set_blocking fd is-blocking?)
  (let ((o (rm (fcntl2 fd F_GETFL))))
    (if is-blocking?
        (rm (fcntl3 fd F_GETFL (logior o O_NONBLOCK)))
        (rm (fcntl3 fd F_GETFL (logand o (lognot O_NONBLOCK)))))))

(define (get_blocking fd)
  (if (= (logand O_NONBLOCK (rm (fcntl2 fd F_GETFL))) 0)
      #f
      #t))

(define (readv fd buffers) (error "not implemented"))

(guile (fd pg) tcsetpgrp)
(guile (fd)    ttyname)

(define write
  (let ((f (pointer->procedure 'int
                               (dynamic-func "write" (dynamic-link))
                               '(int * long))))
  
    (lambda (fd a)
      (let* ((ap (bytevector->pointer a)))
        (rm (f fd ap size))))))

(define (writev fd buffers) (error "not implemented"))
    

(define (set_inheritable fd is-inh?)
  (let ((o (rm (fcntl2 fd F_GETFL))))
    (if is-inh?
        (rm (fcntl3 fd F_GETFL (logior o O_CLOEXEC)))
        (rm (fcntl3 fd F_GETFL (logand o (lognot O_CLOEXEC)))))))

(define (get_inheritable fd)
  (if (= (logand O_CLOEXEC (rm (fcntl2 fd F_GETFL))) 0)
      #f
      #t))


;; Files and dir
(define AT_EACCESS          #x200)
(define AT_SYMLINK_NOFOLLOW #x100)

(define F_OK (@ (guile) F_OK))
(define W_OK (@ (guile) W_OK))
(define R_OK (@ (guile) R_OK))
(define X_OK (@ (guile) X_OK))

(define access
  (let ((f  (pointer->procedure 'int
                               (dynamic-func "access" (dynamic-link))
                               '(* int)))
        (fa (pointer->procedure 'int
                                (dynamic-func "faccessat" (dynamic-link))
                                '(* int int int))))

    (lambda* (path mode #:key
                   (dir_fd None)
                   (effective_ids #f)
                   (follow_symlinks #t))
      (if (eq? dir_fd None)
          (rm (f  (string->pointer path) mode))
          (rm (fa (string->pointer path) mode dir_fd
                  (logior (if effective_ids AT_EACCESS 0)
                          (if follow_symlinks 0 AT_SYMLINK_NOFOLLOW))))))))



(define chdir
  (let ((f (pointer->procedure 'int
                               (dynamic-func "access" (dynamic-link))
                               '(*))))
    (lambda (pth)
      (let ((pth (aif it (ref pth '__fspath__)
                      (it)
                      pth)))
        (if (int? pth)
            (rm (f pth))
            (ca ((@ (guile) chdir) pth)))))))


(define chflags
  (lambda x (error "Not implemented")))

(define chmod
  (let ((f   (pointer->procedure 'int
                                 (dynamic-func "chmod" (dynamic-link))
                                 '(* int)))
        (ff  (pointer->procedure 'int
                                 (dynamic-func "fchmod" (dynamic-link))
                                 '(int int)))
        (fat (pointer->procedure 'int
                                 (dynamic-func "fchmodat" (dynamic-link))
                                 '(* int int int))))
  (lambda* (path mode #:key (dir_fd None) (follow_symlinks #t))
    (if (int? path)
        (rm (ff path mode))
        (let ((path (aif it (ref path '__fspath__)
                         (it)
                         path)))
          (if (eq? dir_fd None)
              (rm (f   (string->pointer path) mode))
              (rm (fat (string->pointer path) mode
                       dir_fd
                       (if follow_symlinks
                           0
                           AT_SYMLINK_NOFOLLOW)))))))))



(define (path-it path)
  (aif it (ref path '__fspath__)
       (it)
       path))

(define chown
  (let ((f   (pointer->procedure 'int
                                 (dynamic-func "chown" (dynamic-link))
                                 '(* int int)))
        (ff  (pointer->procedure 'int
                                 (dynamic-func "fchown" (dynamic-link))
                                 '(int int int)))
        (lf  (pointer->procedure 'int
                                 (dynamic-func "lchow" (dynamic-link))
                                 '(* int int)))
        (fat (pointer->procedure 'int
                                 (dynamic-func "fchownat" (dynamic-link))
                                 '(* int int int int))))
    (lambda* (path uid gid #:key (dir_fd None) (follow_symlinks #t))
      (if (int? path)
          (rm (ff path uid gid))
          (let ((path (path-it path)))
            (if (eq? dir_fd None)
                (if follow_symlinks
                    (rm (f  (string->pointer path) uid gid))
                    (rm (lf (string->pointer path) uid gid)))
                (rm (fat (string->pointer path) uid gid dir_fd
                         (if follow_symlinks
                             0
                             AT_SYMLINK_NOFOLLOW)))))))))

(guile ((x)) chroot)

(define fchdir chdir)

(guile () getcwd)

(define (getcwdb)
  (byte (getcwd)))

(define lchflags (lambda x (error "not implemented")))

(define (lchmod path mode)
  (chmod path mode #:follow_symlinks #f))

(define (lchown path uid gid)
  (chown path uid gid #:follow_symlinks #f))

(define link
  (let ((f (pointer->procedure 'int
                                 (dynamic-func "linkat" (dynamic-link))
                                 '(* * int int int))))
    (lambda* (src dst #:key
                  (src_dir_fd None)
                  (dst_dir_fd None),
                  (follow_symlinks #t))
      (let ((src (path-it src))
            (dst (path-it dst))
            (src_dir_fd (if (eq? src_dir_fd None) AT_FDCWD src_dir_fd))
            (dst_dir_fd (if (eq? dst_dir_fd None) AT_FDCWD dst_dir_fd)))
        (rm (f (string->pointer src)
               (string->pointer dst)
               src_dir_fd
               dst_dir_fd
               (if follow_symlinks
                   0
                   AT_SYMLINK_NOFOLLOW)))))))

(define listdir
  (lambda* (#:optional (pth "."))
    (let ((pth (if (number? pth)
                   ((@ (guile) read-link) (format #f "/proc/self/fd/~a" pth))
                   (path-it pth))))
      (let ((o (ca (opendir pth))))
        (dynamic-wind
          (lambda x #f)
          (lambda ()
            (let lp ((o ) (l '()))
              (let ((w (ca (readdir o))))
                (if (eof-object? w)
                    '()
                    (cons w (lp o))))))
          (lambda x (closedir o)))))))

(define stat
  (let ((f (pointer->procedure int
                               (dynamic-func "__fxstatat" (dynamic-link))
                               (list int int '* '* int)))
        (g (pointer->procedure '*
                               (dynamic-func "scm_stat2scm_" (dynamic-link))
                               '(*))))
    (lambda* (path #:key (dir_fd None) (follow_symlinks #t))
      (if (number? path)
          (stat_result ((@ (guile) stat) path))
          (let ((path (path-it path)))
            (if (eq? dir_fd None)
                (if follow_symlinks
                    (stat_result ((@ (guile) stat) path))
                    (stat_result ((@ (guile) lstat) path)))
                (let* ((bv  (make-bytevector 80))
                       (bvp (bytevector->pointer bv))) 
                  (rm (f 1 ;Special linux flag
                         (string->pointer path)
                         bvp
                         (if follow_symlinks
                             0
                             AT_SYMLINK_NOFOLLOW)))
                  (stat_result (ca (pointer->scm (g bvp)))))))))))

(define lstat
  (lambda* (path #:key (dir_fd None))
    (stat path #:dir_fd dir_fd #:follow_symlinks #f)))

(define mkdir
  (let ((fat (pointer->procedure int
                                 (dynamic-func "mkdirat" (dynamic-link))
                                 (list int * int))))
    (lambda* (path mode #:key (dir_fd None))
      (rm (fat (if (eq? dir_fd None) AT_FDCWD dir_fd)
               (string->pointer (path-it path))
               mode)))))

(define* (mkdirs name mode #:key (exist_ok #f))
  (let lp ((pre "") (l (string-split (path-it name) #\/)))
    (match l
      (()  (values))
      ((x) (let ((s (string-append pre "/" x)))
             (catch #t
               (lambda ()
                 ((@ (guile) stat) s)
                 (if exist_ok
                     (values)
                     (raise error
                            (format #f "dir ~a in mkdirs already exist" s))))
               (lambda x
                 (mkdir s mode)))))
      ((x . l)
       (let ((s (string-append pre "/" x)))
         (catch #t
           (lambda ()
             ((@ (guile) stat) s))
           (lambda x
             (mkdir s mode)))
         (lp s l))))))

(define mkfifo
  (let ((fat (pointer->procedure int
                                 (dynamic-func "mkfifoat" (dynamic-link))
                                 (list int * int))))
    (lambda* (path mode #:key (dir_fd None))
      (rm (fat (if (eq? dir_fd None) AT_FDCWD dir_fd)
               (string->pointer (path-it path))
               mode)))))

(define mknod
  (let ((fat (pointer->procedure int
                                 (dynamic-func "mknodat" (dynamic-link))
                                 (list int * int))))
    (lambda* (path mode #:optional (device 0) #:key (dir_fd None))
      (rm (fat (if (eq? dir_fd None) AT_FDCWD dir_fd)
               (string->pointer (path-it path))
               mode
               device)))))

(define major
  (let ((f (pointer->procedure int
                               (dynamic-func "gnu_dev_major" (dynamic-link))
                               (list int64))))
    (lambda (device)
      (ca (f device)))))

(define minor
  (let ((f (pointer->procedure int
                               (dynamic-func "gnu_dev_minor" (dynamic-link))
                               (list int64))))
    (lambda (device)
      (ca (f device)))))

(define makedev
  (let ((f (pointer->procedure int64
                               (dynamic-func "gnu_dev_makedev" (dynamic-link))
                               (list int int))))
    (lambda (major minor)
      (ca (f major minor)))))

(define pathconf_names (dict))
(pylist-set! pathconf_names "PC_LINK_MAX"  0)
(pylist-set! pathconf_names "PC_MAX_CANON" 1)
(pylist-set! pathconf_names "PC_MAX_INPUT" 2)
(pylist-set! pathconf_names "PC_NAME_MAX"  3)
(pylist-set! pathconf_names "PC_PATH_MAX"  4)
(pylist-set! pathconf_names "PC_PIPE_BUF"  5)
(pylist-set! pathconf_names "PC_CHOWN_RESTRICTED" 6)
(pylist-set! pathconf_names "PC_NO_TRUNC"  7)
(pylist-set! pathconf_names "PC_VDISABLE"  8)

(define-syntax-rule (rmp code)
  (let ((e (errno))
        (r (ca code)))
    (if (>= r 0)
        r
        (let ((e2 (errno)))
          (if (eq? e e2)
              (error "Bug could not find pathcond name endex")
              (rm e2))))))

         
(define pathconf
  (let ((f (pointer->procedure long
                               (dynamic-func "pathconf" (dynamic-link))
                               (list '* int)))
        (ff (pointer->procedure long
                               (dynamic-func "fpathconf" (dynamic-link))
                               (list int int))))
    (lambda (path name)
      (let ((ni (pylist-ref pathconf_names name)))
        (if (number? path)
            (rmp (ff path ni))
            (let ((path (path-it path)))
              (rmp (f (string->pointer path) ni))))))))

(define readlink
  (let ((fat (pointer->procedure int
                                 (dynamic-func "readlinkat" (dynamic-link))
                                 (list int * * long))))
    (lambda* (path #:key (dir_fd None))
      (let* ((n   10000)
             (bv  (make-bytevector 10000))
             (bvp (bytevector->pointer bv)))
        (rm (fat (if (eq? dir_fd None) AT_FDCWD dir_fd)
                 (string->pointer (path-it path))
                 bvp
                 n))
        (bytevector-u8-set! bv (- n 1) 0)
        (pointer->string bvp)))))


(define remove
  (let ((fat (pointer->procedure int
                                 (dynamic-func "unlinkat" (dynamic-link))
                                 (list int * int))))
    (lambda* (path #:key (dir_fd None))
      (rm (fat (if (eq? dir_fd None) AT_FDCWD dir_fd)
               (string->pointer (path-it path))
               0)))))

(define unlink remove)

(define rmdir
  (lambda (path #:key (dir_fd None))
    (let ((path (path-it path)))
      (if (eq? dir_fd None)
          ((@ (guile) rmdir) path)
          (let* ((fd   (open path O_DIRECTORY #:dir_fd dir_fd))
                 (path ((@ (guile) read-link) '
                        (format #f "/proc/self/fd/~a" fd))))
            (close fd)
            ((@ (guile) rmdir) path))))))

(define (removedirs name)
  (let ((name (path-it name)))
    (let lp ((l (reverse (string-split name #\/))))
      (if (pair? l)
          (let ((path (string-join (reverse l) "/")))
            (catch #t
              (lambda () (rmdir path))
              (lambda x (values)))
            (lp (cdr l)))))))

(define rename
  (let ((fat (pointer->procedure int
                                 (dynamic-func "renameat" (dynamic-link))
                                 (list int * int *))))
    (lambda* (src dst #:key (src_dir_fd None) (dst_dir_fd None))
      (rm (fat (if (eq? src_dir_fd None) AT_FDCWD src_dir_fd)
               (string->pointer (path-it src))
               (if (eq? dst_dir_fd None) AT_FDCWD dst_dir_fd)
               (string->pointer (path-it src)))))))


(define replace rename)

(define (renames old new)
  (let ((old (path-it old))
        (new (path-it new)))
    (let lp ((l (string-split new #\/)) (d '()))
      (match l
        (() #t)
        ((x) #t)
        (("" . l)
         (lp l (cons "" d)))
        ((x . l)
         (if (pair? d)
             (let ((path (string-join (reverse d) "/")))
               (catch #t
                 (lambda () (stat path))
                 (lambda x (mkdir path)))
               (lp l (cons x d)))
             (lp l (cons x d))))))
    (rename old new)
    (let ((l (split old #\/)))
      (if (> (length l) 1)
          (if (= (length l) 2)
              (removedirs (string-concat (car l) "/"))
              (removedirs (string-join (reverse (cdr (reverse l))) "/")))))
    (values)))


                 
(define-python-class DirEntry ()
  (define __init__
    (lambda (self path stat errno)
      (set self 'name (basename path))
      (set self 'path path)
      (set self '__errno errno)
      (set self '__stat stat)))
  
  (define inode
    (lambda (self)
      (let ((stat (ref self '__stat)))
        (if stat
            (stat:ino stat)
            (raise error (ref self '__errno))))))
  
  (define is_dir
    (lambda* (self #:key (follow_symlinks #t))
      (let ((s (stat (ref self 'path) #:follow_symlink follow_symlink)))
        ((@ (stat) is-dir?) (ref s '_st_mode)))))
  
  (define is_file
    (lambda* (self #:key (follow_symlinks #t))
      (let ((s (stat (ref self 'path) #:follow_symlink follow_symlink)))
        ((@ (stat) is-reg?) (ref s '_st_mode)))))

  (define is_symlink
    (lambda (self)
      (let ((s (stat (ref self 'path))))
        ((@ (stat) is-lnk?) (ref s '_st_mode)))))
  
  (define stat
    (lambda* (self #:key (follow_symlinks #t))
      (stat (ref self 'path) #:follow_symlinks follow_symlinks))))

(define* (scandir #:optional (path "."))
  (make-generator ()
    (lambda (yield)
      (file-system-fold
       (lambda x #t)
       (lambda (path stat errno r)
         (yield (DirEntry path stat errno)))
       (lambda (path stat res)
         (yield (DirEntry path stat 0)))
       (lambda (path stat res)
         (values))
       (lambda (path stat res)
         (values))
       (lambda (path stat errno res)
         (values))
       #f
       (path-it path)))))

(define stat-float-times #t)
(define (stat_float_times newvalue)
  (set! stat-float-times newvalue))

(define ST_RDONLY      1)
(define ST_NOSUID      2)
(define ST_NODEV       4)
(define ST_NOEXEC      8)
(define ST_SYNCHRONOUS 16)
(define ST_MANDLOCK    64)
(define ST_WRITE       128)
(define ST_APPEND      256)
(define ST_IMMUTABLE   512)
(define ST_NOATIME     1024)
(define ST_NODIRATIME  2048)
(define ST_RELATIME    4096)

(define-python-class StatVFS ()
  (define __init__
    (lambda (self a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11)
      (map
       (lambda (x y) (set self x y))
       '(f_bsize
         f_frsize
         f_blocks
         f_bfree
         f_bavail      
         f_files
         f_ffree
         f_favail      
         f_fsid
         f_flag
         f_namemax)
       (list a1 a2 a3 a4 a5 a6 a7 a8 a9 a10)))))

(define statvfs
  (let ((f (pointer->procedure int
                               (dynamic-func "statvfs" (dynamic-link))
                               (list * *)))
        (ff (pointer->procedure int
                               (dynamic-func "fstatvfs" (dynamic-link))
                               (list int *)))))
    (lambda (path)
      (let* ((bv (make-bytevector 11*8))
             (bvp (bytevector->pointer bv)))
        (rm (if (number? path)
                (ff path bvp)
                (f (string->pointer (path-it path)) bvp)))
            
        (StatVFS
         (bytevector-u64-ref bv 0  (native-endianness))
         (bytevector-u64-ref bv 1  (native-endianness))
         (bytevector-u64-ref bv 2  (native-endianness))
         (bytevector-u64-ref bv 3  (native-endianness))
         (bytevector-u64-ref bv 4  (native-endianness))
         (bytevector-u64-ref bv 5  (native-endianness))
         (bytevector-u64-ref bv 6  (native-endianness))
         (bytevector-u64-ref bv 8  (native-endianness))
         (bytevector-u64-ref bv 9  (native-endianness))
         (bytevector-u64-ref bv 10 (native-endianness)))))))

(define symlink
  (let ((fat (pointer->procedure int
                                 (dynamic-func "symlinkat" (dynamic-link))
                                 (list '* int '*))))

    (lambda* (src dst #:key (target_is_directory #f) (dir_fd None))
      (rm (fat ((string->pointer (path-it dst))
                (if (eq? dir_fd None) AT_FDCWD dir_fd)
                (string->pointer (path-it src))))))))

(define truncate
  (let ((ff (pointer->procedure int
                                (dynamic-func "ftruncate" (dynamic-link))
                                (list int long)))
        (f  (pointer->procedure int
                                (dynamic-func "truncate" (dynamic-link))
                                (list '*  long))))

    (lambda (path length)
      (rm (if (number? path)
              (ff path length)
              (f (string->pointer (path-it path))
                 length))))))

(define UTIME_NOW (- (ash 1 30) 1))
(define utime
  (let ((ff  (pointer->procedure int
                                 (dynamic-func "futimens" (dynamic-link))
                                 (int '*)))
        (fat (pointer->procedure int
                                 (dynamic-func "futimensat" (dynamic-link))
                                 (int '* '* int)))

    (lambda* (path #:optional (times None) (ns #f) #:key (dir_fd None)
                   (follow_symlinks #t))
      (let* ((bv  (make-bytevector 32))
             (bvp (byteector->pointer bv)))
        (if (eq? ns None)
            (if (eq? times None)
                (let ()
                  (bytevector-s64-set! bv 0 0
                                       (native-endianness))
                  (bytevector-s64-set! bv 1 0 UTIME_NOW
                                       (native-endianness))
                  (bytevector-s64-set! bv 2 0
                                       (native-endianness))
                  (bytevector-s64-set! bv 3 UTIME_NOW
                                       (native-endianness)))
                (let ((x1 (pylist-ref ns 0))
                      (x2 (pylist-ref ns 1)))
                  (bytevector-s64-set! bv 0 (floor-quotient x1 1000000000)
                                       (native-endianness))
                  (bytevector-s64-set! bv 1 (modulo  x1 1000000000)
                                       (native-endianness))
                  (bytevector-s64-set! bv 2 (floor-quotient x2 1000000000)
                                       (native-endianness))
                  (bytevector-s64-set! bv 3 (modulo  x2 1000000000)
                                       (native-endianness))))
            (if (eq? times None)
                (begin
                  (bytevector-s64-set! bv 0 (pylist-ref times 0)
                                       (native-endianness))
                  (bytevector-s64-set! bv 1 0
                                       (native-endianness))
                  (bytevector-s64-set! bv 2 (pylist-ref times 1)
                                       (native-endianness))
                  (bytevector-s64-set! bv 3 0
                                       (native-endianness)))
                (raise error "utime cannot set both s and ns")))
        (rm (if (number? path)
                (ff path bvp)
                (fat (if (eq? dir_fd AT_FDCWD None) dir_fd) bvp
                     (string->pointer (path-it path))
                     (if follow_symlinks
                         0
                         AT_SYMLINK_NOFOLLOW)))))))))


(define* (walk top #:key (topdown #t) (onerror None) (followlinks #f))
  ((make-generator ()
    (lambda (yield)
      (let/ec ret
        (define dirs    (py-list))
        (define nondirs (py-list))
        (define entries #f)
    
        (try
         (lambda ()
           (set! entries (py-list (scandir top))))
         (#except error =>
                  (lambda (x . _)
                    (if onerror (onerror x) (ret)))))
       
        (for ((entry : entries)) ()
             (define is_dir (try
                             (lambda ((ref entry 'is_dir)))
                             (#:except error => (lambda x #f))))
             (if is_dir
                 (pylist-append! dirs    (ref entry 'name))
                 (pylist-append! nondirs (ref entry 'name)))

             (if (and (not topdown) is_dir)
                 (let ((walk-into
                        (if followlinks
                            #t
                            (not
                             (try
                              (lambda () ((ref entry 'is_symlink)))
                              (#:except error => (lambda x #f)))))))
                   (if walk_into
                       (for ((a b c : (walk (ref entry 'path) topdown
                                            onerror followlinks))) ()
                           (yield a b c)))))
        
             (if topdown
                 (begin
                   (yield top dirs nondirs)

                   (let ((islink  (ref path 'islink))
                         (join    (ref path 'join)))
                     (for ((dirname : dirs)) ()
                          (let ((new_path (join top dirname)))
                            (if (or followlinks (not (islink new_path)))
                                (for ((a b c : (walk new_path topdown onerror
                                                     followlinks))) ()
                                   (yield a b c)))))))
                 (yield top dirs nondirs))))))))

(define (path:samestat s1 s2)
  (and (equal? (ref s1 'st_dev) (ref s2 'st_dev))
       (equal? (ref s1 'st_ino) (ref s2 'st_ino))))

(define (path:normpath p)
  (let lp ((l (string-split (path-it p) #\/)) (r '()) (first? #t))
    (match l
      (("") (lp '() (cons "" r) #f))
      (("." . l)
       (lp l r #f))
      ((""  . l)
       (if first?
           (lp l (cons "" r) #f)           
           (lp l r #f)))
      ((".." . l)
       (match r
         (("")
          (raise ValueError "normpath .. beond /"))
         ((".." . u)
          (lp l (cons ".." r) #f))
         ((_ . u)
          (lp l u #f))
         (()
          (lp l (cons ".." r) #f))))
      ((x . l)
       (lp l (cons x r) #f))
      (() (string-join (reverse r) "/")))))

(define (path:join . l)
  (normpath (string-join (map path-it l) "/")))

(define (_fwalk topfd toppath topdown onerror follow_symlinks)
  ((make-generator ()
   (lambda (yield)
     (define names   (listdir topfd))
     (define dir     (py-list))
     (define nondirs (py-list))

     (for ((name : names)) ()
          (try
           (lambda ()
             (if (S_ISDIR (ref (stat name #:dir_fd topfd) 'st_mode))
                 (pylist-append! dirs    name)
                 (pylist-append! nondirs name)))
           (#:except error =>
             (lambda x
               (try
                (lambda ()
                  (if (S_ISLNK (ref (stat name #:dir_fd topfd
                                          #:follow_symlinks #f)
                                    'st_mode))
                      (pylist-append! nondirs name)))
                (#:except error => (lambda x (values))))))))
      
     (if topdown
         (yield toppath dirs nondirs topfd))
     
     (for continue ((name : dirs)) ()
          (call-with-values
              (lambda ()
                (try
                 (lambda ()
                   (values (stat name #:dir_fd topfd
                                 #:follow_symlinks follow_symlinks))
                   (open name O_RDONLY #:dir_fd topfd))
                 (#:except errpr =>
                  (lambda (err . l)
                    (if (not (eq? onerror None))
                        (onerror err)
                        (continue))))))
            (lambda (orig_st dirfd)
              (try
               (lambda ()
                 (if (or follow_symlinks (path:samestat orig_st (stat dirfd)))
                     (let ((dirpath (path:join toppath name)))
                       (for ((a b c d :
                                (_fwalk dirfd dirpath topdown onerror
                                        follow_symlinks))) ()
                         (yield a b c d)))))
               (#:finally
                (close dirfd))))))

     (if not topdown
         (yield toppath dirs nondirs topfd))))))

(define* (fwalk #:optinal (top ".") (topdown #t) (onerror #t)
                #:key     (follow_symlinks #f) (dir_fd None))
  ((make-generator ()
   (lambda (yield)
     (define orig_st (stat top #:follow_symlinks #f #:dir_fd dir_fd))
     (define topfd   (open top O_RDONLY #:dir_fd dir_fd))

     (try
      (if (or follow_symlinks or (and (S_ISDIR (ref orig_st 'st_mode))
                                      (path:samestat orig_st (stat topfd))))
          (for ((a b c d : (_fwalk topfd top topdown onerror follow_symlinks)))
               ()
            (yield a b c d)))
      (#:finally:
       (close topfd)))))))

;; Extended attributes
(define getxattr
  (let ((f   (pointer->procedure int
                                (dynamic-func "getxattr" (dynamic-link))
                                ('* '* '* int)))
        (lf  (pointer->procedure int
                                (dynamic-func "lgetxattr" (dynamic-link))
                                ('* '* '* int)))
        (ff  (pointer->procedure int
                                (dynamic-func "fgetxattr" (dynamic-link))
                                ('* '* '* int))))
    (lambda (path attribute #:key (follow_symlink #t))
      (let ((path (ca (if (number? path)
                          path
                          (string->pointer (path-it path)))))
             (k   (ca (string->pointer attribute))))
         (let lp ((size 128))
           (let ((v  (make-bytevector size))
                 (pv (bytevector->pointer v)))
             (let ((n (rm (if (number? path)
                              (ff path k pv size)
                              (if follow_symlink
                                  (f path k pv size)
                                  (lf path k pv size))))))
               (if (> n (- size 2))
                   (lp (* 2 size))
                   (pointer->string pv)))))))))

(define listxattr
  (let ((f  (pointer->procedure int
                                (dynamic-func "listxattr" (dynamic-link))
                                ('* '* int)))
        (lf (pointer->procedure int
                                (dynamic-func "llistxattr" (dynamic-link))
                                ('* '* int)))
        (ff (pointer->procedure int
                                (dynamic-func "flistxattr" (dynamic-link))
                                ('* '* int))))
    (define (mk l)
      (define v  (make-bytevector (+ (length l) 1)))
      (define vp (bytevector->pointer))
      (let lp ((i 0) (l l))
        (if (pair? l)
            (begin
              (bytevector-u8-set! v i (car l))
              (lp (+ i 1) (cdr l)))
            (begin
              (bytevector-u8-set! v i 0)
              (pointer->string vp)))))
    
    (lambda (path attribute #:key (follow_symlink #t))
      (let ((path (if (number? path) path (string->pointer (path-it path)))))
        (let lp ((size 128))
          (let ((v  (make-bytevector size))
                (pv (bytevector->pointer v)))
            (let ((n (rm (if (number? path)
                             (ff path pv size)
                             (if follow_symlink
                                 (f path pv size)
                                 (lf path pv size))))))
              (if (> n (- size 2))
                  (lp (* 2 size))
                  (let lp ((i 0) (l '()))
                    (if (< i n)
                        (let lp2 ((j i) (r '()))
                          (if (< j n)
                              (let ((x (bytevector-u8-ref v j)))
                                (if (= x 0)
                                    (if (null? r)
                                        (lp  (+ j 1) l)
                                        (lp  (+ j 1) (cons (mk (reverse r))
                                                           l)))
                                    (lp2 (+ j 1) (cons x r))))
                              (if (null? r)
                                  (lp j l)
                                  (lp j (cons (mk (reverse r) l))))))
                        (pylist (reverse l)))))))))))))

(define removexattr
  (let ((f  (pointer->procedure int
                                (dynamic-func "removexattr" (dynamic-link))
                                ('* '*)))
        (lf (pointer->procedure int
                                (dynamic-func "lremovexattr" (dynamic-link))
                                ('* '*)))
        (ff (pointer->procedure int
                                (dynamic-func "fremovexattr" (dynamic-link))
                                (int '*))))
    (lambda (path attribute #:key (follow_symlink #t))
      (let ((path (if (number? path)
                      path
                      (string->pointer (path-it path))))
            (k    (ca (string->pointer attribute))))
        (rm (if (number? path)
                (ff path k)
                (if follow_symlink
                    (f  path k)
                    (lf path k))))))))

(define setxattr
  (let ((f  (pointer->procedure int
                                (dynamic-func "setxattr" (dynamic-link))
                                ('* '* '* int int)))
        (lf (pointer->procedure int
                                (dynamic-func "lsetxattr" (dynamic-link))
                                ('* '* '* int int)))
        (ff (pointer->procedure int
                                (dynamic-func "fsetxattr" (dynamic-link))
                                (int '* '* int int))))
    (lambda (path attribute value flags #:key (follow_symlink #t))
      (let ((path (if (number? path) path (string->pointer (path-it path))))
            (val  (ca (string->pointer value)))
            (s    (string-length val))
            (k    (ca (string->pointer attribute))))
        (rm (if (number? path)
                (ff path k val s flags)
                (if follow_symlink
                    (f  path k val s flags)
                    (lf path k val s flags))))))))
  
(define XATTR_SIZE_MAX (ash 1 16))
(define XATTR_CREATE  1)
(define XATTR_REPLACE 2)

;; Processes
(define (abort) ((@ (guile) raise) (@ (guile) SIGABRT)))

(define (comp e pth)
  (if (eq? (string-ref pth 0) #\/)
      pth
      (let ((r (pylist-get e "PATH")))
        (if r
            (let lp ((l (string-split r #\:)))
              (match l
                ((pp . l)
                 (let ((newpath (join pp p)))
                   (if (exists newpath)
                       newpath
                       (lp l))))
                (()
                 pth)))
            pth))))
                 

(define (compe e)
  (for ((k v : e)) ((l '()))
       (cons (string-append k "=" v) l)
       #:final (reverse l)))

(define (execl  path . args) (apply (@ (guile) execl) (path-it path) args))
(define (execle path . args) (apply (@ (guile) execl) (path-it path)
                                    (let* ((a (reverse args))
                                           (e (compe (car args)))
                                           (l (reverse (cdr args))))
                                      (cons e l))))
(define (execlpe path . args)      
  (let* ((a (reverse args))
         (e (compe (car args)))
         (l (cons e (reverse (cdr args))))))
  (apply (@ (guile) execle) (comp e (path-it path)) l)

(define (execlp path . args) (apply (@ (guile) execlp) (path-it path) args))

(define (execv path args)
  (apply execl path (for ((a : args)) ((l '()))
                         (cons a l)
                         #:final (reverse l))))

(define (execve path args env )
  (apply execle path (for ((a : args)) ((l (list env)))
                          (cons a l)
                          #:final (reverse l))))

(define (execvp path args)
  (apply execlp path (for ((a : args)) ((l '()))
                          (cons a l)
                          #:final (reverse l))))

(define (execvp path args env)
  (apply execlpe path (for ((a : args)) ((l (list env)))
                         (cons a l)
                         #:final (reverse l))))



(define (_exit n) (primitive-_exit n))

(define EX_OK           0)
(define EX_USAGE        64)
(define EX_DATAERR      65)
(define  EX_NOINPUT     66)
(define EX_NOUSER       67)
(define EX_NOHOST       68)
(define EX_UNAVAILABLE  69)
(define EX_SOFTWARE     70)
(define EX_OSERR        71)
(define EX_OSFILE       72)
(define EX_CANTCREAT    73)
(define EX_IOERR        74)
(define EX_TEMPFAIL     75)
(define EX_PROTOCOL     76)

(define fork primitive-fork)

(define (kill pid sig) (ca ((@ (guile) kill) pid sig)))

(define (nice i) (ca ((@ (guile) nice) i)))

(define killpg
  (let ((f))
    (lambda (pgid sig)
      (rm (f pgid sig)))))

(define (plock . l) (error "not implemented"))

(define popen)

(define P_WAIT 0)
(define P_NOWAIT  1)
(define P_NOWAIT0 1)

(define-syntax-rule (mk-spawn f ff)
  (define (f mode . l)
    (let ((pid (primitive-fork)))
      (if (= l 0)
          (apply ff l)
          (cond
           ((= mode P_WAIT)
            (cdr ((@ (guile) waitpid) pid)))
           ((= mode P_NOWAIT)
            pid)
           (else
            (raise ValueError "wrong mode specified in spawn command")))))))

(mk-spawn spawnl    execl)
(mk-spawn spawnle   execle)
(mk-spawn spawnlp   execlp)
(mk-spawn spawnlpe  execlpe)
(mk-spawn spawnv    execv)
(mk-spawn spawnve   execve)
(mk-spawn spawnvp   execvp)
(mk-spawn spawnvpe  execvpe)

(define supprts_dir_fs
  (set '()))

(define support_effective_ids
  (set '()))

(define supports_fd
  (set '()))