1 ! Copyright (C) 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien.c-types alien.data alien.strings assocs
4 classes.struct continuations fry io.backend io.backend.unix
5 io.directories io.files io.files.info io.files.info.unix
6 io.files.types kernel libc literals math sequences system unix
8 IN: io.directories.unix
10 CONSTANT: touch-mode flags{ O_WRONLY O_APPEND O_CREAT O_EXCL }
12 CONSTANT: mkdir-mode flags{ USER-ALL GROUP-ALL OTHER-ALL } ! 0o777
14 M: unix touch-file ( path -- )
16 dup exists? [ touch ] [
17 touch-mode file-mode open-file close-file
20 M: unix move-file-atomically ( from to -- )
21 [ normalize-path ] bi@ [ rename ] unix-system-call drop ;
23 M: unix move-file ( from to -- )
24 [ move-file-atomically ] [
26 drop [ copy-file ] [ drop delete-file ] 2bi
30 M: unix delete-file ( path -- ) normalize-path unlink-file ;
32 M: unix make-directory ( path -- )
33 normalize-path mkdir-mode [ mkdir ] unix-system-call drop ;
35 M: unix delete-directory ( path -- )
36 normalize-path [ rmdir ] unix-system-call drop ;
38 M: unix copy-file ( from to -- )
40 [ [ file-permissions ] dip swap set-file-permissions ] 2bi ;
42 : with-unix-directory ( path quot -- )
44 [ opendir dup [ throw-errno ] unless ] dip
45 dupd curry swap '[ _ closedir io-error ] [ ] cleanup
46 ] with-directory ; inline
48 : dirent-type>file-type ( type -- file-type )
50 { $ DT_BLK +block-device+ }
51 { $ DT_CHR +character-device+ }
52 { $ DT_DIR +directory+ }
53 { $ DT_LNK +symbolic-link+ }
54 { $ DT_SOCK +socket+ }
56 { $ DT_REG +regular-file+ }
57 { $ DT_WHT +whiteout+ }
58 } at* [ drop +unknown+ ] unless ;
60 ! An easy way to return +unknown+ is to mount a .iso on OSX and
61 ! call directory-entries on the mount point.
63 : next-dirent ( DIR* dirent* -- dirent* ? )
65 readdir_r [ (throw-errno) ] unless-zero
66 ] 2keep void* deref ; inline
68 : >directory-entry ( dirent* -- directory-entry )
69 [ d_name>> alien>native-string ]
70 [ d_type>> dirent-type>file-type ] bi
71 dup +unknown+ = [ drop dup file-info type>> ] when
72 <directory-entry> ; inline
74 M: unix (directory-entries) ( path -- seq )
77 '[ _ _ next-dirent ] [ >directory-entry ] produce nip
78 ] with-unix-directory ;
80 os linux? [ "io.directories.unix.linux" require ] when