unmaintained/io/os-unix.factor

   1 ! Copyright (C) 2007 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: alien arrays calendar errors io io-internals kernel
   4 math nonblocking-io sequences unix-internals unix-io ;
   5 IN: libs-io
   6
   7 : O_APPEND  HEX: 100 ; inline
   8 : O_EXCL    HEX: 800 ; inline
   9 : SEEK_SET 0 ; inline
  10 : SEEK_CUR 1 ; inline
  11 : SEEK_END 2 ; inline
  12 : EEXIST 17 ; inline
  13
  14 FUNCTION: off_t lseek ( int fildes, off_t offset, int whence ) ;
  15 : append-mode
  16     O_WRONLY O_APPEND O_CREAT bitor bitor ; foldable
  17
  18 : open-append ( path -- fd )
  19     append-mode file-mode open dup io-error
  20     [ 0 SEEK_END lseek io-error ] keep ;
  21
  22 : touch-mode
  23     O_WRONLY O_APPEND O_CREAT O_EXCL bitor bitor bitor ; foldable
  24
  25 : open-touch ( path -- fd )
  26     touch-mode file-mode open
  27     [ io-error close t ]
  28     [ 2drop err_no EEXIST = [ err_no io-error ] unless -1 ] recover ;
  29
  30 : <file-appender> ( path -- stream ) open-append <writer> ;
  31
  32 FUNCTION: int unlink ( char* path ) ;
  33 : delete-file ( path -- )
  34     unlink io-error ;
  35
  36 FUNCTION: int mkdir ( char* path, mode_t mode ) ;
  37
  38 : (create-directory) ( path mode -- )
  39     mkdir io-error ;
  40
  41 : create-directory ( path -- )
  42     0 (create-directory) ;
  43
  44 FUNCTION: int rmdir ( char* path ) ;
  45
  46 : delete-directory ( path -- )
  47     rmdir io-error ;
  48
  49 FUNCTION: int chroot ( char* path ) ;
  50 FUNCTION: int chdir ( char* path ) ;
  51 FUNCTION: int fchdir ( int fd ) ;
  52
  53 FUNCTION: int utimes ( char* path, timeval[2] times ) ;
  54 FUNCTION: int futimes ( int id, timeval[2] times ) ;
  55
  56 TYPEDEF: longlong blkcnt_t
  57 TYPEDEF: int blksize_t
  58 TYPEDEF: int dev_t
  59 TYPEDEF: uint ino_t
  60 TYPEDEF: ushort mode_t
  61 TYPEDEF: ushort nlink_t
  62 TYPEDEF: uint uid_t
  63 TYPEDEF: uint gid_t
  64 TYPEDEF: longlong quad_t
  65 TYPEDEF: ulong u_long
  66
  67 FUNCTION: int stat ( char* path, stat* sb ) ;
  68
  69 C-STRUCT: stat
  70     { "dev_t"     "dev" }       ! device inode resides on
  71     { "ino_t"     "ino" }       ! inode's number
  72     { "mode_t"    "mode" }      ! inode protection mode
  73     { "nlink_t"   "nlink" }     ! number or hard links to the file
  74     { "uid_t"     "uid" }       ! user-id of owner
  75     { "gid_t"     "gid" }       ! group-id of owner
  76     { "dev_t"     "rdev" }      ! device type, for special file inode
  77     { "timespec"  "atime" }     ! time of last access
  78     { "timespec"  "mtime" }     ! time of last data modification
  79     { "timespec"  "ctime" }     ! time of last file status change
  80     { "off_t"     "size" }      ! file size, in bytes
  81     { "blkcnt_t"  "blocks" }    ! blocks allocated for file
  82     { "blksize_t" "blksize" }   ! optimal file sys I/O ops blocksize
  83     { "u_long"    "flags" }     ! user defined flags for file
  84     { "u_long"    "gen" } ;     ! file generation number
  85
  86 : stat* ( path -- byte-array )
  87     "stat" <c-object> [ stat io-error ] keep ;
  88
  89 : make-timeval-array ( array -- byte-array )
  90     [ length "timeval" <c-array> ] keep
  91     dup length [ over [ pick set-timeval-nth ] [ 2drop ] if ] 2each ;
  92
  93 : (set-file-times) ( timestamp timestamp -- alien )
  94     [ [ timestamp>timeval ] [ f ] if* ] 2apply 2array
  95     make-timeval-array ;
  96
  97 : set-file-times ( path timestamp timestamp -- )
  98     #! set access, write
  99     (set-file-times) utimes io-error ;
 100
 101 : set-file-times* ( fd timestamp timestamp -- )
 102     (set-file-times) futimes io-error ;
 103
 104
 105 : set-file-access-time ( path timestamp -- )
 106     f set-file-times ;
 107
 108 : set-file-write-time ( path timestamp -- )
 109     >r f r> set-file-times ;
 110
 111
 112 : file-write-time ( path -- timestamp )
 113     stat* stat-mtime timespec>timestamp ;
 114
 115 : file-access-time ( path -- timestamp )
 116     stat* stat-atime timespec>timestamp ;
 117
 118 ! File type
 119 : S_IFMT    OCT: 0170000 ; inline ! type of file
 120 : S_IFIFO   OCT: 0010000 ; inline ! named pipe (fifo)
 121 : S_IFCHR   OCT: 0020000 ; inline ! character special
 122 : S_IFDIR   OCT: 0040000 ; inline ! directory
 123 : S_IFBLK   OCT: 0060000 ; inline ! block special
 124 : S_IFREG   OCT: 0100000 ; inline ! regular
 125 : S_IFLNK   OCT: 0120000 ; inline ! symbolic link
 126 : S_IFSOCK  OCT: 0140000 ; inline ! socket
 127 : S_IFWHT   OCT: 0160000 ; inline ! whiteout
 128 : S_IFXATTR OCT: 0200000 ; inline ! extended attribute
 129
 130 ! File mode
 131 ! Read, write, execute/search by owner
 132 : S_IRWXU OCT: 0000700 ; inline    ! rwx mask owner
 133 : S_IRUSR OCT: 0000400 ; inline    ! r owner
 134 : S_IWUSR OCT: 0000200 ; inline    ! w owner
 135 : S_IXUSR OCT: 0000100 ; inline    ! x owner
 136 ! Read, write, execute/search by group
 137 : S_IRWXG OCT: 0000070 ; inline    ! rwx mask group
 138 : S_IRGRP OCT: 0000040 ; inline    ! r group
 139 : S_IWGRP OCT: 0000020 ; inline    ! w group
 140 : S_IXGRP OCT: 0000010 ; inline    ! x group
 141 ! Read, write, execute/search by others
 142 : S_IRWXO OCT: 0000007 ; inline    ! rwx mask other
 143 : S_IROTH OCT: 0000004 ; inline    ! r other
 144 : S_IWOTH OCT: 0000002 ; inline    ! w other
 145 : S_IXOTH OCT: 0000001 ; inline    ! x other
 146
 147 : S_ISUID OCT: 0004000 ; inline    ! set user id on execution
 148 : S_ISGID OCT: 0002000 ; inline    ! set group id on execution
 149 : S_ISVTX OCT: 0001000 ; inline    ! sticky bit
 150
 151 FUNCTION: uid_t getuid ;
 152 FUNCTION: uid_t geteuid ;
 153
 154 FUNCTION: gid_t getgid ;
 155 FUNCTION: gid_t getegid ;
 156
 157 FUNCTION: int setuid ( uid_t uid ) ;
 158 FUNCTION: int seteuid ( uid_t euid ) ;
 159 FUNCTION: int setreuid ( uid_t ruid, uid_t euid ) ;
 160
 161 FUNCTION: int setgid ( gid_t gid ) ;
 162 FUNCTION: int setegid ( gid_t egid ) ;
 163 FUNCTION: int setregid ( gid_t rgid, gid_t egid ) ;
 164
 165 FUNCTION: int issetugid ;
 166
 167 FUNCTION: int chmod ( char* path, mode_t mode ) ;
 168 FUNCTION: int fchmod ( int fd, mode_t mode ) ;
 169
 170 FUNCTION: int chown ( char* path, uid_t owner, gid_t group ) ;
 171 FUNCTION: int fchown ( int fd, uid_t owner, gid_t group ) ;
 172 #! lchown does not follow symbolic links
 173 FUNCTION: int lchown ( char* path, uid_t owner, gid_t group ) ;
 174
 175 FUNCTION: int getgroups ( int gidsetlen, gid_t* gidset ) ;
 176 FUNCTION: int setgroups ( int ngroups, gid_t* gidset ) ;
 177
 178 FUNCTION: int flock ( int fd, int operation ) ;
 179 ! FUNCTION: int dup ( int oldd ) ;
 180 ! FUNCTION: int dup2 ( int oldd, int newd ) ;
 181
 182 FUNCTION: int fcntl ( int fd, int cmd, int arg ) ;
 183 FUNCTION: int getdtablesize ;
 184
 185 : file-mode? ( path mask -- ? )
 186     >r stat* stat-mode r> bit-set? ;
 187
 188 : user-read? ( path -- ? ) S_IRUSR file-mode? ;
 189 : user-write? ( path -- ? ) S_IWUSR file-mode? ;
 190 : user-execute? ( path -- ? ) S_IXUSR file-mode? ;
 191
 192 : group-read? ( path -- ? ) S_IRGRP file-mode? ;
 193 : group-write? ( path -- ? ) S_IWGRP file-mode? ;
 194 : group-execute? ( path -- ? ) S_IXGRP file-mode? ;
 195
 196 : other-read? ( path -- ? ) S_IROTH file-mode? ;
 197 : other-write? ( path -- ? ) S_IWOTH file-mode? ;
 198 : other-execute? ( path -- ? ) S_IXOTH file-mode? ;
 199
 200 : set-uid? ( path -- ? ) S_ISUID bit-set? ;
 201 : set-gid? ( path -- ? ) S_ISGID bit-set? ;
 202 : set-sticky? ( path -- ? ) S_ISVTX bit-set? ;
 203
 204 : chmod* ( path mask ? -- )
 205     >r >r dup stat* stat-mode r> r> [
 206         set-bit
 207     ] [
 208         clear-bit
 209     ] if chmod io-error ;
 210
 211 : set-user-read ( path ? -- ) >r S_IRUSR r> chmod* ;
 212 : set-user-write ( path ? -- ) >r S_IWUSR r> chmod* ;
 213 : set-user-execute ( path ? -- ) >r S_IXUSR r> chmod* ;
 214
 215 : set-group-read ( path ? -- ) >r S_IRGRP r> chmod* ;
 216 : set-group-write ( path ? -- ) >r S_IWGRP r> chmod* ;
 217 : set-group-execute ( path ? -- ) >r S_IXGRP r> chmod* ;
 218
 219 : set-other-read ( path ? -- ) >r S_IROTH r> chmod* ;
 220 : set-other-write ( path ? -- ) >r S_IWOTH r> chmod* ;
 221 : set-other-execute ( path ? -- ) >r S_IXOTH r> chmod* ;
 222
 223 : set-uid ( path ? -- ) >r S_ISUID r> chmod* ;
 224 : set-gid ( path ? -- ) >r S_ISGID r> chmod* ;
 225 : set-sticky ( path ? -- ) >r S_ISVTX r> chmod* ;
 226
 227 : mode>symbol ( mode -- ch )
 228     S_IFMT bitand
 229     {
 230         { [ dup S_IFDIR = ] [ drop "/" ] }
 231         { [ dup S_IFIFO = ] [ drop "|" ] }
 232         { [ dup S_IXUSR = ] [ drop "*" ] }
 233         { [ dup S_IFLNK = ] [ drop "@" ] }
 234         { [ dup S_IFWHT = ] [ drop "%" ] }
 235         { [ dup S_IFSOCK = ] [ drop "=" ] }
 236         { [ t ] [ drop "" ] }
 237     } cond ;