diff --git a/extra/ftp/client/client.factor b/extra/ftp/client/client.factor index 88b83b7d66..273f2237b5 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 diff --git a/extra/io/unix/backend/backend.factor b/extra/io/unix/backend/backend.factor index 5a21e8da68..537f00bfc9 100644 --- a/extra/io/unix/backend/backend.factor +++ b/extra/io/unix/backend/backend.factor @@ -101,8 +101,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 ; ! Readers : eof ( reader -- ) diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor index 121cd6dec3..9b0057c166 100755 --- a/extra/io/unix/files/files.factor +++ b/extra/io/unix/files/files.factor @@ -12,21 +12,18 @@ 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 -: 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 ; : 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 ; @@ -34,8 +31,8 @@ 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 - [ dup 0 SEEK_END lseek io-error ] [ ] [ close ] cleanup ; + append-flags file-mode open-file + [ dup 0 SEEK_END lseek io-error ] [ ] [ close-file ] cleanup ; M: unix (file-appender) ( path -- stream ) open-append ; @@ -46,14 +43,13 @@ 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-file ] if ; 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 ; @@ -106,6 +102,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 diff --git a/extra/io/unix/launcher/launcher.factor b/extra/io/unix/launcher/launcher.factor index d8a0c3cfe9..405f26d4bc 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 @@ -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 ; diff --git a/extra/io/unix/mmap/mmap.factor b/extra/io/unix/mmap/mmap.factor index ada1f94d87..216f98ee58 100755 --- a/extra/io/unix/mmap/mmap.factor +++ b/extra/io/unix/mmap/mmap.factor @@ -4,11 +4,11 @@ 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 - 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/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 745cac0cd1..2ac0a3bfa0 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 ; @@ -69,13 +69,14 @@ 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 ) ; -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 ; @@ -83,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 ) ; @@ -136,7 +136,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 ) ; @@ -155,7 +165,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 drop ; + FUNCTION: int utimes ( char* path, timeval[2] times ) ; : SIGKILL 9 ; inline @@ -163,8 +177,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