;**************************************************************************** ; Directory Streams ; Scanning UNIX (POSIX) directories ; ; Procedure: ; OS:for-each-file-in-directory DIR-NAME PROC ; The procedure scans through all the files in the given directory, and calls ; the given procedure PROC for each file. The results from all executions ; of PROC are combined into a list, which is what OS:for-each-file-in-directory ; returns. ; The procedure 'PROC' is given a file-info "object" that describes the ; current file being scanned. If the procedure PROC returns ; - #f, the scanning of the directory is terminated ; - '(), the scanning continues, but nothing is appended to the ; list-result from OS:for-each-file-in-directory ; - everything else gets appended to the list ; ; One should not make any assumptions as to a particular order the directory ; entries are scanned (or the order the elements of the resulting list are ; arranged) ; ; The file-info object being given to the procedure 'PROC' is the result ; of ; procedure ; OS:make-file-info FILE-PATH ; The object accepts the following "messages" ; 'name - returns the file's name ; 'link-count - returns the link-count of the file ; 'directory? - #t if the file is a directory ; 'block-special? - #t if the file is a block-special file, like those ; in /dev/dsk ; 'char-special? - #t if the file is a char-special file, as /dev/tty ; 'regular-file? - #t if the file is a plain regular file ; 'pipe? - #t if the file is a communication (FIFO) pipe ; 'mtime - returns the modification time of the file, ; a BIGNUM, generally, number, the number of seconds ; since Jan 1, 1970 0:0:0 GMT (see man time(2)) ; 'atime - returns time of the last (read) access to the file ; 'ctime - returns the "creation" time of the file ; 'size - returns the file size ; 'uid - returns owner's uid ; 'gid - returns owner's gid (group id) ; 'perm - returns a predicate that takes two symbol arguments, ; who ('owner, 'group, or 'others) and operation ; ('read, 'write, or 'exec), and tells if the ; file can be accessed by _who_ with the _operation_ ; ; ; See the procedure TEST:fake-ls-l that uses OS:for-each-file-in-directory ; to fake the "ls -l ." UNIX command. ; ; All i/o errors cause ##SIGNAL.IO-ERROR to be thrown. ; ; Refer to readdir(3C) man page ; ; $Id: readdir.scm,v 2.7 1999/10/13 01:30:35 oleg Exp oleg $ (declare (block) (standard-bindings) (extended-bindings) ; needed for ##c-code to be recognized... ; (fixnum) ; mtime, etc. can be BIGNUM! ) (##include "myenv.scm") ; include target dependent stuff ;(##include "header.scm") ; from the gambc/lib/header.scm (c-declare "#include ") (c-declare "#include ") (c-declare "#include ") (c-declare "#include ") (c-declare "#include ") (c-declare "#include ") (c-declare "#include ") (c-declare "#include ") ; Make the file-info object (define (OS:make-file-info file-path) (let ; struct-stat is a SCM incarnation of "struct stat" ; it contains the "relevant" information from the ; real "struct stat", see man stat(2) and ; /usr/include/sys/stat.h ; u16vector[0] = file mode (the st_mode field) ; u16vector[1] = link count ; u16vector[2] and [3] - file size ; u16vector[4] and [5] - atime ; u16vector[6] and [7] - mtime ; u16vector[8] and [9] - ctime ; u16vector[10] = uid ; u16vector[11] = gid ((struct-stat (make-u16vector 12 0))) ; get an unsigned short from the struct-stat slot #n ; (define (get-ushort-stat-slot n) ; (##fixnum.logand #x00ffff (u16vector-ref struct-stat n))) ; get an unsigned long by combining struct-stat's ; slot #n and slot #n+1 (in the big-endian format) ; The result maybe a BIGNUM! (define (get-ulong-stat-slot n) ; (+ (* #x10000 (get-ushort-stat-slot 6)) (get-ushort-stat-slot 7)) (##c-code "{ ___U16* vp = (___U16*)___BODY_AS(___ARG1,___tSUBTYPED); ___WORD conversion_result = ___FAL; assert(___INT(___U16VECTORLENGTH(___ARG1)) > ___INT(___ARG2)); ___ulong_to_scmobj( (vp[___INT(___ARG2)] << 16) | vp[___INT(___ARG2)+1], &conversion_result, 0); ___RESULT = conversion_result;}" struct-stat n)) (or ; Get the file stat and fill out struct-stat ; return #f if i/o error occurred ((c-lambda (char-string scheme-object) scheme-object "struct stat file_stat; ___U16* vp; if( stat(___arg1,&file_stat) != 0 ) ___result = ___FAL; else { assert( ___INT(___U16VECTORLENGTH(___arg2)) ==12 ); vp = (___U16*)___BODY_AS(___arg2,___tSUBTYPED); *vp++ = file_stat.st_mode; *vp++ = file_stat.st_nlink; *vp++ = (unsigned)file_stat.st_size >> 16; *vp++ = file_stat.st_size; *vp++ = (unsigned)file_stat.st_atime >> 16; *vp++ = file_stat.st_atime; *vp++ = (unsigned)file_stat.st_mtime >> 16; *vp++ = file_stat.st_mtime; *vp++ = (unsigned)file_stat.st_ctime >> 16; *vp++ = file_stat.st_ctime; *vp++ = file_stat.st_uid; *vp++ = file_stat.st_gid; ___result = ___TRU; } /* ___VECTOR16SET(___arg2,___FIX(4),___FIX(file_stat.st_atime >> 16)); ___VECTOR16SET(___arg2,___FIX(5),___FIX(file_stat.st_atime)); ___VECTOR16SET(___arg2,___FIX(6),___FIX(file_stat.st_mtime >> 16)); ___VECTOR16SET(___arg2,___FIX(7),___FIX(file_stat.st_mtime)); ___VECTOR16SET(___arg2,___FIX(8),___FIX(file_stat.st_ctime >> 16)); ___VECTOR16SET(___arg2,___FIX(9),___FIX(file_stat.st_ctime)); ___VECTOR16SET(___arg2,___FIX(10),___FIX(file_stat.st_uid)); ___VECTOR16SET(___arg2,___FIX(11),___FIX(file_stat.st_gid));*/") file-path struct-stat) (##signal '##SIGNAL.IO-ERROR "IO error: " (OS:strerror) " while getting the file stat for " file-path)) (lambda (selector) (case selector ((name) file-path) ((link-count) (##u16vector-ref struct-stat 1)) ((directory?) (##fixnum.= #o0040000 (##fixnum.logand #o0170000 (##u16vector-ref struct-stat 0)))) ((block-special?) (##fixnum.= #o0060000 (##fixnum.logand #o0170000 (##u16vector-ref struct-stat 0)))) ((char-special?) (##fixnum.= #o0020000 (##fixnum.logand #o0170000 (##u16vector-ref struct-stat 0)))) ((regular-file?) (##fixnum.= #o0100000 (##fixnum.logand #o0170000 (##u16vector-ref struct-stat 0)))) ((pipe?) (##fixnum.= #o0010000 (##fixnum.logand #o0170000 (##u16vector-ref struct-stat 0)))) ((mtime) (get-ulong-stat-slot 6)) ((atime) (get-ulong-stat-slot 4)) ((ctime) (get-ulong-stat-slot 8)) ((size) (get-ulong-stat-slot 2)) ;(##fixnum.logior (##fixnum.lsh (##u16vector-ref struct-stat 2) 16) ; (##u16vector-ref struct-stat 3)) ((uid) (##u16vector-ref struct-stat 10)) ((gid) (##u16vector-ref struct-stat 11)) ((perm) (lambda (who operation) (let ((who-shift (assq who '((owner . 6) (group . 3) (others . 0)))) (op-bit (assq operation '((read . #o4) (write . #o2) (exec . #o1))) )) (if (not who-shift) (error "file-info:perm: wrong who (owner/group/others) selector " who)) (if (not op-bit) (error "file-info:perm: wrong read/write/exec selector " operation)) (not (##fixnum.zero? (##fixnum.logand (##fixnum.shl (cdr op-bit) (cdr who-shift)) (##u16vector-ref struct-stat 0))))))) (else (error "unknown selector " selector " in file-info")))))) (define (OS:for-each-file-in-directory dir-name file-taker) (letrec ( (orig-dir (OS:getcwd)) (unix-dir-stream ; That is, DIR * (or ((c-lambda (char-string) (pointer "DIR") "opendir") dir-name) (##signal '##SIGNAL.IO-ERROR "IO error: " (OS:strerror) " while preparing to scan directory " dir-name))) ; get the next dirent and extract file-name ; Return #f if the whole dir has been scanned (get-dirent (lambda () (or ((c-lambda ((pointer "DIR")) char-string "static char file_name_str[MAXNAMLEN+19]; #if !defined(_D_ALLOC_NAMLEN) #if defined(__svr4__) || defined(mips) #define _D_ALLOC_NAMLEN(DP) ((DP)->d_reclen) #else #define _D_ALLOC_NAMLEN(DP) ((DP)->d_namlen) #endif #endif const struct dirent * direntp; errno = 0; /* reset errno to detect if readdir sets it */ direntp = readdir(___arg1); if( direntp == 0 ) ___result = 0; /* meaning #f */ else ___result = strncpy(file_name_str,direntp->d_name,_D_ALLOC_NAMLEN(direntp)), file_name_str[_D_ALLOC_NAMLEN(direntp)] = '\\0';") unix-dir-stream) ; readdir returned NULL. Check if errno is ; zero. If it is, the end of directory ; has been reached. Otherwise, it's an error! (and (##c-code "___RESULT = errno==0 ? ___FAL : ___TRU;" ) (##signal '##SIGNAL.IO-ERROR "IO error: " (OS:strerror) " while scanning directory " dir-name))))) (finish (lambda (propagated-result) ((c-lambda ((pointer "DIR")) void "closedir") unix-dir-stream) (OS:chdir orig-dir) propagated-result )) ) ; Main directory scan loop (OS:chdir dir-name); Change the directory to the one being scanned (let loop ((curr-file-name (get-dirent)) (result-list '())) (if curr-file-name (let ((takers-result (file-taker (OS:make-file-info curr-file-name)))) (if takers-result ; #f as taker's result terminates the dir scan (loop (get-dirent) (if (eqv? takers-result '()) result-list (cons takers-result result-list))) (finish result-list) )) (finish result-list))) ))