From 58861321fff10ec0ceae9f008bb10af844c13e4c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 13 May 2008 16:26:11 -0500 Subject: [PATCH 01/13] ftp server is alive! --- extra/ftp/client/client.factor | 18 -------- extra/ftp/ftp.factor | 18 ++++++++ extra/ftp/server/server.factor | 79 +++++++++++++++++++++++++--------- 3 files changed, 76 insertions(+), 39 deletions(-) diff --git a/extra/ftp/client/client.factor b/extra/ftp/client/client.factor index 13cb21d7e4..44ff488a93 100644 --- a/extra/ftp/client/client.factor +++ b/extra/ftp/client/client.factor @@ -6,24 +6,6 @@ io.files io.sockets kernel io.streams.duplex math math.parser sequences splitting namespaces strings fry ftp ; IN: ftp.client -TUPLE: ftp-client host port user password mode ; - -: ( host -- ftp-client ) - ftp-client new - swap >>host - 21 >>port - "anonymous" >>user - "ftp@my.org" >>password ; - -TUPLE: ftp-response n strings parsed ; - -: ( -- ftp-response ) - ftp-response new - V{ } clone >>strings ; - -: add-response-line ( ftp-response string -- ftp-response ) - over strings>> push ; - : (ftp-response-code) ( str -- n ) 3 head string>number ; diff --git a/extra/ftp/ftp.factor b/extra/ftp/ftp.factor index 565f5ce2ff..05291d3d5f 100644 --- a/extra/ftp/ftp.factor +++ b/extra/ftp/ftp.factor @@ -6,4 +6,22 @@ IN: ftp SINGLETON: active SINGLETON: passive +TUPLE: ftp-client host port user password mode state ; + +: ( host -- ftp-client ) + ftp-client new + swap >>host + 21 >>port + "anonymous" >>user + "ftp@my.org" >>password ; + +TUPLE: ftp-response n strings parsed ; + +: ( -- ftp-response ) + ftp-response new + V{ } clone >>strings ; + +: add-response-line ( ftp-response string -- ftp-response ) + over strings>> push ; + : ftp-send ( string -- ) write "\r\n" write flush ; diff --git a/extra/ftp/server/server.factor b/extra/ftp/server/server.factor index 9165fa08bd..1b9201fb7b 100644 --- a/extra/ftp/server/server.factor +++ b/extra/ftp/server/server.factor @@ -1,15 +1,13 @@ USING: accessors combinators io io.encodings.8-bit -io.server io.sockets kernel sequences ftp -io.unix.launcher.parser unicode.case ; +io.files io.server io.sockets kernel math.parser +namespaces sequences ftp io.unix.launcher.parser +unicode.case ; IN: ftp.server -TUPLE: ftp-server port ; - -: ( -- ftp-server ) - ftp-server new - 21 >>port ; +SYMBOL: client TUPLE: ftp-client-command string tokenized ; + : ( -- obj ) ftp-client-command new ; @@ -17,25 +15,56 @@ TUPLE: ftp-client-command string tokenized ; readln [ >>string ] [ tokenize-command >>tokenized ] bi ; -: server>client ( string -- ftp-client-command ) - ftp-send read-client-command ; +: send-response ( ftp-response -- ) + [ n>> ] [ strings>> ] bi + 2dup + but-last-slice [ + [ number>string write "-" write ] [ ftp-send ] bi* + ] with each + first [ number>string write bl ] [ ftp-send ] bi* ; -: send-banner ( -- ftp-client-command ) - "220 Welcome to " host-name append server>client ; +: server-response ( n string -- ) + + swap add-response-line + swap >>n + send-response ; -: handle-client-loop ( ftp-client-command -- ) +: send-banner ( -- ) + 220 "Welcome to " host-name append server-response ; + +: send-PASS-request ( -- ) + 331 "Please specify the password." server-response ; + +: parse-USER ( ftp-client-command -- ) + tokenized>> second client get swap >>user drop ; + +: send-login-response ( -- ) + ! client get + 230 "Login successful" server-response ; + +: parse-PASS ( ftp-client-command -- ) + tokenized>> second client get swap >>password drop ; + +: send-quit-response ( ftp-client-command -- ) + drop 221 "Goodbye." server-response ; + +: unimplemented-command ( ftp-client-command -- ) + 500 "Unimplemented command: " rot string>> append server-response ; + +: handle-client-loop ( -- ) readln - [ >>string ] [ tokenize-command >>tokenized ] bi - first >upper { - ! { "USER" [ ] } - ! { "PASS" [ ] } + [ >>string ] + [ tokenize-command >>tokenized ] bi + dup tokenized>> first >upper { + { "USER" [ parse-USER send-PASS-request t ] } + { "PASS" [ parse-PASS send-login-response t ] } ! { "ACCT" [ ] } ! { "CWD" [ ] } ! { "CDUP" [ ] } ! { "SMNT" [ ] } ! { "REIN" [ ] } - ! { "QUIT" [ ] } + { "QUIT" [ send-quit-response f ] } ! { "PORT" [ ] } ! { "PASV" [ ] } @@ -66,10 +95,17 @@ TUPLE: ftp-client-command string tokenized ; ! { "SITE" [ ] } ! { "NOOP" [ ] } - } case ; -: handle-client ( -- ftp-response ) + ! { "EPRT" [ ] } + ! { "LPRT" [ ] } + ! { "EPSV" [ ] } + ! { "LPSV" [ ] } + [ drop unimplemented-command t ] + } case [ handle-client-loop ] when ; + +: handle-client ( -- ) "" [ + host-name client set send-banner handle-client-loop ] with-directory ; @@ -77,7 +113,8 @@ TUPLE: ftp-client-command string tokenized ; internet-server "ftp.server" latin1 [ handle-client ] with-server ; -: ftpd-main ( -- ) - 2100 ftpd ; +: ftpd-main ( -- ) 2100 ftpd ; MAIN: ftpd-main + +! sudo tcpdump -i en1 -A -s 10000 tcp port 21 From d3f924681ba753cb72dead2cba88f47a7111fa88 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 13 May 2008 18:02:42 -0500 Subject: [PATCH 02/13] io.unix.mmap: use open-file instead of open --- extra/io/unix/mmap/mmap.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/io/unix/mmap/mmap.factor b/extra/io/unix/mmap/mmap.factor index ada1f94d87..4b015a071e 100755 --- a/extra/io/unix/mmap/mmap.factor +++ b/extra/io/unix/mmap/mmap.factor @@ -4,7 +4,7 @@ USING: alien io io.files kernel math system unix io.unix.backend io.mmap ; IN: io.unix.mmap -: open-r/w ( path -- fd ) O_RDWR file-mode open dup io-error ; +: open-r/w ( path -- fd ) O_RDWR file-mode open-file ; : mmap-open ( length prot flags path -- alien fd ) >r f -roll r> open-r/w [ 0 mmap ] keep From a43790444907e778355b3d49e392a7d754efe11f Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 13 May 2008 18:07:31 -0500 Subject: [PATCH 03/13] io.unix.files: update open-read --- extra/io/unix/files/files.factor | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor index 835b14e66d..d30e5c93a5 100755 --- a/extra/io/unix/files/files.factor +++ b/extra/io/unix/files/files.factor @@ -17,8 +17,7 @@ M: unix cd ( path -- ) : read-flags O_RDONLY ; inline -: open-read ( path -- fd ) - O_RDONLY file-mode open dup io-error ; +: open-read ( path -- fd ) O_RDONLY file-mode open-file ; M: unix (file-reader) ( path -- stream ) open-read ; From 7edfdbc057adc49b9dacc90353f1508c735ee93b Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 13 May 2008 18:28:43 -0500 Subject: [PATCH 04/13] unix: read-symbolic-link --- extra/unix/unix.factor | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/extra/unix/unix.factor b/extra/unix/unix.factor index 71e8dba8e6..4fd63313f9 100755 --- a/extra/unix/unix.factor +++ b/extra/unix/unix.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.c-types alien.syntax kernel libc structs sequences - continuations + continuations byte-arrays strings math namespaces system combinators vocabs.loader qualified accessors inference macros fry arrays.lib unix.types ; @@ -135,7 +135,17 @@ FUNCTION: int pclose ( void* file ) ; FUNCTION: int pipe ( int* filedes ) ; FUNCTION: void* popen ( char* command, char* type ) ; FUNCTION: ssize_t read ( int fd, void* buf, size_t nbytes ) ; + FUNCTION: ssize_t readlink ( char* path, char* buf, size_t bufsize ) ; + +: PATH_MAX 1024 ; inline + +: read-symbolic-link ( path -- path ) + PATH_MAX dup >r + PATH_MAX + [ readlink ] unix-system-call + r> swap head-slice >string ; + FUNCTION: ssize_t recv ( int s, void* buf, size_t nbytes, int flags ) ; FUNCTION: ssize_t recvfrom ( int s, void* buf, size_t nbytes, int flags, sockaddr-in* from, socklen_t* fromlen ) ; FUNCTION: int rename ( char* from, char* to ) ; @@ -162,8 +172,6 @@ FUNCTION: int utimes ( char* path, timeval[2] times ) ; FUNCTION: int kill ( pid_t pid, int sig ) ; -: PATH_MAX 1024 ; inline - : PRIO_PROCESS 0 ; inline : PRIO_PGRP 1 ; inline : PRIO_USER 2 ; inline From 95f7d8c8d42de7046d145703d6cffb43ef488951 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 13 May 2008 18:30:06 -0500 Subject: [PATCH 05/13] unix: indendation... --- extra/unix/unix.factor | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/extra/unix/unix.factor b/extra/unix/unix.factor index 4fd63313f9..5bdeeebd19 100755 --- a/extra/unix/unix.factor +++ b/extra/unix/unix.factor @@ -141,10 +141,10 @@ FUNCTION: ssize_t readlink ( char* path, char* buf, size_t bufsize ) ; : PATH_MAX 1024 ; inline : read-symbolic-link ( path -- path ) - PATH_MAX dup >r - PATH_MAX - [ readlink ] unix-system-call - r> swap head-slice >string ; + PATH_MAX dup >r + PATH_MAX + [ readlink ] unix-system-call + r> swap head-slice >string ; FUNCTION: ssize_t recv ( int s, void* buf, size_t nbytes, int flags ) ; FUNCTION: ssize_t recvfrom ( int s, void* buf, size_t nbytes, int flags, sockaddr-in* from, socklen_t* fromlen ) ; From 68fbd92703caf6b4e5747289f065bf5f83b57ce6 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 13 May 2008 18:36:54 -0500 Subject: [PATCH 06/13] io.unix.file: update read-link --- extra/io/unix/files/files.factor | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor index d30e5c93a5..69d4356d18 100755 --- a/extra/io/unix/files/files.factor +++ b/extra/io/unix/files/files.factor @@ -105,6 +105,4 @@ M: unix make-link ( path1 path2 -- ) normalize-path symlink io-error ; M: unix read-link ( path -- path' ) - normalize-path - PATH_MAX [ tuck ] [ ] bi readlink - dup io-error head-slice >string ; + normalize-path read-symbolic-link ; \ No newline at end of file From 6f2192bb7f597692e270ec8f3826a6179909031b Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 13 May 2008 18:40:09 -0500 Subject: [PATCH 07/13] unix: add unlink-file --- extra/unix/unix.factor | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/extra/unix/unix.factor b/extra/unix/unix.factor index 5bdeeebd19..a34bd85dc3 100755 --- a/extra/unix/unix.factor +++ b/extra/unix/unix.factor @@ -164,7 +164,11 @@ FUNCTION: int socket ( int domain, int type, int protocol ) ; FUNCTION: char* strerror ( int errno ) ; FUNCTION: int symlink ( char* path1, char* path2 ) ; FUNCTION: int system ( char* command ) ; + FUNCTION: int unlink ( char* path ) ; + +: unlink-file ( path -- ) [ unlink ] unix-system-call ; + FUNCTION: int utimes ( char* path, timeval[2] times ) ; : SIGKILL 9 ; inline From 099487d4d330f50e88981199a15c3cf3d4d20a51 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 13 May 2008 18:40:41 -0500 Subject: [PATCH 08/13] io.unix.files: update delete-file --- extra/io/unix/files/files.factor | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor index 69d4356d18..c1e4d319ce 100755 --- a/extra/io/unix/files/files.factor +++ b/extra/io/unix/files/files.factor @@ -51,8 +51,7 @@ M: unix touch-file ( path -- ) M: unix move-file ( from to -- ) [ normalize-path ] bi@ rename io-error ; -M: unix delete-file ( path -- ) - normalize-path unlink io-error ; +M: unix delete-file ( path -- ) normalize-path unlink-file ; M: unix make-directory ( path -- ) normalize-path OCT: 777 mkdir io-error ; From 991945d8b4a402f3f273df061d38276dd591801b Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 13 May 2008 19:05:12 -0500 Subject: [PATCH 09/13] unix: fix unlink-file --- extra/unix/unix.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/unix/unix.factor b/extra/unix/unix.factor index a34bd85dc3..8ce9ef5c87 100755 --- a/extra/unix/unix.factor +++ b/extra/unix/unix.factor @@ -167,7 +167,7 @@ FUNCTION: int system ( char* command ) ; FUNCTION: int unlink ( char* path ) ; -: unlink-file ( path -- ) [ unlink ] unix-system-call ; +: unlink-file ( path -- ) [ unlink ] unix-system-call drop ; FUNCTION: int utimes ( char* path, timeval[2] times ) ; From 7ce5a7d9d69095405df990687954dd48c893a6ac Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 13 May 2008 22:36:18 -0500 Subject: [PATCH 10/13] io.unix.file and io.unix.launcher: More usages of 'open-file' --- extra/io/unix/files/files.factor | 10 ++++------ extra/io/unix/launcher/launcher.factor | 2 +- 2 files changed, 5 insertions(+), 7 deletions(-) diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor index c1e4d319ce..c4f10ebb7b 100755 --- a/extra/io/unix/files/files.factor +++ b/extra/io/unix/files/files.factor @@ -12,8 +12,7 @@ M: unix cwd ( -- path ) MAXPATHLEN [ ] [ ] bi getcwd [ (io-error) ] unless* ; -M: unix cd ( path -- ) - chdir io-error ; +M: unix cd ( path -- ) [ chdir ] unix-system-call drop ; : read-flags O_RDONLY ; inline @@ -24,8 +23,7 @@ M: unix (file-reader) ( path -- stream ) : write-flags { O_WRONLY O_CREAT O_TRUNC } flags ; inline -: open-write ( path -- fd ) - write-flags file-mode open dup io-error ; +: open-write ( path -- fd ) write-flags file-mode open-file ; M: unix (file-writer) ( path -- stream ) open-write ; @@ -33,7 +31,7 @@ M: unix (file-writer) ( path -- stream ) : append-flags { O_WRONLY O_APPEND O_CREAT } flags ; inline : open-append ( path -- fd ) - append-flags file-mode open dup io-error + append-flags file-mode open-file [ dup 0 SEEK_END lseek io-error ] [ ] [ close ] cleanup ; M: unix (file-appender) ( path -- stream ) @@ -45,7 +43,7 @@ M: unix (file-appender) ( path -- stream ) M: unix touch-file ( path -- ) normalize-path dup exists? [ touch ] [ - touch-mode file-mode open close + touch-mode file-mode open-file close ] if ; M: unix move-file ( from to -- ) diff --git a/extra/io/unix/launcher/launcher.factor b/extra/io/unix/launcher/launcher.factor index 043b2bd73e..1a0bab73c3 100755 --- a/extra/io/unix/launcher/launcher.factor +++ b/extra/io/unix/launcher/launcher.factor @@ -44,7 +44,7 @@ USE: unix : redirect-file ( obj mode fd -- ) >r >r normalize-path r> file-mode - open dup io-error r> redirect-fd ; + open-file r> redirect-fd ; : redirect-file-append ( obj mode fd -- ) >r drop path>> normalize-path open-append r> redirect-fd ; From b029942d1da09c8649c97664251ceaa24485d4cd Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 13 May 2008 22:59:42 -0500 Subject: [PATCH 11/13] unix: close-file --- extra/unix/unix.factor | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/extra/unix/unix.factor b/extra/unix/unix.factor index 8ce9ef5c87..002c9b38c2 100755 --- a/extra/unix/unix.factor +++ b/extra/unix/unix.factor @@ -69,7 +69,11 @@ FUNCTION: int bind ( int s, void* name, socklen_t namelen ) ; FUNCTION: int chdir ( char* path ) ; FUNCTION: int chown ( char* path, uid_t owner, gid_t group ) ; FUNCTION: int chroot ( char* path ) ; -FUNCTION: void close ( int fd ) ; + +FUNCTION: int close ( int fd ) ; + +: close-file ( fd -- ) [ close ] unix-system-call drop ; + FUNCTION: int connect ( int s, void* name, socklen_t namelen ) ; FUNCTION: int dup2 ( int oldd, int newd ) ; ! FUNCTION: int dup ( int oldd ) ; From d4172cca472cf6f93bdcccbeba8c0d1444982ce1 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 13 May 2008 23:00:41 -0500 Subject: [PATCH 12/13] Convert usages of 'close' to 'close-file' --- extra/io/unix/backend/backend.factor | 3 +-- extra/io/unix/files/files.factor | 4 ++-- extra/io/unix/launcher/launcher.factor | 2 +- extra/io/unix/mmap/mmap.factor | 4 ++-- extra/io/unix/sockets/sockets.factor | 2 +- 5 files changed, 7 insertions(+), 8 deletions(-) diff --git a/extra/io/unix/backend/backend.factor b/extra/io/unix/backend/backend.factor index 652d4e77b3..fe45d433e6 100644 --- a/extra/io/unix/backend/backend.factor +++ b/extra/io/unix/backend/backend.factor @@ -85,8 +85,7 @@ M: integer init-handle ( fd -- ) [ F_SETFL O_NONBLOCK fcntl drop ] [ F_SETFD FD_CLOEXEC fcntl drop ] bi ; -M: integer close-handle ( fd -- ) - close ; +M: integer close-handle ( fd -- ) close-file ; TUPLE: unix-io-error error port ; diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor index c4f10ebb7b..80073e6aed 100755 --- a/extra/io/unix/files/files.factor +++ b/extra/io/unix/files/files.factor @@ -32,7 +32,7 @@ M: unix (file-writer) ( path -- stream ) : open-append ( path -- fd ) append-flags file-mode open-file - [ dup 0 SEEK_END lseek io-error ] [ ] [ close ] cleanup ; + [ dup 0 SEEK_END lseek io-error ] [ ] [ close-file ] cleanup ; M: unix (file-appender) ( path -- stream ) open-append ; @@ -43,7 +43,7 @@ M: unix (file-appender) ( path -- stream ) M: unix touch-file ( path -- ) normalize-path dup exists? [ touch ] [ - touch-mode file-mode open-file close + touch-mode file-mode open-file close-file ] if ; M: unix move-file ( from to -- ) diff --git a/extra/io/unix/launcher/launcher.factor b/extra/io/unix/launcher/launcher.factor index 1a0bab73c3..5a11e56cd9 100755 --- a/extra/io/unix/launcher/launcher.factor +++ b/extra/io/unix/launcher/launcher.factor @@ -31,7 +31,7 @@ USE: unix ] when* ; : redirect-fd ( oldfd fd -- ) - 2dup = [ 2drop ] [ dupd dup2 io-error close ] if ; + 2dup = [ 2drop ] [ dupd dup2 io-error close-file ] if ; : reset-fd ( fd -- ) #! We drop the error code because on *BSD, fcntl of diff --git a/extra/io/unix/mmap/mmap.factor b/extra/io/unix/mmap/mmap.factor index 4b015a071e..216f98ee58 100755 --- a/extra/io/unix/mmap/mmap.factor +++ b/extra/io/unix/mmap/mmap.factor @@ -8,7 +8,7 @@ IN: io.unix.mmap : mmap-open ( length prot flags path -- alien fd ) >r f -roll r> open-r/w [ 0 mmap ] keep - over MAP_FAILED = [ close (io-error) ] when ; + over MAP_FAILED = [ close-file (io-error) ] when ; M: unix (mapped-file) ( path length -- obj ) swap >r @@ -18,5 +18,5 @@ M: unix (mapped-file) ( path length -- obj ) M: unix close-mapped-file ( mmap -- ) [ mapped-file-address ] keep [ mapped-file-length munmap ] keep - mapped-file-handle close + mapped-file-handle close-file io-error ; diff --git a/extra/io/unix/sockets/sockets.factor b/extra/io/unix/sockets/sockets.factor index fee4821f50..51b198bdc0 100755 --- a/extra/io/unix/sockets/sockets.factor +++ b/extra/io/unix/sockets/sockets.factor @@ -79,7 +79,7 @@ M: accept-task do-io-task >r dup protocol-family r> socket-fd dup init-server-socket dup rot make-sockaddr/size bind - zero? [ dup close (io-error) ] unless ; + zero? [ dup close-file (io-error) ] unless ; M: unix (server) ( addrspec -- handle ) [ From 09f4e4b032e7db5daba05e048fea8ae960f31825 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 13 May 2008 23:09:39 -0500 Subject: [PATCH 13/13] Move some words from unix to unix.process --- extra/unix/process/process.factor | 16 ++++++++++++---- extra/unix/unix.factor | 4 ---- 2 files changed, 12 insertions(+), 8 deletions(-) diff --git a/extra/unix/process/process.factor b/extra/unix/process/process.factor index 0abefe14f1..48fac04a1c 100755 --- a/extra/unix/process/process.factor +++ b/extra/unix/process/process.factor @@ -1,12 +1,20 @@ -USING: kernel alien.c-types alien.strings sequences math unix -vectors kernel namespaces continuations threads assocs vectors -io.unix.backend io.encodings.utf8 ; +USING: kernel alien.c-types alien.strings sequences math alien.syntax unix + vectors kernel namespaces continuations threads assocs vectors + io.unix.backend io.encodings.utf8 ; IN: unix.process ! Low-level Unix process launching utilities. These are used ! to implement io.launcher on Unix. User code should use ! io.launcher instead. +FUNCTION: pid_t fork ( ) ; + +: fork-process ( -- pid ) [ fork ] unix-system-call ; + +FUNCTION: int execv ( char* path, char** argv ) ; +FUNCTION: int execvp ( char* path, char** argv ) ; +FUNCTION: int execve ( char* path, char** argv, char** envp ) ; + : >argv ( seq -- alien ) [ utf8 malloc-string ] map f suffix >c-void*-array ; @@ -29,7 +37,7 @@ IN: unix.process >r [ first ] [ ] bi r> exec-with-env ; : with-fork ( child parent -- ) - fork dup io-error dup zero? -roll swap curry if ; inline + fork-process dup zero? -roll swap curry if ; inline : wait-for-pid ( pid -- status ) 0 [ 0 waitpid drop ] keep *int WEXITSTATUS ; diff --git a/extra/unix/unix.factor b/extra/unix/unix.factor index 002c9b38c2..40abdc873c 100755 --- a/extra/unix/unix.factor +++ b/extra/unix/unix.factor @@ -77,9 +77,6 @@ FUNCTION: int close ( int fd ) ; FUNCTION: int connect ( int s, void* name, socklen_t namelen ) ; FUNCTION: int dup2 ( int oldd, int newd ) ; ! FUNCTION: int dup ( int oldd ) ; -FUNCTION: int execv ( char* path, char** argv ) ; -FUNCTION: int execvp ( char* path, char** argv ) ; -FUNCTION: int execve ( char* path, char** argv, char** envp ) ; : _exit ( status -- * ) #! We throw to give this a terminating stack effect. "int" f "_exit" { "int" } alien-invoke "Exit failed" throw ; @@ -87,7 +84,6 @@ FUNCTION: int fchdir ( int fd ) ; FUNCTION: int fchown ( int fd, uid_t owner, gid_t group ) ; FUNCTION: int fcntl ( int fd, int cmd, int arg ) ; FUNCTION: int flock ( int fd, int operation ) ; -FUNCTION: pid_t fork ( ) ; FUNCTION: void freeaddrinfo ( addrinfo* ai ) ; FUNCTION: int futimes ( int id, timeval[2] times ) ; FUNCTION: char* gai_strerror ( int ecode ) ;