steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

fix compile errors in ftp.server

db4
Doug Coleman 2008-11-18 13:31:43 -06:00
parent f8a6e3b0d8
commit 0a12467767
1 changed files with 8 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
extra/ftp/server/server.factor
View File

@ -7,10 +7,11 @@ namespaces make sequences ftp io.unix.launcher.parser
unicode.case splitting assocs classes io.servers.connection unicode.case splitting assocs classes io.servers.connection
destructors calendar io.timeouts io.streams.duplex threads destructors calendar io.timeouts io.streams.duplex threads
continuations math concurrency.promises byte-arrays continuations math concurrency.promises byte-arrays
io.backend sequences.lib tools.hexdump io.files.listing ; io.backend sequences.lib tools.hexdump io.files.listing
io.streams.string ;
IN: ftp.server IN: ftp.server
TUPLE: ftp-client url mode state command-promise ; TUPLE: ftp-client url mode state command-promise user password ;
: <ftp-client> ( url -- ftp-client ) : <ftp-client> ( url -- ftp-client )
ftp-client new ftp-client new
@ -75,7 +76,7 @@ C: <ftp-list> ftp-list
: handle-USER ( ftp-command -- ) : handle-USER ( ftp-command -- )
[ [
drop tokenized>> second client get (>>user)
331 "Please specify the password." server-response 331 "Please specify the password." server-response
] [ ] [
2drop "bad USER" ftp-error 2drop "bad USER" ftp-error
@ -140,16 +141,16 @@ ERROR: type-error type ;
150 "Here comes the directory listing." server-response ; 150 "Here comes the directory listing." server-response ;
: finish-directory ( -- ) : finish-directory ( -- )
226 "Opening " server-response ; 226 "Directory send OK." server-response ;
GENERIC: service-command ( stream obj -- ) GENERIC: service-command ( stream obj -- )
M: ftp-list service-command ( stream obj -- ) M: ftp-list service-command ( stream obj -- )
drop drop
start-directory start-directory [
[
utf8 encode-output utf8 encode-output
directory. [ ftp-send ] each [ current-directory get directory. ] with-string-writer string-lines
harvest [ ftp-send ] each
] with-output-stream ] with-output-stream
finish-directory ; finish-directory ;