#lang racket/base (require (for-syntax "generate-ffi.rkt") (prefix-in ffi: "ext.rkt") (prefix-in s: "lookup.rkt") ffi/unsafe) (define (stat i . flags) (let ((flags (apply vector flags))) (cond ((string? i) (ffi:stat (string->path i) flags)) ((path? i) (ffi:stat i flags)) ((port? i) (ffi:stat i flags)) (else (error "Don't know how to stat" i))))) (define (type-bits i) (arithmetic-shift (bitwise-and (stat i s:mode) 261632) (- 9))) (define (normal-file? bits) (= #o100 bits)) (define (directory? bits) (= #o40 (bitwise-and #o740 bits))) (define (link? bits) (= 80 bits)) (define (fold-files proc init (very-top (build-path #f))) (let do-directory ((top very-top) (result init)) (let ((contents (map (λ (i) (build-path top i)) (directory-list top)))) (let do-list ((contents contents) (result result) (dirs null)) (if (null? contents) (foldl (λ (dir result) (do-directory dir result)) result dirs) (let* ((item (car contents)) (bits (type-bits item)) (result (proc item (cond ((normal-file? bits) 'file) ((directory? bits) 'directory) ((link? bits) 'link) (else 'other)) result))) (do-list (cdr contents) result (if (directory? bits) (cons item dirs) dirs)))))))) (define (main) (display (current-directory)) (newline) (for-each (λ (n) (with-handlers ((exn:fail? (λ (e) (display (exn-message e))(newline)))) (display n) (newline) (display (number->string (stat n s:mode) 8)) (newline) (let ((bits (type-bits n))) (display (number->string bits 8)) (newline) (display (list 'directory (directory? bits))) (newline) (display (list 'normal (normal-file? bits))) (newline)))) '("main.rkt" "feep.rkt" "/tmp" "/usr" "/home/synx" "/home/synx/.mailsplit/socket" "/dev/null" "/bin/bash" "faoeuuou"))) (provide main stat fold-files normal-file? directory? link? type-bits)