basis/io/directories/unix/unix.factor

   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
   7 unix.ffi vocabs ;
   8 IN: io.directories.unix
   9
  10 CONSTANT: touch-mode flags{ O_WRONLY O_APPEND O_CREAT O_EXCL }
  11
  12 CONSTANT: mkdir-mode flags{ USER-ALL GROUP-ALL OTHER-ALL } ! 0o777
  13
  14 M: unix touch-file ( path -- )
  15     normalize-path
  16     dup exists? [ touch ] [
  17         touch-mode file-mode open-file close-file
  18     ] if ;
  19
  20 M: unix move-file-atomically ( from to -- )
  21     [ normalize-path ] bi@ [ rename ] unix-system-call drop ;
  22
  23 M: unix move-file ( from to -- )
  24     [ move-file-atomically ] [
  25         dup errno>> EXDEV = [
  26             drop [ copy-file ] [ drop delete-file ] 2bi
  27         ] [ rethrow ] if
  28     ] recover ;
  29
  30 M: unix delete-file ( path -- ) normalize-path unlink-file ;
  31
  32 M: unix make-directory ( path -- )
  33     normalize-path mkdir-mode [ mkdir ] unix-system-call drop ;
  34
  35 M: unix delete-directory ( path -- )
  36     normalize-path [ rmdir ] unix-system-call drop ;
  37
  38 M: unix copy-file ( from to -- )
  39     [ call-next-method ]
  40     [ [ file-permissions ] dip swap set-file-permissions ] 2bi ;
  41
  42 : with-unix-directory ( path quot -- )
  43     dupd '[ _ _
  44         [ opendir dup [ throw-errno ] unless ] dip
  45         dupd curry swap '[ _ closedir io-error ] finally
  46     ] with-directory ; inline
  47
  48 : dirent-type>file-type ( type -- file-type )
  49     H{
  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+ }
  58     } at* [ drop +unknown+ ] unless ;
  59
  60 ! An easy way to return +unknown+ is to mount a .iso on OSX and
  61 ! call directory-entries on the mount point.
  62
  63 : next-dirent ( DIR* dirent* -- dirent* ? )
  64     f void* <ref> [
  65         readdir_r [ (throw-errno) ] unless-zero
  66     ] 2keep void* deref ; inline
  67
  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
  73
  74 M: unix (directory-entries) ( path -- seq )
  75     [
  76         dirent <struct>
  77         '[ _ _ next-dirent ] [ >directory-entry ] produce nip
  78     ] with-unix-directory ;
  79
  80 os linux? [ "io.directories.unix.linux" require ] when