Merge branch 'master' of git://factorcode.org/git/factor

db4
Slava Pestov 2008-05-20 07:55:55 -05:00
commit 38e2f992af
3 changed files with 41 additions and 19 deletions

View File

@ -6,12 +6,12 @@ ARTICLE: "stream-binary" "Working with binary data"
$nl $nl
"There are two ways to order the bytes making up an integer; " { $emphasis "little endian" } " byte order outputs the least significant byte first, and the most significant byte last, whereas " { $emphasis "big endian" } " is the other way around." "There are two ways to order the bytes making up an integer; " { $emphasis "little endian" } " byte order outputs the least significant byte first, and the most significant byte last, whereas " { $emphasis "big endian" } " is the other way around."
$nl $nl
"Consider the hexadecimal integer "{ $snippet "HEX: cafebabe" } ". Big endian byte order yields the following sequence of bytes:" "Consider the hexadecimal integer "{ $snippet "HEX: cafebabe" } ". Little endian byte order yields the following sequence of bytes:"
{ $table { $table
{ "Byte:" "1" "2" "3" "4" } { "Byte:" "1" "2" "3" "4" }
{ "Value:" { $snippet "be" } { $snippet "ba" } { $snippet "fe" } { $snippet "ca" } } { "Value:" { $snippet "be" } { $snippet "ba" } { $snippet "fe" } { $snippet "ca" } }
} }
"Compare this with little endian byte order:" "Compare this with big endian byte order:"
{ $table { $table
{ "Byte:" "1" "2" "3" "4" } { "Byte:" "1" "2" "3" "4" }
{ "Value:" { $snippet "ca" } { $snippet "fe" } { $snippet "ba" } { $snippet "be" } } { "Value:" { $snippet "ca" } { $snippet "fe" } { $snippet "ba" } { $snippet "be" } }

View File

@ -821,8 +821,8 @@ HELP: 3append
HELP: subseq HELP: subseq
{ $values { "from" "a non-negative integer" } { "to" "a non-negative integer" } { "seq" sequence } { "subseq" "a new sequence" } } { $values { "from" "a non-negative integer" } { "to" "a non-negative integer" } { "seq" sequence } { "subseq" "a new sequence" } }
{ $description "Outputs a new sequence consisting of all elements starting from and including " { $snippet "m" } ", and up to but not including " { $snippet "n" } "." } { $description "Outputs a new sequence consisting of all elements starting from and including " { $snippet "from" } ", and up to but not including " { $snippet "to" } "." }
{ $errors "Throws an error if " { $snippet "m" } " or " { $snippet "n" } " is out of bounds." } ; { $errors "Throws an error if " { $snippet "from" } " or " { $snippet "to" } " is out of bounds." } ;
HELP: clone-like HELP: clone-like
{ $values { "seq" sequence } { "exemplar" sequence } { "newseq" "a new sequence" } } { $values { "seq" sequence } { "exemplar" sequence } { "newseq" "a new sequence" } }

View File

@ -5,7 +5,7 @@ io.encodings io.encodings.binary io.encodings.utf8 io.files
io.server io.sockets kernel math.parser namespaces sequences io.server io.sockets kernel math.parser namespaces sequences
ftp io.unix.launcher.parser unicode.case splitting assocs ftp io.unix.launcher.parser unicode.case splitting assocs
classes io.server destructors calendar io.timeouts classes io.server destructors calendar io.timeouts
io.streams.duplex threads continuations io.streams.duplex threads continuations math
concurrency.promises byte-arrays ; concurrency.promises byte-arrays ;
IN: ftp.server IN: ftp.server
@ -78,24 +78,34 @@ C: <ftp-list> ftp-list
ERROR: type-error type ; ERROR: type-error type ;
: parse-type ( string -- string' )
>upper {
{ "IMAGE" [ "Binary" ] }
{ "I" [ "Binary" ] }
[ type-error ]
} case ;
: handle-TYPE ( obj -- ) : handle-TYPE ( obj -- )
[ [
tokenized>> second >upper { tokenized>> second parse-type
{ "IMAGE" [ "Binary" ] }
{ "I" [ "Binary" ] }
[ type-error ]
} case
200 "Switching to " rot " mode" 3append server-response 200 "Switching to " rot " mode" 3append server-response
] [ ] [
2drop "TYPE is binary only" ftp-error 2drop "TYPE is binary only" ftp-error
] recover ; ] recover ;
: random-local-server ( -- server )
remote-address get class new 0 >>port binary <server> ;
: port>bytes ( port -- hi lo )
[ -8 shift ] keep [ HEX: ff bitand ] bi@ ;
: handle-PWD ( obj -- ) : handle-PWD ( obj -- )
drop drop
257 current-directory get "\"" swap "\"" 3append server-response ; 257 current-directory get "\"" swap "\"" 3append server-response ;
: random-local-server ( -- server ) : handle-SYST ( obj -- )
remote-address get class new 0 >>port binary <server> ; drop
215 "UNIX Type: L8" server-response ;
: handle-STOR ( obj -- ) : handle-STOR ( obj -- )
[ [
@ -156,7 +166,7 @@ M: ftp-put service-command ( stream obj -- )
3drop "File transfer failed" ftp-error 3drop "File transfer failed" ftp-error
] recover ; ] recover ;
: extended-passive-loop ( server -- ) : passive-loop ( server -- )
[ [
[ [
|dispose |dispose
@ -191,16 +201,28 @@ M: ftp-put service-command ( stream obj -- )
[ tokenized>> second <ftp-get> swap fulfill ] [ tokenized>> second <ftp-get> swap fulfill ]
curry if-command-promise ; curry if-command-promise ;
: expect-connection ( -- port )
random-local-server
client get <promise> >>command-promise drop
[ [ passive-loop ] curry in-thread ]
[ addr>> port>> ] bi ;
: handle-PASV ( obj -- )
drop client get passive >>mode drop
expect-connection
[
"Entering Passive Mode (127,0,0,1," %
port>bytes [ number>string ] bi@ "," swap 3append %
")" %
] "" make 227 swap server-response ;
: handle-EPSV ( obj -- ) : handle-EPSV ( obj -- )
drop drop
client get command-promise>> [ client get command-promise>> [
"You already have a passive stream" ftp-error "You already have a passive stream" ftp-error
] [ ] [
229 "Entering Extended Passive Mode (|||" 229 "Entering Extended Passive Mode (|||"
random-local-server expect-connection number>string
client get <promise> >>command-promise drop
[ [ B extended-passive-loop ] curry in-thread ]
[ addr>> port>> number>string ] bi
"|)" 3append server-response "|)" 3append server-response
] if ; ] if ;
@ -241,7 +263,7 @@ ERROR: not-a-directory ;
{ "QUIT" [ handle-QUIT f ] } { "QUIT" [ handle-QUIT f ] }
! { "PORT" [ ] } ! { "PORT" [ ] }
! { "PASV" [ ] } { "PASV" [ handle-PASV t ] }
! { "MODE" [ ] } ! { "MODE" [ ] }
{ "TYPE" [ handle-TYPE t ] } { "TYPE" [ handle-TYPE t ] }
! { "STRU" [ ] } ! { "STRU" [ ] }
@ -263,7 +285,7 @@ ERROR: not-a-directory ;
{ "PWD" [ handle-PWD t ] } { "PWD" [ handle-PWD t ] }
! { "ABOR" [ ] } ! { "ABOR" [ ] }
! { "SYST" [ drop ] } { "SYST" [ handle-SYST t ] }
! { "STAT" [ ] } ! { "STAT" [ ] }
! { "HELP" [ ] } ! { "HELP" [ ] }