further improvements of os module

1 files changed, 704 insertions, 8 deletions

diff --git a/modules/language/python/module/os.scm b/modules/language/python/module/os.scm
index b5b8a18..f12f1c5 100644
--- a/modules/language/python/module/os.scm
+++ b/modules/language/python/module/os.scm
@@ -2,18 +2,68 @@
   #: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 exceptions)
   #:use-module (language python yield)
   #:use-module (language python string)
-  #:export (error name ctermid environ))
+  #: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
+
+                  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
+                  ))
 
 (define error 'OSError)
-(define name  "posix")
-(define ctermid
-  (@ (guile) ctermid))
+
+(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)
+        (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 name  "posix")
+(guile ctermid)
 
-(define environ
+(define-values (environ environb)
   (let ()
     (define e (dereference-pointer (dynamic-pointer "environ" (dynamic-link))))
     (define (get-envs)
@@ -40,7 +90,8 @@
 
       (define __getitem__
         (lambda (self k)
-          (getenv (slot-ref (pystring k) 'str))))
+          (let ((r ((@ (guile) getenv) (slot-ref (pystring k) 'str))))
+            (if r r (raise IndexError)))))
 
       (define __setitem__
         (lambda (self k v) 
@@ -56,8 +107,653 @@
              (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 (concat a ... stx)
+  (datum->syntax
+   stx
+   (symbol->string
+    (string-append
+     a ...
+     (symbol->string
+      (syntax->datum stx))))))
+
+(define-syntax statset
+  (lambda (x)
+    (syntax-case x ()
+      ((_ (m ...) self scm)
+       (begin
+         (statset m self scm) ...))
+      ((_ m self scm)
+       (with-syntax ((mem  (concat "st_" #'m))
+                     (smem (concat "stat;" #'m)))
+         #'(set self 'mem (smem scm)))))))
+
+(define-python-class stat_result ()
+  (define __init__
+     (lambda (self scm)
+       (ca
+        (statset (mode ino dev nlink uid gid size atime mtime ctime)
+                 self scm)))))
+(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)
+                (bytevector-s32-ref a 1))))))
+
+
+(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"))
     
-    (Env)))
 
-(for ((k v : environ)) () (pk k))
+(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)
+                   (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 "fstatat" (dynamic-link))
+                               '(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 (get-path 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 dir_fd
+                         (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)))
+
+
+
+               
+
+