stat module finished and walkings
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>
Sun, 11 Mar 2018 21:02:10 +0000 (22:02 +0100)
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>
Sun, 11 Mar 2018 21:02:10 +0000 (22:02 +0100)
modules/language/python/module/os.scm
modules/language/python/module/stat.scm

index ad4d2e3eb5aef9b6584d0cb8d5a17a65ae22e619..1dbe30e767be3f7daebe96b54bed97b1071deff9 100644 (file)
          (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 (_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)))))))
+
+      
+(define supprts_dir_fs
+  (set '()))
+
+(define support_effective_ids
+  (set '()))
+
+(define supports_fd
+  (set '()))
+
+
index cb314b7feb7b894abba06f4f5f5ad2d42565d7ce..a430562608844ee16868a104e682d5712109623f 100644 (file)
@@ -1,10 +1,29 @@
 (define-module (language python module stat)
-  #:export ())
+  #:export (ST_MODE ST_INO ST_DEV ST_NLINK ST_UID ST_GID ST_SIZE ST_ATIME
+                    ST_MTIME ST_CTIME S_ISUID S_ISGID S_ENFMT S_ISVTX S_IREAD
+                    S_IWRITE S_IEXEC S_IRWXU S_IRUSR S_IWUSR S_IXUSR S_IRGRP
+                    S_IWGRP S_IXGRP S_IRWXG S_IROTH S_IWOTH S_IXOTH S_IRWXO
+                    S_IFDIR S_IFREG S_IFLNK S_IFCHR S_IFBLK S_IFIFO S_IFSOC
+                    UF_NODUMP UF_IMMUTABLE UF_APPEND UF_OPAQUE UF_NOUNLINK
+                    UF_COMPRESSED UF_HIDDEN SF_ARCHIVED SF_IMMUTABLE SF_APPEND
+                    SF_NOUNLINK SF_SNAPSHOT S_ISDIR S_ISREG S_ISLNK S_ISCHR
+                    S_ISBLK S_ISFIFO S_ISSOCK S_IMODE S_IFMT
+                    filemode))
 
+(define ST_MODE  0)
+(define ST_INO   1)
+(define ST_DEV   2)
+(define ST_NLINK 3)
+(define ST_UID   4)
+(define ST_GID   5)
+(define ST_SIZE  6)
+(define ST_ATIME 7)
+(define ST_MTIME 8)
+(define ST_CTIME 9)
 
 (define S_ISUID  #o04000)
 (define S_ISGID  #o02000)
-(define S_ENFMT  "error")
+(define S_ENFMT  S_ISGID)
 (define S_ISVTX  #o01000)
 (define S_IREAD  #o00400)
 (define S_IWRITE #o00200)
 (define S_IXOTH  #o00001)
 (define S_IRWXO  (logior S_IXOTH S_IWOTH S_IROTH))
 
+;;Internal
+(define SS_IFMT   #o170000)
+
+
 (define S_IFDIR   #o040000)
-(define S_IFMT    #o170000)
 (define S_IFREG   #o100000)
 (define S_IFLNK   #o120000)
 (define S_IFCHR   #o020000)
 (define S_IFBLK   #o060000)
 (define S_IFIFO   #o010000)
-    
-(define (is-dir? x) (= (logand x S_IFMT) S_IFDIR))
-(define (is-reg? x) (= (logand x S_IFMT) S_IFREG))
-(define (is-lnk? x) (= (logand x S_IFMT) S_IFLNK))
-(define (is-chr? x) (= (logand x S_IFMT) S_IFCHR))
-(define (is-blk? x) (= (logand x S_IFMT) S_IFBLK))
-(define (is-fif? x) (= (logand x S_IFMT) S_IFIFO))
+(define S_IFSOCK  #o140000)
+
+(define (S_ISDIR  x) (= (logand x SS_IFMT) S_IFDIR))
+(define (S_ISREG  x) (= (logand x SS_IFMT) S_IFREG))
+(define (S_ISLNK  x) (= (logand x SS_IFMT) S_IFLNK))
+(define (S_ISCHR  x) (= (logand x SS_IFMT) S_IFCHR))
+(define (S_ISBLK  x) (= (logand x SS_IFMT) S_IFBLK))
+(define (S_ISFIFO x) (= (logand x SS_IFMT) S_IFIFO))
+(define (S_ISSOCK x) (= (logand x SS_IFMT) S_IFSOCK))
+(define (S_IMODE  x) (logand x #o7777))
+(define (S_IFMT   x) (logand x SS_IFMT))
+
+(define UF_NODUMP      #x00000001)
+(define UF_IMMUTABLE   #x00000002)
+(define UF_APPEND      #x00000004)
+(define UF_OPAQUE      #x00000008)
+(define UF_NOUNLINK    #x00000010)
+(define UF_COMPRESSED  #x00000020)
+(define UF_HIDDEN      #x00008000)
+(define SF_ARCHIVED    #x00010000)
+(define SF_IMMUTABLE   #x00020000)
+(define SF_APPEND      #x00040000)
+(define SF_NOUNLINK    #x00100000)
+(define SF_SNAPSHOT    #x00200000)
+
+(define _filemode_table
+  `(((,S_IFLNK         "l")
+     (,S_IFREG         "-")
+     (,S_IFBLK         "b")
+     (,S_IFDIR         "d")
+     (,S_IFCHR         "c")
+     (,S_IFIFO         "p"))
+
+    ((,S_IRUSR         "r"))
+    ((,S_IWUSR         "w"))
+    ((,(logior S_IXUSR S_ISUID) "s")
+     (,S_ISUID         "S")
+     (,S_IXUSR         "x"))
+
+    ((,S_IRGRP         "r"))
+    ((,S_IWGRP         "w"))
+    ((,(logior S_IXGRP S_ISGID) "s")
+     (,S_ISGID         "S")
+     (,S_IXGRP         "x"))
+
+    ((,S_IROTH         "r"),)
+    ((,S_IWOTH         "w"),)
+    ((,(logior S_IXOTH S_ISVTX) "t")
+     (,S_ISVTX         "T")
+     (,S_IXOTH         "x"))))
+
+(define (filemode mode)
+  """Convert a file's mode to a string of the form '-rwxrwxrwx'."""
+  (define perm (py-list))
+  
+  (for ((table : _filemode_table)) ()
+       (for ((bit char : table)) ()
+            (if (= (logand mode  bit) bit)
+                (pylist-append! perm char)
+                (break))
+            #:final
+            (pylist-append! perm "-")))
+
+  (py-string-join "" perm))