diff options
Diffstat (limited to 'modules/language/python/module/os.scm')
| -rw-r--r-- | modules/language/python/module/os.scm | 211 |
1 files changed, 211 insertions, 0 deletions
diff --git a/modules/language/python/module/os.scm b/modules/language/python/module/os.scm index ad4d2e3..1dbe30e 100644 --- a/modules/language/python/module/os.scm +++ b/modules/language/python/module/os.scm @@ -1082,3 +1082,214 @@ (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 '())) + + |