extra/unix/stat/stat.factor

   1
   2 USING: kernel system combinators alien.syntax alien.c-types
   3        math io.unix.backend vocabs.loader ;
   4
   5 IN: unix.stat
   6
   7 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   8 ! File Types
   9 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  10
  11 : S_IFMT   OCT: 170000 ; ! These bits determine file type.
  12
  13 : S_IFDIR  OCT:  40000 ;    ! Directory.
  14 : S_IFCHR  OCT:  20000 ;    ! Character device.
  15 : S_IFBLK  OCT:  60000 ;    ! Block device.
  16 : S_IFREG  OCT: 100000 ;    ! Regular file.
  17 : S_IFIFO  OCT: 010000 ;    ! FIFO.
  18 : S_IFLNK  OCT: 120000 ;    ! Symbolic link.
  19 : S_IFSOCK OCT: 140000 ;    ! Socket.
  20
  21 : S_ISTYPE ( mode mask -- val ) >r S_IFMT bitand r> = ;
  22
  23 : S_ISREG  ( mode -- value ) S_IFREG S_ISTYPE ;
  24 : S_ISDIR  ( mode -- value ) S_IFDIR S_ISTYPE ;
  25 : S_ISCHR  ( mode -- value ) S_IFCHR S_ISTYPE ;
  26 : S_ISBLK  ( mode -- value ) S_IFBLK S_ISTYPE ;
  27 : S_ISFIFO ( mode -- value ) S_IFIFO S_ISTYPE ;
  28 : S_ISLNK  ( mode -- value ) S_IFLNK S_ISTYPE ;
  29 : S_ISSOCK ( mode -- value ) S_IFSOCK S_ISTYPE ;
  30
  31 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  32 ! File Access Permissions
  33 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  34
  35 ! Read, write, execute/search by owner
  36 : S_IRWXU OCT: 0000700 ; inline    ! rwx mask owner
  37 : S_IRUSR OCT: 0000400 ; inline    ! r owner
  38 : S_IWUSR OCT: 0000200 ; inline    ! w owner
  39 : S_IXUSR OCT: 0000100 ; inline    ! x owner
  40 ! Read, write, execute/search by group
  41 : S_IRWXG OCT: 0000070 ; inline    ! rwx mask group
  42 : S_IRGRP OCT: 0000040 ; inline    ! r group
  43 : S_IWGRP OCT: 0000020 ; inline    ! w group
  44 : S_IXGRP OCT: 0000010 ; inline    ! x group
  45 ! Read, write, execute/search by others
  46 : S_IRWXO OCT: 0000007 ; inline    ! rwx mask other
  47 : S_IROTH OCT: 0000004 ; inline    ! r other
  48 : S_IWOTH OCT: 0000002 ; inline    ! w other
  49 : S_IXOTH OCT: 0000001 ; inline    ! x other
  50
  51 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  52
  53 FUNCTION: int chmod ( char* path, mode_t mode ) ;
  54
  55 FUNCTION: int fchmod ( int fd, mode_t mode ) ;
  56
  57 FUNCTION: int mkdir ( char* path, mode_t mode ) ;
  58
  59 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  60 <<
  61   os
  62   {
  63     { "linux"   [ "unix.stat.linux"   require ] }
  64     { "macosx"  [ "unix.stat.macosx"  require ] }
  65     { "freebsd" [ "unix.stat.freebsd" require ] }
  66     [ drop ]
  67   }
  68   case
  69 >>
  70 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  71
  72 : check-status ( n -- ) io-error ;
  73
  74 : stat* ( pathname -- stat )
  75   "stat" <c-object> dup >r
  76     stat check-status
  77   r> ;
  78
  79 : lstat* ( pathname -- stat )
  80   "stat" <c-object> dup >r
  81     lstat check-status
  82   r> ;