diff --git a/extra/ftp/client/client.factor b/extra/ftp/client/client.factor index 9b9a2214c1..8413331c00 100644 --- a/extra/ftp/client/client.factor +++ b/extra/ftp/client/client.factor @@ -120,7 +120,7 @@ name target ; ERROR: ftp-error got expected ; : ftp-assert ( ftp-response n -- ) - 2dup >r n>> r> = [ 2drop ] [ ftp-error ] if ; + 2dup [ n>> ] dip = [ 2drop ] [ ftp-error ] if ; : ftp-login ( ftp-client -- ) read-response 220 ftp-assert @@ -156,12 +156,12 @@ GENERIC: ftp-download ( path obj -- ) dupd '[ _ [ ftp-login ] [ @ ] bi ftp-quit drop - ] >r ftp-connect r> with-stream ; inline + ] [ ftp-connect ] dip with-stream ; inline M: ftp-client ftp-download ( path ftp-client -- ) [ [ drop parent-directory ftp-cwd drop ] - [ >r file-name r> ftp-get drop ] 2bi + [ [ file-name ] dip ftp-get drop ] 2bi ] with-ftp-client ; M: string ftp-download ( path string -- ) diff --git a/extra/ftp/ftp.factor b/extra/ftp/ftp.factor index 1fd97df6d5..8f0b48bd4d 100644 --- a/extra/ftp/ftp.factor +++ b/extra/ftp/ftp.factor @@ -36,7 +36,6 @@ TUPLE: ftp-response n strings parsed ; : ftp-ipv4 1 ; inline : ftp-ipv6 2 ; inline - : ch>type ( ch -- type ) { { CHAR: d [ +directory+ ] } @@ -54,9 +53,13 @@ TUPLE: ftp-response n strings parsed ; } case ; : file-info>string ( file-info name -- string ) - >r [ [ type>> type>ch 1string ] [ drop "rwx------" append ] bi ] - [ size>> number>string 15 CHAR: \s pad-left ] bi r> - 3array " " join ; + [ + [ + [ type>> type>ch 1string ] + [ drop "rwx------" append ] bi + ] + [ size>> number>string 15 CHAR: \s pad-left ] bi + ] dip 3array " " join ; : directory-list ( -- seq ) "" directory-files diff --git a/extra/ftp/server/server.factor b/extra/ftp/server/server.factor index 3ecf8d2f3f..170155bd43 100644 --- a/extra/ftp/server/server.factor +++ b/extra/ftp/server/server.factor @@ -6,7 +6,8 @@ io.encodings.utf8 io.files io.sockets kernel math.parser namespaces make sequences ftp io.unix.launcher.parser unicode.case splitting assocs classes io.servers.connection destructors calendar io.timeouts io.streams.duplex threads -continuations math concurrency.promises byte-arrays ; +continuations math concurrency.promises byte-arrays sequences.lib +hexdump ; IN: ftp.server SYMBOL: client @@ -19,12 +20,14 @@ TUPLE: ftp-command raw tokenized ; TUPLE: ftp-get path ; : ( path -- obj ) - ftp-get new swap >>path ; + ftp-get new + swap >>path ; TUPLE: ftp-put path ; : ( path -- obj ) - ftp-put new swap >>path ; + ftp-put new + swap >>path ; TUPLE: ftp-list ; @@ -62,7 +65,7 @@ C: ftp-list : handle-USER ( ftp-command -- ) [ - tokenized>> second client get swap >>user drop + tokenized>> second client get (>>user) 331 "Please specify the password." server-response ] [ 2drop "bad USER" ftp-error @@ -70,7 +73,7 @@ C: ftp-list : handle-PASS ( ftp-command -- ) [ - tokenized>> second client get swap >>password drop + tokenized>> second client get (>>password) 230 "Login successful" server-response ] [ 2drop "PASS error" ftp-error @@ -101,20 +104,20 @@ ERROR: type-error type ; : handle-PWD ( obj -- ) drop - 257 current-directory get "\"" swap "\"" 3append server-response ; + 257 current-directory get "\"" "\"" surround server-response ; : handle-SYST ( obj -- ) drop 215 "UNIX Type: L8" server-response ; : if-command-promise ( quot -- ) - >r client get command-promise>> r> + [ client get command-promise>> ] dip [ "Establish an active or passive connection first" ftp-error ] if* ; : handle-STOR ( obj -- ) [ tokenized>> second - [ >r r> fulfill ] if-command-promise + [ [ ] dip fulfill ] if-command-promise ] [ 2drop ] recover ; @@ -145,7 +148,7 @@ M: ftp-list service-command ( stream obj -- ) rot [ file-name ] [ " " swap file-info size>> number>string - "(" " bytes)." swapd 3append append + "(" " bytes)." surround append ] bi 3append server-response ; : transfer-incoming-file ( path -- ) @@ -191,7 +194,7 @@ M: ftp-put service-command ( stream obj -- ) : handle-LIST ( obj -- ) drop - [ >r r> fulfill ] if-command-promise ; + [ [ ] dip fulfill ] if-command-promise ; : handle-SIZE ( obj -- ) [ @@ -217,7 +220,7 @@ M: ftp-put service-command ( stream obj -- ) expect-connection [ "Entering Passive Mode (127,0,0,1," % - port>bytes [ number>string ] bi@ "," swap 3append % + port>bytes [ number>string ] bi@ "," splice % ")" % ] "" make 227 swap server-response ; @@ -242,7 +245,7 @@ ERROR: not-a-directory ; set-current-directory 250 "Directory successully changed." server-response ] [ - not-a-directory throw + not-a-directory ] if ] [ 2drop