From bd77106e353a6c6c910b6f58b04ad95a98bd50d3 Mon Sep 17 00:00:00 2001 From: Stefan Israelsson Tampe Date: Sun, 1 Apr 2018 16:38:40 +0200 Subject: os debugged --- modules/language/python/module/os.scm | 177 +++++++++++++++++++--------------- 1 file changed, 100 insertions(+), 77 deletions(-) (limited to 'modules/language/python/module/os.scm') diff --git a/modules/language/python/module/os.scm b/modules/language/python/module/os.scm index 8791626..863287d 100644 --- a/modules/language/python/module/os.scm +++ b/modules/language/python/module/os.scm @@ -36,8 +36,8 @@ umask uname unsetenv path curdir pardir sep extsep altsep pathsep linesep defpath - devnull - + 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 @@ -54,6 +54,23 @@ set_blocking readv write writev set_inheritable get_inheritable + F_OK W_OK R_OK X_O AT_EACCESS AT_SYMLINK_NOFOLLOW + + lchown lchmod lchflags getcwdb fchdir chroot chown chmod + chflags chdir access listdir link + + stat lstat mkdir mkdirs mkfifo mknod major + + minor makedev pathconf_names pathconf readlink remove + unlink rmdir removedirs rename replace renames scandir + stat_float_times + + ST_RDONLY ST_NOSUID ST_NODEV ST_NOEXEC ST_SYNCHRONOUS + ST_MANDLOCK ST_WRITE ST_APPEND ST_IMMUTABLE ST_NOATIME + ST_NODIRATIME ST_RELATIME + + statvfs symlink truncate utime walk fwalk + getxattr listxattr removexattr setxattr XATTR_SIZE_MAX XATTR_CREATE XATTR_REPLACE @@ -473,12 +490,13 @@ 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))))))))) + (set self 'st_atime (* (ref self 'st_atime) 1.0)) + (set self 'st_mtime (* (ref self 'st_mtime) 1.0)) + (set self 'st_ctime (* (ref self 'st_ctime) 1.0)) + (set self 'st_atime_ns (/ (ref self 'st_atime_ns) 1000000000.0)) + (set self 'st_mtime_ns (/ (ref self 'st_mtime_ns) 1000000000.0)) + (set self 'st_ctime_ns + (/ (ref self 'st_ctime_ns) 1000000000.0))))))))) (name-object stat_result) @@ -527,7 +545,7 @@ (dynamic-func "openat" (dynamic-link)) (list int '* int int)))) - (lambda* (path flags mode #:optional (dir_fd None)) + (lam (path flags (= mode #o777) (= dir_fd None)) (if (eq? dir_fd None) (ca (open-fdes path flags mode)) (rm (f dir_fd (string->pointer path) flags mode)))))) @@ -756,7 +774,6 @@ (define chflags (lambda x (error "Not implemented"))) -(define chmod (lambda x #f)) (defineu chmod (0 2) (let ((f (pointer->procedure int (dynamic-func "chmod" (dynamic-link)) @@ -788,7 +805,7 @@ (it) path)) -(define chown (lambda x #f)) + (defineu chown (0 2) (let ((f (pointer->procedure int (dynamic-func "chown" (dynamic-link)) @@ -858,7 +875,7 @@ (define listdir (lambda* (#:optional (pth ".")) (let ((pth (if (number? pth) - ((@ (guile) read-link) (format #f "/proc/self/fd/~a" pth)) + ((@ (guile) readlink) (format #f "/proc/self/fd/~a" pth)) (path-it pth)))) (let ((o (ca (opendir pth)))) (dynamic-wind @@ -873,7 +890,6 @@ (cons w (lp o))))))) (lambda x (closedir o))))))) -(define stat (lambda x #f)) (defineu stat (0 2) (let ((f (pointer->procedure int (dynamic-func "__fxstatat" (dynamic-link)) @@ -881,17 +897,19 @@ (g (pointer->procedure '* (dynamic-func "scm_stat2scm_" (dynamic-link)) '(*)))) - (lambda* (path #:key (dir_fd None) (follow_symlinks #t)) + (lam (path (= dir_fd None) (= follow_symlinks #t)) (if (number? path) - (stat_result ((@ (guile) stat) path)) + (ca (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))) + (ca + (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 + dir_fd (string->pointer path) bvp (if follow_symlinks @@ -903,7 +921,6 @@ (lambda* (path #:key (dir_fd None)) (stat path #:dir_fd dir_fd #:follow_symlinks #f))) -(define mkdir #f) (defineu mkdir (0) (let ((fat (pointer->procedure int (dynamic-func "mkdirat" (dynamic-link)) @@ -936,7 +953,7 @@ (mkdir s mode))) (lp s l)))))) -(define mkfifo #f) + (defineu mkfifo (0) (let ((fat (pointer->procedure int (dynamic-func "mkfifoat" (dynamic-link)) @@ -946,7 +963,6 @@ (string->pointer (path-it path)) mode))))) -(define mknod #f) (defineu mknod (0) (let ((fat (pointer->procedure int (dynamic-func "__xmknodat" (dynamic-link)) @@ -957,7 +973,6 @@ mode device))))) -(define major #f) (defineu major () (let ((f (pointer->procedure int (dynamic-func "gnu_dev_major" (dynamic-link)) @@ -965,7 +980,6 @@ (lambda (device) (ca (f device))))) -(define minor #f) (defineu minor () (let ((f (pointer->procedure int (dynamic-func "gnu_dev_minor" (dynamic-link)) @@ -973,7 +987,6 @@ (lambda (device) (ca (f device))))) -(define makedev #f) (defineu makedev () (let ((f (pointer->procedure int64 (dynamic-func "gnu_dev_makedev" (dynamic-link)) @@ -981,6 +994,7 @@ (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) @@ -1002,8 +1016,6 @@ (error "Bug could not find pathcond name endex") (rm e2)))))) - -(define pathconf #f) (defineu pathconf (2) (let ((f (pointer->procedure long (dynamic-func "pathconf" (dynamic-link)) @@ -1018,7 +1030,6 @@ (let ((path (path-it path))) (rmp (f (string->pointer path) ni)))))))) -(define readlink #f) (defineu readlink (0) (let ((fat (pointer->procedure int (dynamic-func "readlinkat" (dynamic-link)) @@ -1034,7 +1045,6 @@ (bytevector-u8-set! bv (- n 1) 0) (pointer->string bvp))))) -(define remove #f) (defineu remove (0) (let ((fat (pointer->procedure int (dynamic-func "unlinkat" (dynamic-link)) @@ -1052,7 +1062,7 @@ (if (eq? dir_fd None) ((@ (guile) rmdir) path) (let* ((fd (open path O_DIRECTORY #:dir_fd dir_fd)) - (path ((@ (guile) read-link) ' + (path ((@ (guile) readlink) ' (format #f "/proc/self/fd/~a" fd)))) (close fd) ((@ (guile) rmdir) path)))))) @@ -1067,7 +1077,6 @@ (lambda x (values))) (lp (cdr l))))))) -(define rename #f) (defineu rename (0) (let ((fat (pointer->procedure int (dynamic-func "renameat" (dynamic-link)) @@ -1106,59 +1115,75 @@ (removedirs (string-join (reverse (cdr (reverse l))) "/"))))) (values))) - +(define statu stat) (define-python-class DirEntry () (define __init__ - (lambda (self path stat errno) + (lambda (self path stat) (set self 'name (basename path)) (set self 'path path) - (set self '__errno errno) (set self '__stat stat))) + + (define __repr__ + (lambda (self) + (format #f "DirEntry(~a)" (basename (ref self 'path))))) (define inode (lambda (self) (let ((stat (ref self '__stat))) (if stat (stat:ino stat) - (raise error (ref self '__errno)))))) + (raise error "Bug no stat"))))) (define is_dir (lambda* (self #:key (follow_symlinks #t)) - (let ((s (stat (ref self 'path) #:follow_symlinks follow_symlinks))) - ((@ (stat) is-dir?) (ref s '_st_mode))))) + (let ((s (statu (ref self 'path) + #:follow_symlinks follow_symlinks))) + (S_ISDIR (ref s 'st_mode))))) (define is_file (lambda* (self #:key (follow_symlinks #t)) - (let ((s (stat (ref self 'path) #:follow_symlinks follow_symlinks))) - ((@ (stat) is-reg?) (ref s '_st_mode))))) + (let ((s (statu (ref self 'path) #:follow_symlinks follow_symlinks))) + (S_ISREG (ref s 'st_mode))))) (define is_symlink (lambda (self) - (let ((s (stat (ref self 'path)))) - ((@ (stat) is-lnk?) (ref s '_st_mode))))) + (let ((s (statu (ref self 'path)))) + (S_ISLNK (ref s 'st_mode))))) (define stat (lambda* (self #:key (follow_symlinks #t)) (stat (ref self 'path) #:follow_symlinks follow_symlinks)))) +(define (one yield) + (let ((first? #t)) + (lambda (name stat . x) + (if first? + (begin + (set! first? #f) + #t) + (begin + (yield (DirEntry name stat)) + #f))))) + (define* (scandir #:optional (path ".")) - (make-generator () + ((make-generator () (lambda (yield) (file-system-fold - (lambda x #t) - (lambda (path stat errno r) - (yield (DirEntry path stat errno))) + (one yield) + (lambda (path stat res) + (yield (DirEntry path stat)) + res) (lambda (path stat res) - (yield (DirEntry path stat 0))) + res) (lambda (path stat res) - (values)) + res) (lambda (path stat res) - (values)) + res) (lambda (path stat errno res) - (values)) + res) #f - (path-it path))))) + (path-it path)))))) (define (stat_float_times newvalue) (set! stat-float-times newvalue)) @@ -1194,7 +1219,6 @@ f_namemax) (list a1 a2 a3 a4 a5 a6 a7 a8 a9 a10))))) -(define statvfs #f) (defineu statvfs (2) (let ((f (pointer->procedure int (dynamic-func "statvfs" (dynamic-link)) @@ -1221,7 +1245,7 @@ (bytevector-u64-ref bv (* 9 8) (native-endianness)) (bytevector-u64-ref bv (* 10 8) (native-endianness))))))) -(define symlink #f) + (defineu symlink (0) (let ((fat (pointer->procedure int (dynamic-func "symlinkat" (dynamic-link)) @@ -1232,7 +1256,6 @@ (if (eq? dir_fd None) AT_FDCWD dir_fd) (string->pointer (path-it src)))))))) -(define truncate #f) (defineu truncate (2) (let ((ff (pointer->procedure int (dynamic-func "ftruncate" (dynamic-link)) @@ -1320,7 +1343,7 @@ (for ((entry : entries)) () (define is_dir (try - (lambda () (ref entry 'is_dir)) + (lambda () ((ref entry 'is_dir))) (#:except error => (lambda x #f)))) (if is_dir (pylist-append! dirs (ref entry 'name)) @@ -1337,21 +1360,22 @@ (if walk-into (for ((a b c : (walk (ref entry 'path) topdown onerror followlinks))) () - (yield a b c))))) + (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)))))))) + (if topdown + (begin + (yield top dirs nondirs) + + (for ((dirname : dirs)) () + (let ((new_path (path:join top dirname))) + (if (or followlinks (not (path:islink new_path))) + (for ((a b c : (walk new_path topdown onerror + followlinks))) () + (yield a b c)))))) + (yield top dirs nondirs))))))) + +(define (path:islink p) + (ca (S_ISLNK (stat:mode ((@ (guile) stat) (path-it p)))))) (define (path:samestat s1 s2) (and (equal? (ref s1 'st_dev) (ref s2 'st_dev)) @@ -1386,11 +1410,11 @@ (define (_fwalk topfd toppath topdown onerror follow_symlinks) ((make-generator () - (lambda (yield) + (lambda (yield) (define names (listdir topfd)) (define dirs (py-list)) (define nondirs (py-list)) - + (for ((name : names)) () (try (lambda () @@ -1416,10 +1440,10 @@ (try (lambda () (values (stat name #:dir_fd topfd - #:follow_symlinks follow_symlinks)) - (open name O_RDONLY #:dir_fd topfd)) + #:follow_symlinks follow_symlinks) + (open name O_RDONLY #:dir_fd topfd))) (#:except error => - (lambda (err . l) + (lambda (err . l) (if (not (eq? onerror None)) (onerror err) (continue)))))) @@ -1434,9 +1458,9 @@ (yield a b c d))))) #:finally - (close dirfd))))) + (lambda () (close dirfd)))))) - (if not topdown + (if (not topdown) (yield toppath dirs nondirs topfd)))))) (def (fwalk (= top ".") (= topdown #t) (= onerror #t) @@ -1451,11 +1475,10 @@ (if (or follow_symlinks (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))) - () + (_fwalk topfd top topdown onerror follow_symlinks))) () (yield a b c d)))) #:finally - (close topfd)))))) + (lambda () (close topfd))))))) ;; Extended attributes (define getxattr #f) -- cgit v1.2.3