f12f1c511a025b623007f9d2126b4b0107dd3557
[software/python-on-guile.git] / modules / language / python / module / os.scm
1 (define-module (language python module os)
2 #:use-module (system foreign)
3 #:use-module (oop pf-objects)
4 #:use-module (oop goops)
5 #:use-module (rnrs bytevectors)
6 #:use-module (language python for)
7 #:use-module ((language python module python) #:select (open))
8 #:use-module (language python try)
9 #:use-module (language python exceptions)
10 #:use-module (language python yield)
11 #:use-module (language python string)
12 #:use-module (language python bytes)
13 #:use-module (language python list)
14 #:export (error name ctermid environ environb chdir fchdir getcwd
15 fsencode fdencode fspath PathLike getenv getenvb
16 get_exec_path getgid getegid geteuid
17 getgroups getgrouplist getlogin getpgid getpgrp getpid
18 getppid PRIO_PROCESS PRIO_PRGRP PRIO_USER getpriority
19 getresgid getuid initgroups putenv setegid seteuid
20 setgid setgroups setpgrp setpgid setpriority setregid
21 setresgid setreuid setresuid getsid setsid setuid strerr
22 umask uname unsetenv
23
24 dopen close closerange device_encoding dup dup2 fchmod fchown
25 fdatasync fpathconf fstat fstatvfs fsynch ftruncate isatty
26 F_LOCK F_TLOCK F_ULOCK F_TEST lockf
27 SEEK_SET SEEK_CUR SEEK_END SEEK_DATA SEEK_HOLE lseek
28 open O_RDONLY O_WRONLY O_RDWR O_APPEND O_CREAT O_EXCL
29 O_TRUNC O_SYNC O_NDELAY O_NONBLOCK O_NOCTTY O_LARGEFILE
30 O_NOTRANS O_DSYNC O_RSYNC O_CLOEXEC O_PATH O_DIRECTORY
31 O_NOFOLLOW O_DIRECT O_NOATIME O_ASYNC O_TMPFILE
32 openpty pipe pipe2 posix_fallocate
33 posix_fadvise POSIX_FADV_NORMAL POSIX_FADV_RANDOM
34 POSIX_FADV_SEQUENTIAL POSIX_FADV_WILLNEED
35 POSIX_FADV_DONTNEED POSIX_FADV_NOREUSE
36 pread pwrite read sendfile set_blocking get_blocking
37 set_blocking readv write writev set_inheritable
38 get_inheritable
39 ))
40
41 (define error 'OSError)
42
43 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
44 (define-syntax-rule (ca code)
45 (catch #t
46 (lambda () code)
47 (lambda x (raise error x))))
48 (define-syntax-rule (rm code)
49 (let ((r (ca code)))
50 (if (< r 0)
51 (raise error)
52 (values))))
53
54 (define-syntax guile
55 (syntax-rules ()
56 ((_ (x ...) code) (guile (x ...) code code))
57 ((_ (x ...) code1 code2)
58 (define code1 (lambda (x ...) (ca ((@ (guile) code2 x ...))))))
59 ((_ code) (guile code code))
60 ((_ code1 code2)
61 (define code1 (lambda x (ca (apply (@ (guile) code2 x))))))))
62
63 (define name "posix")
64 (guile ctermid)
65
66 (define-values (environ environb)
67 (let ()
68 (define e (dereference-pointer (dynamic-pointer "environ" (dynamic-link))))
69 (define (get-envs)
70 (let lp ((e e))
71 (let ((*e (dereference-pointer e)))
72 (if (null-pointer? *e)
73 '()
74 (cons
75 (pointer->string *e)
76 (lp (make-pointer (+ (pointer-address e) 8))))))))
77
78 (define (getkw)
79 (let lp ((es (get-envs)))
80 (if (pair? es)
81 (let ((x (string-split (car es) #\=)))
82 (let ((k (car x))
83 (v (string-join (cdr x) "=")))
84 (cons (cons k v) (lp (cdr es)))))
85 '())))
86
87 (define-python-class Env ()
88 (define __init__
89 (lambda (self) (values)))
90
91 (define __getitem__
92 (lambda (self k)
93 (let ((r ((@ (guile) getenv) (slot-ref (pystring k) 'str))))
94 (if r r (raise IndexError)))))
95
96 (define __setitem__
97 (lambda (self k v)
98 (putenv (slot-ref (pystring (+ k "=" v)) 'str))))
99
100 (define __delitem__
101 (lambda (self k)
102 (putenv (slot-ref (pystring k) 'str))))
103
104 (define __iter__
105 (lambda (self)
106 ((make-generator ()
107 (lambda (yield)
108 (for ((x : (getkw))) ()
109 (yield (car x) (cdr x)))))))))
110
111 (define-python-class Envb ()
112 (define __init__
113 (lambda (self) (values)))
114
115 (define __getitem__
116 (lambda (self k)
117 (let ((r (bytes ((@ (guile) getenv) (slot-ref (string k) 'str)))))
118 (if r r (raise IndexError)))))
119
120 (define __setitem__
121 (lambda (self k v)
122 (putenv (slot-ref (string (+ k "=" v)) 'str))))
123
124 (define __delitem__
125 (lambda (self k)
126 (putenv (slot-ref (string k) 'str))))
127
128 (define __iter__
129 (lambda (self)
130 ((make-generator ()
131 (lambda (yield)
132 (for ((x : (getkw))) ()
133 (yield (car x) (cdr x)))))))))
134
135
136 (values (Env) (Envb))))
137
138
139 (guile (path) chdir)
140
141 (define (fchdir fd)
142 (error "not implemented"))
143
144 (guile () getcwd)
145
146 (define (fsencode fn)
147 (error "not implemented"))
148 (define (fsdecode fn)
149 (error "not implemented"))
150
151 (define-method (fspath (pth <string> )) pth)
152 (define-method (fspath (pth <py-string> )) pth)
153 (define-method (fspath (pth <py-bytes> )) pth)
154 (define-method (fspath (pth <py-bytearray>)) pth)
155 (define-method (fspath (pth <p> ))
156 (aif it (ref pth '__fspath__)
157 (it)
158 (next-method)))
159
160 (define-python-class PathLike ()
161 (define __fspath__
162 (lambda (self) (error "not implemented"))))
163
164
165 (define* (getenv key #:key (default None))
166 (try
167 (lambda ()
168 (pylist-ref environ key))
169 (#:except IndexError => (lambda x default))))
170
171 (define* (getenvb key #:key (default None))
172 (try
173 (lambda ()
174 (pylist-ref environb key))
175 (#:except IndexError => (lambda x default))))
176
177 (define* (get_exec_path #:key (env #f))
178 (define (f s)
179 (let ((s (slot-ref (string s) 'str)))
180 (string-split str ":")))
181 (if env
182 (f (pylist-ref env "PATH"))
183 (f (pylist-ref environ "PATH"))))
184
185 (guile () getgid)
186 (guile () getegid)
187 (guile () geteuid)
188
189 (define (getgrouplist user group)
190 (error "not impllemeneted"))
191
192 (guile () getgroups)
193
194 (guile getlogin)
195
196 (define getpgid
197 (let ((f (pointer->procedure int
198 (dynamic-func "getpgid" (dynamic-link))
199 (list int))))
200 (lambda (pid)
201 (rm (f pid)))))
202
203
204 (guile getpgrp)
205 (guile getpid)
206 (guile getppid)
207
208 (define PRIO_PROCESS (@ (guile) PRIO_PROCESS))
209 (define PRIO_PRGRP (@ (guile) PRIO_PRGRP))
210 (define PRIO_USER (@ (guile) PRIO_USER))
211
212 (guile getpriority)
213
214 (define getresgid
215 (let* ((f (pointer->procedure
216 void
217 (dynamic-func "getresgid" (dynamic-link))
218 '(* * *))))
219
220 (lambda ()
221 (let* ((a (make-bytevector 8))
222 (ap (bytevector->pointer a))
223 (b (make-bytevector 8))
224 (bp (bytevector->pointer b))
225 (c (make-bytevector 8))
226 (cp (bytevector->pointer c)))
227 (rm (f ap bp cp))
228 (list
229 (bytevector-u16-ref a 0 (native-endianness))
230 (bytevector-u16-ref b 0 (native-endianness))
231 (bytevector-u16-ref c 0 (native-endianness)))))))
232
233 (guile getuid)
234
235 (define initgroup
236 (let ((f (pointer->procedure
237 'int
238 (dynamic-func "initgroups" (dynamic-link))
239 '(* int))))
240
241 (lambda (user group)
242 (rm (string->pointer user) group))))
243
244 (define (putenv key value)
245 (pylist-set! environ key value))
246
247 (guile setegid)
248 (guile seteuid)
249 (guile setgid)
250
251 (guile setgroups)
252 (define setpgrp
253 (let ((f (pointer->procedure 'int
254 (dynamic-func "setpgrp" (dynamic-link))
255 '())))
256 (lambda ()
257 (rm (f)))))
258
259 (guile setpgid)
260 (guile setpriority)
261
262 (define setregid
263 (let ((f (pointer->procedure 'int
264 (dynamic-func "setregid" (dynamic-link))
265 '(int int))))
266 (lambda (a b)
267 (rm (f a b)))))
268
269 (define setresgid
270 (let ((f (pointer->procedure 'int
271 (dynamic-func "setresgid" (dynamic-link))
272 '(int int int))))
273 (lambda (a b c)
274 (rm (f a b c)))))
275
276 (define setreuid
277 (let ((f (pointer->procedure 'int
278 (dynamic-func "setreuid" (dynamic-link))
279 '(int int))))
280 (lambda (a b)
281 (rm (f a b)))))
282
283 (define setresuid
284 (let ((f (pointer->procedure 'int
285 (dynamic-func "setresuid" (dynamic-link))
286 '(int int int))))
287 (lambda (a b c)
288 (rm (f a b c)))))
289
290 (guile getsid)
291 (guile setsid)
292 (guile setuid)
293 (guile strerror)
294 (guile umask)
295 (guile uname)
296 (guile unsetenv)
297
298 ;; File descriptor operations
299 (define fdopen open)
300
301 (define close
302 (lambda (fd)
303 (ca (close-fd fd))))
304
305 (define (closerange fd_low fd_high)
306 (for ((i : (range low high))) ()
307 (try:
308 (lambda () (close i))
309 (#:except OSError => (lambda (x) (values))))))
310
311 (define device_encoding (lambda (fd) (error "not implemented")))
312
313 (guile (fd) dup)
314
315 (define dup2
316 (let ((f (pointer->procedure 'int
317 (dynamic-func "dup3" (dynamic-link))
318 '(int int int))))
319 (lambda* (fd fd2 #:optional (inheritable? #t))
320 (if inheritable?
321 (rm (f fd fd2 O_CLOEXEC))
322 (ca ((@ (guile) dup2) fd fd2))))))
323
324 (guile (fd mode) fchmod)
325 (guile (fd uid gid) fchown)
326
327
328 (define (fdatasync fd) (error "not implemented"))
329 (define (fpathconf fd name) (error "not implemented"))
330
331 (define (concat a ... stx)
332 (datum->syntax
333 stx
334 (symbol->string
335 (string-append
336 a ...
337 (symbol->string
338 (syntax->datum stx))))))
339
340 (define-syntax statset
341 (lambda (x)
342 (syntax-case x ()
343 ((_ (m ...) self scm)
344 (begin
345 (statset m self scm) ...))
346 ((_ m self scm)
347 (with-syntax ((mem (concat "st_" #'m))
348 (smem (concat "stat;" #'m)))
349 #'(set self 'mem (smem scm)))))))
350
351 (define-python-class stat_result ()
352 (define __init__
353 (lambda (self scm)
354 (ca
355 (statset (mode ino dev nlink uid gid size atime mtime ctime)
356 self scm)))))
357 (name-object stat_result)
358
359 (define (fstat fd)
360 (stat_result (stat fd)))
361
362 (define (fstatvfs fd) (error "not implemented"))
363
364 (guile (fd) fsynch fsync)
365
366 (guil (fd len) ftruncate truncate-file)
367
368 (guile (fd) isatty isatty?)
369
370 (define F_LOCK 1)
371 (define F_TLOCK 2)
372 (define F_ULOCK 0)
373 (define F_TEST 3)
374 (define lockf
375 (let ((f (pointer->procedure 'int
376 (dynamic-func "lockf" (dynamic-link))
377 '(int int long))))
378 (lambda (fd op len)
379 (rm (f fd op len)))))
380
381
382
383 (define SEEK_SET #x0)
384 (define SEEK_CUR #x1)
385 (define SEEK_END #x2)
386 (define SEEK_DATA #x3)
387 (define SEEK_HOLE #x4)
388
389 (define lseek
390 (let ((f (pointer->procedure 'int
391 (dynamic-func "lseek" (dynamic-link))
392 '(int long int))))
393 (lambda (fd pos how)
394 (rm (f fd pos how)))))
395
396 (define open
397 (let ((f (pointer->procedure 'int
398 (dynamic-func "openat" (dynamic-link))
399 '(int * int int))))
400
401 (lambda* (path flags mode #:optional (dir_fd None))
402 (if (eq? dir_fd None)
403 (ca (open-fdes path flags mode))
404 (rm (f dir_fd (string->pointer path) flags mode))))))
405
406
407 (define-syntax-rule (mko O) (define O (@ (guile) O)))
408 (mko O_RDONLY)
409 (mko O_WRONLY)
410 (mko O_RDWR)
411 (mko O_APPEND)
412 (mko O_CREAT)
413 (mko O_EXCL)
414 (mko O_TRUNC)
415
416 ;;unix
417 (mko O_SYNC)
418 (mko O_NDELAY)
419 (mko O_NONBLOCK)
420 (mko O_NOCTTY)
421
422 ;;
423 (mko O_LARGEFILE)
424 (mko O_NOTRANS)
425
426 (define O_DSYNC #o10000)
427 (define O_RSYNC O_SYNC)
428 (define O_CLOEXEC #o2000000)
429 (define O_PATH #o10000000)
430 (define O_DIRECTORY #o200000)
431 (define O_NOFOLLOW #o400000)
432 (define O_DIRECT #o40000)
433 (define O_NOATIME #o1000000)
434 (define O_ASYNC #o20000)
435 (define O_TMPFILE (logior #o20000000 O_DIRECTORY))
436
437 (define openpty (lambda x (error "not implemented")))
438
439 (define pipe
440 (let ((x (ca (@ (guile) pipe))))
441 (values (car x) (cdr x))))
442
443 (define pipe2
444 (let ((f (pointer->procedure 'int
445 (dynamic-func "pipe2" (dynamic-link))
446 '(int * int))))
447 (lambda (flags)
448 (let* ((a (make-bytevector 16))
449 (ap (bytevector->pointer a)))
450 (rm (f ap flags))
451 (values (bytevector-s32-ref a 0)
452 (bytevector-s32-ref a 1))))))
453
454
455 (define posix_fallocate
456 (let ((f (pointer->procedure 'int
457 (dynamic-func "posix_fallocate" (dynamic-link))
458 '(int long long))))
459 (lambda (fd off len)
460 (rm (f fd off len)))))
461
462 (define posix_fadvise
463 (let ((f (pointer->procedure 'int
464 (dynamic-func "posix_fadvise" (dynamic-link))
465 '(int long long int))))
466 (lambda (fd off len advice)
467 (rm (f fd off len advice)))))
468
469 (define POSIX_FADV_NORMAL 0)
470 (define POSIX_FADV_RANDOM 1)
471 (define POSIX_FADV_SEQUENTIAL 2)
472 (define POSIX_FADV_WILLNEED 3)
473 (define POSIX_FADV_DONTNEED 4)
474 (define POSIX_FADV_NOREUSE 5)
475
476 (define pread
477 (let ((f (pointer->procedure 'int
478 (dynamic-func "pread" (dynamic-link))
479 '(int * long long))))
480 (lambda (fd size offset)
481 (let* ((a (make-bytevector size))
482 (ap (bytevector->pointer a)))
483 (let ((n (rm (f fd ap size offset))))
484 (if (= n 0)
485 (make-bytevector 0)
486 (let ((o (make <bytevector>)))
487 (slot-set! o 'n (size))
488 (slot-set! o 'size n)
489 (slot-set! o 'bv a)
490 o)))))))
491
492 (define pwrite
493 (let ((f (pointer->procedure 'int
494 (dynamic-func "pwrite" (dynamic-link))
495 '(int * long long))))
496
497 (lambda (fd a offset)
498 (let* ((ap (bytevector->pointer a)))
499 (rm (f fd ap size offset))))))
500
501 (define read
502 (let ((f (pointer->procedure 'int
503 (dynamic-func "read" (dynamic-link))
504 '(int * long))))
505 (lambda (fd size)
506 (let* ((a (make-bytevector size))
507 (ap (bytevector->pointer a)))
508 (let ((n (rm (f fd ap size))))
509 (if (= n 0)
510 (make-bytevector 0)
511 (let ((o (make <bytevector>)))
512 (slot-set! o 'n (size))
513 (slot-set! o 'size n)
514 (slot-set! o 'bv a)
515 o)))))))
516
517 (define (sendfile out in offset count)
518 (ca
519 (if (eq? count None)
520 ((@ (guile) sendfile out in count))
521 ((@ (guile) sendfile out in count offset)))))
522
523 (define F_GETFL 3)
524 (define fcntl2 (pointer->procedure 'int
525 (dynamic-func "fcntl" (dynamic-link))
526 '(int int)))
527 (define fcntl3 (pointer->procedure 'int
528 (dynamic-func "fcntl" (dynamic-link))
529 '(int int INT)))
530
531 (define (set_blocking fd is-blocking?)
532 (let ((o (rm (fcntl2 fd F_GETFL))))
533 (if is-blocking?
534 (rm (fcntl3 fd F_GETFL (logior o O_NONBLOCK)))
535 (rm (fcntl3 fd F_GETFL (logand o (lognot O_NONBLOCK)))))))
536
537 (define (get_blocking fd)
538 (if (= (logand O_NONBLOCK (rm (fcntl2 fd F_GETFL))) 0)
539 #f
540 #t))
541
542 (define (readv fd buffers) (error "not implemented"))
543
544 (guile (fd pg) tcsetpgrp)
545 (guile (fd) ttyname)
546
547 (define write
548 (let ((f (pointer->procedure 'int
549 (dynamic-func "write" (dynamic-link))
550 '(int * long))))
551
552 (lambda (fd a)
553 (let* ((ap (bytevector->pointer a)))
554 (rm (f fd ap size))))))
555
556 (define (writev fd buffers) (error "not implemented"))
557
558
559 (define (set_inheritable fd is-inh?)
560 (let ((o (rm (fcntl2 fd F_GETFL))))
561 (if is-inh?
562 (rm (fcntl3 fd F_GETFL (logior o O_CLOEXEC)))
563 (rm (fcntl3 fd F_GETFL (logand o (lognot O_CLOEXEC)))))))
564
565 (define (get_inheritable fd)
566 (if (= (logand O_CLOEXEC (rm (fcntl2 fd F_GETFL))) 0)
567 #f
568 #t))
569
570
571 ;; Files and dir
572 (define AT_EACCESS #x200)
573 (define AT_SYMLINK_NOFOLLOW #x100)
574
575 (define F_OK (@ (guile) F_OK))
576 (define W_OK (@ (guile) W_OK))
577 (define R_OK (@ (guile) R_OK))
578 (define X_OK (@ (guile) X_OK))
579
580 (define access
581 (let ((f (pointer->procedure 'int
582 (dynamic-func "access" (dynamic-link))
583 '(* int)))
584 (fa (pointer->procedure 'int
585 (dynamic-func "faccessat" (dynamic-link))
586 '(* int int int))))
587
588 (lambda* (path mode #:key
589 (dir_fd None)
590 (effective_ids #f)
591 (follow_symlinks #t))
592 (if (eq? dir_fd None)
593 (rm (f (string->pointer path) mode))
594 (rm (fa (string->pointer path) mode dir_fd
595 (logior (if effective_ids AT_EACCESS 0)
596 (if follow_symlinks 0 AT_SYMLINK_NOFOLLOW))))))))
597
598
599
600 (define chdir
601 (let ((f (pointer->procedure 'int
602 (dynamic-func "access" (dynamic-link))
603 '(*))))
604 (lambda (pth)
605 (let ((pth (aif it (ref pth '__fspath__)
606 (it)
607 pth)))
608 (if (int? pth)
609 (rm (f pth))
610 (ca ((@ (guile) chdir) pth)))))))
611
612
613 (define chflags
614 (lambda x (error "Not implemented")))
615
616 (define chmod
617 (let ((f (pointer->procedure 'int
618 (dynamic-func "chmod" (dynamic-link))
619 '(* int)))
620 (ff (pointer->procedure 'int
621 (dynamic-func "fchmod" (dynamic-link))
622 '(int int)))
623 (fat (pointer->procedure 'int
624 (dynamic-func "fchmodat" (dynamic-link))
625 '(* int int int))))
626 (lambda* (path mode #:key (dir_fd None) (follow_symlinks #t))
627 (if (int? path)
628 (rm (ff path mode))
629 (let ((path (aif it (ref path '__fspath__)
630 (it)
631 path)))
632 (if (eq? dir_fd None)
633 (rm (f (string->pointer path) mode))
634 (rm (fat (string->pointer path) mode
635 dir_fd
636 (if follow_symlinks
637 0
638 AT_SYMLINK_NOFOLLOW)))))))))
639
640
641
642 (define (path-it path)
643 (aif it (ref path '__fspath__)
644 (it)
645 path))
646
647 (define chown
648 (let ((f (pointer->procedure 'int
649 (dynamic-func "chown" (dynamic-link))
650 '(* int int)))
651 (ff (pointer->procedure 'int
652 (dynamic-func "fchown" (dynamic-link))
653 '(int int int)))
654 (lf (pointer->procedure 'int
655 (dynamic-func "lchow" (dynamic-link))
656 '(* int int)))
657 (fat (pointer->procedure 'int
658 (dynamic-func "fchownat" (dynamic-link))
659 '(* int int int int))))
660 (lambda* (path uid gid #:key (dir_fd None) (follow_symlinks #t))
661 (if (int? path)
662 (rm (ff path uid gid))
663 (let ((path (path-it path)))
664 (if (eq? dir_fd None)
665 (if follow_symlinks
666 (rm (f (string->pointer path) uid gid))
667 (rm (lf (string->pointer path) uid gid)))
668 (rm (fat (string->pointer path) uid gid dir_fd
669 (if follow_symlinks
670 0
671 AT_SYMLINK_NOFOLLOW)))))))))
672
673 (guile ((x)) chroot)
674
675 (define fchdir chdir)
676
677 (guile () getcwd)
678
679 (define (getcwdb)
680 (byte (getcwd)))
681
682 (define lchflags (lambda x (error "not implemented")))
683
684 (define (lchmod path mode)
685 (chmod path mode #:follow_symlinks #f))
686
687 (define (lchown path uid gid)
688 (chown path uid gid #:follow_symlinks #f))
689
690 (define link
691 (let ((f (pointer->procedure 'int
692 (dynamic-func "linkat" (dynamic-link))
693 '(* * int int int))))
694 (lambda* (src dst #:key
695 (src_dir_fd None)
696 (dst_dir_fd None),
697 (follow_symlinks #t))
698 (let ((src (path-it src))
699 (dst (path-it dst))
700 (src_dir_fd (if (eq? src_dir_fd None) AT_FDCWD src_dir_fd))
701 (dst_dir_fd (if (eq? dst_dir_fd None) AT_FDCWD dst_dir_fd)))
702 (rm (f (string->pointer src)
703 (string->pointer dst)
704 src_dir_fd
705 dst_dir_fd
706 (if follow_symlinks
707 0
708 AT_SYMLINK_NOFOLLOW)))))))
709
710 (define listdir
711 (lambda* (#:optional (pth "."))
712 (let ((pth (if (number? pth)
713 (read-link (format #f "/proc/self/fd/~a" pth))
714 (path-it pth))))
715 (let ((o (ca (opendir pth))))
716 (dynamic-wind
717 (lambda x #f)
718 (lambda ()
719 (let lp ((o ) (l '()))
720 (let ((w (ca (readdir o))))
721 (if (eof-object? w)
722 '()
723 (cons w (lp o))))))
724 (lambda x (closedir o)))))))
725
726 (define stat
727 (let ((f (pointer->procedure 'int
728 (dynamic-func "fstatat" (dynamic-link))
729 '(int * * int)))
730 (g (pointer->procedure '*
731 (dynamic-func "scm_stat2scm_" (dynamic-link))
732 '(*))))
733 (lambda* (path #:key (dir_fd None) (follow_symlinks #t))
734 (if (number? path)
735 (stat_result ((@ (guile) stat) path))
736 (let ((path (get-path path)))
737 (if (eq? dir_fd None)
738 (if follow_symlinks
739 (stat_result ((@ (guile) stat) path))
740 (stat_result ((@ (guile) lstat) path)))
741 (let ((bv (make-bytevector 80))
742 (bvp (bytevector->pointer bv)))
743 (rm (f dir_fd
744 (string->pointer path)
745 bvp
746 (if follow_symlinks
747 0
748 AT_SYMLINK_NOFOLLOW)))
749 (stat_result (ca (pointer->scm (g bvp)))))))))))
750
751 (define lstat
752 (lambda* (path #:key (dir_fd None))
753 (stat path #:dir_fd dir_fd #:follow_symlinks #f)))
754
755
756
757
758
759