basis/unix/unix.factor

   1 ! Copyright (C) 2005, 2007 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: alien alien.c-types alien.syntax kernel libc
   4 sequences continuations byte-arrays strings math namespaces
   5 system combinators vocabs.loader qualified accessors
   6 stack-checker macros locals generalizations unix.types
   7 debugger io prettyprint io.files ;
   8 IN: unix
   9
  10 : PROT_NONE   0 ; inline
  11 : PROT_READ   1 ; inline
  12 : PROT_WRITE  2 ; inline
  13 : PROT_EXEC   4 ; inline
  14
  15 : MAP_FILE    0 ; inline
  16 : MAP_SHARED  1 ; inline
  17 : MAP_PRIVATE 2 ; inline
  18
  19 : MAP_FAILED -1 <alien> ; inline
  20
  21 : NGROUPS_MAX 16 ; inline
  22
  23 : DT_UNKNOWN   0 ; inline
  24 : DT_FIFO      1 ; inline
  25 : DT_CHR       2 ; inline
  26 : DT_DIR       4 ; inline
  27 : DT_BLK       6 ; inline
  28 : DT_REG       8 ; inline
  29 : DT_LNK      10 ; inline
  30 : DT_SOCK     12 ; inline
  31 : DT_WHT      14 ; inline
  32
  33 : dirent-type>file-type ( ch -- type )
  34     {
  35         { DT_BLK  [ +block-device+ ] }
  36         { DT_CHR  [ +character-device+ ] }
  37         { DT_DIR  [ +directory+ ] }
  38         { DT_LNK  [ +symbolic-link+ ] }
  39         { DT_SOCK [ +socket+ ] }
  40         { DT_FIFO [ +fifo+ ] }
  41         { DT_REG  [ +regular-file+ ] }
  42         { DT_WHT  [ +whiteout+ ] }
  43         [ drop +unknown+ ]
  44     } case ;
  45
  46 C-STRUCT: group
  47     { "char*" "gr_name" }
  48     { "char*" "gr_passwd" }
  49     { "int" "gr_gid" }
  50     { "char**" "gr_mem" } ;
  51
  52 LIBRARY: factor
  53
  54 FUNCTION: void clear_err_no ( ) ;
  55 FUNCTION: int err_no ( ) ;
  56
  57 LIBRARY: libc
  58
  59 FUNCTION: char* strerror ( int errno ) ;
  60
  61 ERROR: unix-error errno message ;
  62
  63 M: unix-error error.
  64     "Unix system call failed:" print
  65     nl
  66     dup message>> write " (" write errno>> pprint ")" print ;
  67
  68 : (io-error) ( -- * ) err_no dup strerror unix-error ;
  69
  70 : io-error ( n -- ) 0 < [ (io-error) ] when ;
  71
  72 ERROR: unix-system-call-error args errno message word ;
  73
  74 M: unix-system-call-error error.
  75     "Unix system call ``" write dup word>> pprint "'' failed:" print
  76     nl
  77     dup message>> write " (" write dup errno>> pprint ")" print
  78     nl
  79     "It was called with the following arguments:" print
  80     nl
  81     args>> stack. ;
  82
  83 MACRO:: unix-system-call ( quot -- )
  84     [let | n [ quot infer in>> ]
  85            word [ quot first ] |
  86         [
  87             n ndup quot call dup 0 < [
  88                 drop
  89                 n narray
  90                 err_no dup strerror
  91                 word unix-system-call-error
  92             ] [
  93                 n nnip
  94             ] if
  95         ]
  96     ] ;
  97
  98 FUNCTION: int accept ( int s, void* sockaddr, socklen_t* socklen ) ;
  99 FUNCTION: int bind ( int s, void* name, socklen_t namelen ) ;
 100 FUNCTION: int chdir ( char* path ) ;
 101 FUNCTION: int chmod ( char* path, mode_t mode ) ;
 102 FUNCTION: int fchmod ( int fd, mode_t mode ) ;
 103 FUNCTION: int chown ( char* path, uid_t owner, gid_t group ) ;
 104 FUNCTION: int chroot ( char* path ) ;
 105
 106 FUNCTION: int close ( int fd ) ;
 107 FUNCTION: int closedir ( DIR* dirp ) ;
 108
 109 : close-file ( fd -- ) [ close ] unix-system-call drop ;
 110
 111 FUNCTION: int connect ( int s, void* name, socklen_t namelen ) ;
 112 FUNCTION: int dup2 ( int oldd, int newd ) ;
 113 ! FUNCTION: int dup ( int oldd ) ;
 114 : _exit ( status -- * )
 115     #! We throw to give this a terminating stack effect.
 116     "int" f "_exit" { "int" } alien-invoke "Exit failed" throw ;
 117 FUNCTION: void endpwent ( ) ;
 118 FUNCTION: int fchdir ( int fd ) ;
 119 FUNCTION: int fchown ( int fd, uid_t owner, gid_t group ) ;
 120 FUNCTION: int fcntl ( int fd, int cmd, int arg ) ;
 121 FUNCTION: int flock ( int fd, int operation ) ;
 122 FUNCTION: void freeaddrinfo ( addrinfo* ai ) ;
 123 FUNCTION: int futimes ( int id, timeval[2] times ) ;
 124 FUNCTION: char* gai_strerror ( int ecode ) ;
 125 FUNCTION: int getaddrinfo ( char* hostname, char* servname, addrinfo* hints, addrinfo** res ) ;
 126 FUNCTION: char* getcwd ( char* buf, size_t size ) ;
 127 FUNCTION: pid_t getpid ;
 128 FUNCTION: int getdtablesize ;
 129 FUNCTION: gid_t getegid ;
 130 FUNCTION: uid_t geteuid ;
 131 FUNCTION: gid_t getgid ;
 132 FUNCTION: char* getenv ( char* name ) ;
 133
 134 FUNCTION: int getgrgid_r ( gid_t gid, group* grp, char* buffer, size_t bufsize, group** result ) ;
 135 FUNCTION: int getgrnam_r ( char* name, group* grp, char* buffer, size_t bufsize, group** result ) ;
 136 FUNCTION: passwd* getpwent ( ) ;
 137 FUNCTION: passwd* getpwuid ( uid_t uid ) ;
 138 FUNCTION: passwd* getpwnam ( char* login ) ;
 139 FUNCTION: int getpwnam_r ( char* login, passwd* pwd, char* buffer, size_t bufsize, passwd** result ) ;
 140 FUNCTION: int getgroups ( int gidsetlen, gid_t* gidset ) ;
 141 FUNCTION: int getgrouplist ( char* name, int basegid, int* groups, int* ngroups ) ;
 142 FUNCTION: int getrlimit ( int resource, rlimit* rlp ) ;
 143 FUNCTION: int setrlimit ( int resource, rlimit* rlp ) ;
 144
 145 FUNCTION: int getpriority ( int which, id_t who ) ;
 146 FUNCTION: int setpriority ( int which, id_t who, int prio ) ;
 147
 148 FUNCTION: int getrusage ( int who, rusage* r_usage ) ;
 149
 150 FUNCTION: group* getgrent ;
 151 FUNCTION: int gethostname ( char* name, int len ) ;
 152 FUNCTION: int getsockname ( int socket, sockaddr* address, socklen_t* address_len ) ;
 153 FUNCTION: int getpeername ( int socket, sockaddr* address, socklen_t* address_len ) ;
 154 FUNCTION: uid_t getuid ;
 155 FUNCTION: uint htonl ( uint n ) ;
 156 FUNCTION: ushort htons ( ushort n ) ;
 157 ! FUNCTION: int issetugid ;
 158 FUNCTION: int ioctl ( int fd, ulong request, char* argp ) ;
 159 FUNCTION: int lchown ( char* path, uid_t owner, gid_t group ) ;
 160 FUNCTION: int listen ( int s, int backlog ) ;
 161 FUNCTION: off_t lseek ( int fildes, off_t offset, int whence ) ;
 162 FUNCTION: void* mmap ( void* addr, size_t len, int prot, int flags, int fd, off_t offset ) ;
 163 FUNCTION: int munmap ( void* addr, size_t len ) ;
 164 FUNCTION: uint ntohl ( uint n ) ;
 165 FUNCTION: ushort ntohs ( ushort n ) ;
 166 FUNCTION: int shutdown ( int fd, int how ) ;
 167
 168 FUNCTION: int open ( char* path, int flags, int prot ) ;
 169
 170 FUNCTION: DIR* opendir ( char* path ) ;
 171
 172 : open-file ( path flags mode -- fd ) [ open ] unix-system-call ;
 173
 174 C-STRUCT: utimbuf
 175     { "time_t" "actime"  }
 176     { "time_t" "modtime" } ;
 177
 178 FUNCTION: int utime ( char* path, utimebuf* buf ) ;
 179
 180 : touch ( filename -- ) f [ utime ] unix-system-call drop ;
 181
 182 : change-file-times ( filename access modification -- )
 183     "utimebuf" <c-object>
 184     tuck set-utimbuf-modtime
 185     tuck set-utimbuf-actime
 186     [ utime ] unix-system-call drop ;
 187
 188 FUNCTION: int pclose ( void* file ) ;
 189 FUNCTION: int pipe ( int* filedes ) ;
 190 FUNCTION: void* popen ( char* command, char* type ) ;
 191 FUNCTION: ssize_t read ( int fd, void* buf, size_t nbytes ) ;
 192
 193 FUNCTION: dirent* readdir ( DIR* dirp ) ;
 194 FUNCTION: int readdir_r ( void* dirp, dirent* entry, dirent** result ) ;
 195
 196 FUNCTION: ssize_t readlink ( char* path, char* buf, size_t bufsize ) ;
 197
 198 : PATH_MAX 1024 ; inline
 199
 200 : read-symbolic-link ( path -- path )
 201     PATH_MAX <byte-array> dup [
 202         PATH_MAX
 203         [ readlink ] unix-system-call
 204     ] dip swap head-slice >string ;
 205
 206 FUNCTION: ssize_t recv ( int s, void* buf, size_t nbytes, int flags ) ;
 207 FUNCTION: ssize_t recvfrom ( int s, void* buf, size_t nbytes, int flags, sockaddr-in* from, socklen_t* fromlen ) ;
 208 FUNCTION: int rename ( char* from, char* to ) ;
 209 FUNCTION: int rmdir ( char* path ) ;
 210 FUNCTION: int select ( int nfds, void* readfds, void* writefds, void* exceptfds, timeval* timeout ) ;
 211 FUNCTION: ssize_t sendto ( int s, void* buf, size_t len, int flags, sockaddr-in* to, socklen_t tolen ) ;
 212 FUNCTION: int setenv ( char* name, char* value, int overwrite ) ;
 213 FUNCTION: int unsetenv ( char* name ) ;
 214 FUNCTION: int setegid ( gid_t egid ) ;
 215 FUNCTION: int seteuid ( uid_t euid ) ;
 216 FUNCTION: int setgid ( gid_t gid ) ;
 217 FUNCTION: int setgroups ( int ngroups, gid_t* gidset ) ;
 218 FUNCTION: int setregid ( gid_t rgid, gid_t egid ) ;
 219 FUNCTION: int setreuid ( uid_t ruid, uid_t euid ) ;
 220 FUNCTION: int setsockopt ( int s, int level, int optname, void* optval, socklen_t optlen ) ;
 221 FUNCTION: int setuid ( uid_t uid ) ;
 222 FUNCTION: int socket ( int domain, int type, int protocol ) ;
 223 FUNCTION: int symlink ( char* path1, char* path2 ) ;
 224 FUNCTION: int system ( char* command ) ;
 225
 226 FUNCTION: int unlink ( char* path ) ;
 227
 228 : unlink-file ( path -- ) [ unlink ] unix-system-call drop ;
 229
 230 FUNCTION: int utimes ( char* path, timeval[2] times ) ;
 231
 232 FUNCTION: ssize_t write ( int fd, void* buf, size_t nbytes ) ;
 233
 234 {
 235     { [ os linux? ] [ "unix.linux" require ] }
 236     { [ os bsd? ] [ "unix.bsd" require ] }
 237     { [ os solaris? ] [ "unix.solaris" require ] }
 238 } cond