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
4 combinators continuations destructors fry io io.backend
5 io.directories io.encodings.binary
6 io.encodings.utf8 io.files io.pathnames io.files.types kernel
7 math.bitwise sequences system unix unix.stat vocabs.loader
8 classes.struct unix.ffi literals libc vocabs ;
9 IN: io.directories.unix
11 CONSTANT: file-mode 0o0666
13 CONSTANT: touch-mode flags{ O_WRONLY O_APPEND O_CREAT O_EXCL }
15 M: unix touch-file ( path -- )
17 dup exists? [ touch ] [
18 touch-mode file-mode open-file close-file
21 M: unix move-file ( from to -- )
22 [ normalize-path ] bi@ [ rename ] unix-system-call drop ;
24 M: unix delete-file ( path -- ) normalize-path unlink-file ;
26 M: unix make-directory ( path -- )
27 normalize-path 0o777 [ mkdir ] unix-system-call drop ;
29 M: unix delete-directory ( path -- )
30 normalize-path [ rmdir ] unix-system-call drop ;
32 M: unix copy-file ( from to -- )
33 [ normalize-path ] bi@ call-next-method ;
35 : with-unix-directory ( path quot -- )
36 [ opendir dup [ (io-error) ] unless ] dip
37 dupd curry swap '[ _ closedir io-error ] [ ] cleanup ; inline
39 HOOK: find-next-file os ( DIR* -- byte-array )
41 M: unix find-next-file ( DIR* -- byte-array )
45 [ readdir_r 0 = [ errno 0 = [ (io-error) ] unless ] unless ] 2keep
46 void* deref [ drop f ] unless ;
48 : dirent-type>file-type ( ch -- type )
50 { DT_BLK [ +block-device+ ] }
51 { DT_CHR [ +character-device+ ] }
52 { DT_DIR [ +directory+ ] }
53 { DT_LNK [ +symbolic-link+ ] }
54 { DT_SOCK [ +socket+ ] }
55 { DT_FIFO [ +fifo+ ] }
56 { DT_REG [ +regular-file+ ] }
57 { DT_WHT [ +whiteout+ ] }
61 M: unix >directory-entry ( byte-array -- directory-entry )
63 [ d_name>> underlying>> utf8 alien>string ]
64 [ d_type>> dirent-type>file-type ]
65 } cleave directory-entry boa ;
67 M: unix (directory-entries) ( path -- seq )
69 '[ _ find-next-file dup ]
72 ] with-unix-directory ;
74 os linux? [ "io.directories.unix.linux" require ] when