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

core/byte-arrays/byte-arrays-docs.factor

@@ -26,5 +26,6 @@ HELP: <byte-array> ( n -- byte-array )
 
 HELP: >byte-array
 { $values { "seq" "a sequence" } { "byte-array" byte-array } }
-{ $description "Outputs a freshly-allocated byte array whose elements have the same boolean values as a given sequence." }
+{ $description
+  "Outputs a freshly-allocated byte array whose elements have the same signed byte values as a given sequence." }
 { $errors "Throws an error if the sequence contains elements other than integers." } ;

extra/ftp/client/client.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays classes.singleton combinators
-continuations io io.encodings.binary io.encodings.ascii
+continuations io io.encodings.binary io.encodings.utf8
 io.files io.sockets kernel io.streams.duplex math
 math.parser sequences splitting namespaces strings fry ftp ;
 IN: ftp.client
@@ -56,15 +56,17 @@ IN: ftp.client
     "|" split 2 tail* first string>number ;
 
 TUPLE: remote-file
-    type permissions links owner group size month day time year name ;
+type permissions links owner group size month day time year
+name target ;
 
 : <remote-file> ( -- remote-file ) remote-file new ;
 
 : parse-permissions ( remote-file str -- remote-file )
     [ first ch>type >>type ] [ rest >>permissions ] bi ;
 
-: parse-list-9 ( lines -- seq )
+: parse-list-11 ( lines -- seq )
     [
+        11 f pad-right
         <remote-file> swap {
             [ 0 swap nth parse-permissions ]
             [ 1 swap nth string>number >>links ]
@@ -75,6 +77,7 @@ TUPLE: remote-file
             [ 6 swap nth >>day ]
             [ 7 swap nth >>time ]
             [ 8 swap nth >>name ]
+            [ 10 swap nth >>target ]
         } cleave
     ] map ;
 
@@ -105,7 +108,8 @@ TUPLE: remote-file
     dup strings>>
     [ " " split harvest ] map
     dup length {
-        { 9 [ parse-list-9 ] }
+        { 11 [ parse-list-11 ] }
+        { 9 [ parse-list-11 ] }
         { 8 [ parse-list-8 ] }
         { 3 [ parse-list-3 ] }
         [ drop ]
@@ -129,7 +133,7 @@ ERROR: ftp-error got expected ;
     [ 229 ftp-assert ] [ parse-epsv ] bi ;
 
 : list ( ftp-client -- ftp-response )
-    host>> open-remote-port <inet> ascii <client>
+    host>> open-remote-port <inet> utf8 <client> drop
     ftp-list 150 ftp-assert
     lines
     <ftp-response> swap >>strings
@@ -137,14 +141,14 @@ ERROR: ftp-error got expected ;
     parse-list ;
 
 : ftp-get ( filename ftp-client -- ftp-response )
-    host>> open-remote-port <inet> binary <client>
+    host>> open-remote-port <inet> binary <client> drop
     swap
     [ ftp-retr 150 ftp-assert drop ]
     [ binary <file-writer> stream-copy ] 2bi
     read-response dup 226 ftp-assert ;
 
 : ftp-connect ( ftp-client -- stream )
-    [ host>> ] [ port>> ] bi <inet> ascii <client> ;
+    [ host>> ] [ port>> ] bi <inet> utf8 <client> drop ;
 
 GENERIC: ftp-download ( path obj -- )
 

extra/ftp/ftp.factor

@@ -7,7 +7,8 @@ IN: ftp
 SINGLETON: active
 SINGLETON: passive
 
-TUPLE: ftp-client host port user password mode state ;
+TUPLE: ftp-client host port user password mode state
+command-promise ;
 
 : <ftp-client> ( host -- ftp-client )
     ftp-client new

extra/ftp/server/server.factor

@@ -1,19 +1,35 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors combinators io io.encodings.8-bit
-io.files io.server io.sockets kernel math.parser
+io.encodings io.encodings.binary io.encodings.utf8 io.files
-namespaces sequences ftp io.unix.launcher.parser
+io.server io.sockets kernel math.parser namespaces sequences
-unicode.case splitting assocs ;
+ftp io.unix.launcher.parser unicode.case splitting assocs
+classes io.server destructors calendar io.timeouts
+io.streams.duplex threads continuations
+concurrency.promises byte-arrays ;
 IN: ftp.server
 
 SYMBOL: client
-SYMBOL: stream
 
 TUPLE: ftp-command raw tokenized ;
 
 : <ftp-command> ( -- obj )
     ftp-command new ;
 
+TUPLE: ftp-get path ;
+
+: <ftp-get> ( path -- obj )
+    ftp-get new swap >>path ;
+
+TUPLE: ftp-put path ;
+
+: <ftp-put> ( path -- obj )
+    ftp-put new swap >>path ;
+
+TUPLE: ftp-list ;
+
+C: <ftp-list> ftp-list
+
 : read-command ( -- ftp-command )
     <ftp-command> readln
     [ >>raw ] [ tokenize-command >>tokenized ] bi ;
@@ -32,77 +48,179 @@ TUPLE: ftp-command raw tokenized ;
         swap >>n
     send-response ;
 
+: ftp-error ( string -- )
+    500 "Unrecognized command: " rot append server-response ;
+
 : send-banner ( -- )
     220 "Welcome to " host-name append server-response ;
 
-: send-PASS-request ( -- )
-    331 "Please specify the password." server-response ;
-
 : anonymous-only ( -- )
     530 "This FTP server is anonymous only." server-response ;
 
-: parse-USER ( ftp-command -- )
+: handle-QUIT ( obj -- )
-    tokenized>> second client get swap >>user drop ;
-
-: send-login-response ( -- )
-    ! client get
-    230 "Login successful" server-response ;
-
-: parse-PASS ( ftp-command -- )
-    tokenized>> second client get swap >>password drop ;
-
-: send-quit-response ( ftp-command -- )
     drop 221 "Goodbye." server-response ;
 
-: ftp-error ( string -- )
+: handle-USER ( ftp-command -- )
-    500 "Unrecognized command: " rot append server-response ;
+    [
+        tokenized>> second client get swap >>user drop
+        331 "Please specify the password." server-response
+    ] [
+        2drop "bad USER" ftp-error
+    ] recover ;
 
-: send-type-error ( -- )
+: handle-PASS ( ftp-command -- )
-    "TYPE is binary only" ftp-error ;
+    [
+        tokenized>> second client get swap >>password drop
+        230 "Login successful" server-response
+    ] [
+        2drop "PASS error" ftp-error
+    ] recover ;
 
-: send-type-success ( string -- )
+ERROR: type-error type ;
-    200 "Switching to " rot " mode" 3append server-response ;
 
-: parse-TYPE ( obj -- )
+: handle-TYPE ( obj -- )
-    tokenized>> second >upper {
+    [
-        { "IMAGE" [ "Binary" send-type-success ] }
+        tokenized>> second >upper {
-        { "I" [ "Binary" send-type-success ] }
+            { "IMAGE" [ "Binary" ] }
-        [ drop send-type-error ]
+            { "I" [ "Binary" ] }
-    } case ;
+            [ type-error ]
+        } case
+        200 "Switching to " rot " mode" 3append server-response
+    ] [
+        2drop "TYPE is binary only" ftp-error
+    ] recover ;
 
-: pwd-response ( -- )
+: handle-PWD ( obj -- )
+    drop
     257 current-directory get "\"" swap "\"" 3append server-response ;
 
-! : random-local-inet ( -- spec )
+: random-local-server ( -- server )
-    ! remote-address get class new 0 >>port ;
+    remote-address get class new 0 >>port binary <server> ;
-
-! : handle-LIST ( -- )
-    ! random-local-inet ascii <server> ;
 
 : handle-STOR ( obj -- )
-    ;
+    [
+        drop
+    ] [
+        2drop
+    ] recover ;
 
 ! EPRT |2|::1|62138|
 ! : handle-EPRT ( obj -- )
     ! tokenized>> second "|" split harvest ;
 
-! : handle-EPSV ( obj -- )
-    ! 229 "Entering Extended Passive Mode (|||"
-    ! random-local-inet ! get port number>string
-    ! "|)" 3append server-response ;
-
-! LPRT 6,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,2,242,186
-: handle-LPRT ( obj -- )
-    tokenized>> "," split ;
-
 : start-directory ( -- )
     150 "Here comes the directory listing." server-response ;
 
 : finish-directory ( -- )
     226 "Directory send OK." server-response ;
 
-: send-directory-list ( stream -- )
+GENERIC: service-command ( stream obj -- )
-    [ directory-list write ] with-output-stream ;
+
+M: ftp-list service-command ( stream obj -- )
+    drop
+    start-directory
+    [
+        utf8 encode-output
+        directory-list [ ftp-send ] each
+    ] with-output-stream
+    finish-directory ;
+
+: start-file-transfer ( path -- )
+    150 "Opening BINARY mode data connection for "
+    rot   
+    [ file-name ] [
+        " " swap  file-info file-info-size number>string
+        "(" " bytes)." swapd 3append append
+    ] bi 3append server-response ;
+    
+: finish-file-transfer ( -- )
+    226 "File send OK." server-response ;
+
+M: ftp-get service-command ( stream obj -- )
+    [
+        path>>
+        [ start-file-transfer ]
+        [ binary <file-reader> swap stream-copy ] bi
+        finish-file-transfer
+    ] [
+        3drop "File transfer failed" ftp-error
+    ] recover ;
+
+M: ftp-put service-command ( stream obj -- )
+    [
+        path>>
+        [ start-file-transfer ]
+        [ binary <file-reader> swap stream-copy ] bi
+        finish-file-transfer
+    ] [
+        3drop "File transfer failed" ftp-error
+    ] recover ;
+
+: extended-passive-loop ( server -- )
+    [
+        [
+            |dispose
+            30 seconds over set-timeout
+            accept drop &dispose
+            client get command-promise>>
+            30 seconds ?promise-timeout
+            service-command
+        ]
+        [ client get f >>command-promise drop ]
+        [ ] cleanup
+    ] with-destructors ;
+
+: if-command-promise ( quot -- )
+    >r client get command-promise>> r>
+    [ "Establish an active or passive connection first" ftp-error ] if* ;
+
+: handle-LIST ( obj -- )
+    drop
+    [ <ftp-list> swap fulfill ] if-command-promise ;
+
+: handle-SIZE ( obj -- )
+    [
+        tokenized>> second file-info size>>
+        213 swap number>string server-response
+    ] [
+        2drop
+        550 "Could not get file size" server-response
+    ] recover ;
+
+: handle-RETR ( obj -- )
+    [ tokenized>> second <ftp-get> swap fulfill ]
+    curry if-command-promise ;
+
+: handle-EPSV ( obj -- )
+    drop
+    client get command-promise>> [
+        "You already have a passive stream" ftp-error
+    ] [
+        229 "Entering Extended Passive Mode (|||"
+        random-local-server
+        client get <promise> >>command-promise drop
+        [ [ B extended-passive-loop ] curry in-thread ]
+        [ addr>> port>> number>string ] bi
+        "|)" 3append server-response
+    ] if ;
+
+! LPRT 6,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,2,242,186
+! : handle-LPRT ( obj -- ) tokenized>> "," split ;
+
+ERROR: not-a-directory ;
+
+: handle-CWD ( obj -- )
+    [
+        tokenized>> second dup directory? [
+            set-current-directory
+            250 "Directory successully changed." server-response
+        ] [
+            not-a-directory throw
+        ] if
+    ] [
+        2drop
+        550 "Failed to change directory." server-response
+    ] recover ;
 
 : unrecognized-command ( obj -- ) raw>> ftp-error ;
 
@@ -111,28 +229,30 @@ TUPLE: ftp-command raw tokenized ;
     [ >>raw ]
     [ tokenize-command >>tokenized ] bi
     dup tokenized>> first >upper {
-        { "USER" [ parse-USER send-PASS-request t ] }
+        { "USER" [ handle-USER t ] }
-        { "PASS" [ parse-PASS send-login-response t ] }
+        { "PASS" [ handle-PASS t ] }
         { "ACCT" [ drop "ACCT unimplemented" ftp-error t ] }
-        ! { "CWD" [ ] }
+        { "CWD" [ handle-CWD t ] }
+        ! { "XCWD" [ ] }
         ! { "CDUP" [ ] }
         ! { "SMNT" [ ] }
 
         ! { "REIN" [ drop client get reset-ftp-client t ] }
-        { "QUIT" [ send-quit-response f ] }
+        { "QUIT" [ handle-QUIT f ] }
 
         ! { "PORT" [ ] }
         ! { "PASV" [ ] }
         ! { "MODE" [ ] }
-        { "TYPE" [ parse-TYPE t ] }
+        { "TYPE" [ handle-TYPE t ] }
         ! { "STRU" [ ] }
 
         ! { "ALLO" [ ] }
         ! { "REST" [ ] }
         ! { "STOR" [ handle-STOR t ] }
         ! { "STOU" [ ] }
-        ! { "RETR" [ ] }
+        { "RETR" [ handle-RETR t ] }
-        ! { "LIST" [ drop handle-LIST t ] }
+        { "LIST" [ handle-LIST t ] }
+        { "SIZE" [ handle-SIZE t ] }
         ! { "NLST" [ ] }
         ! { "APPE" [ ] }
         ! { "RNFR" [ ] }
@@ -140,7 +260,7 @@ TUPLE: ftp-command raw tokenized ;
         ! { "DELE" [ ] }
         ! { "RMD" [ ] }
         ! { "MKD" [ ] }
-        { "PWD" [ drop pwd-response t ] }
+        { "PWD" [ handle-PWD t ] }
         ! { "ABOR" [ ] }
 
         ! { "SYST" [ drop ] }
@@ -150,18 +270,20 @@ TUPLE: ftp-command raw tokenized ;
         ! { "SITE" [ ] }
         ! { "NOOP" [ ] }
 
-        ! { "EPRT" [ handle-eprt ] }
+        ! { "EPRT" [ handle-EPRT ] }
-        ! { "LPRT" [ handle-lprt ] }
+        ! { "LPRT" [ handle-LPRT ] }
-        ! { "EPSV" [ drop handle-epsv t ] }
+        { "EPSV" [ handle-EPSV t ] }
-        ! { "LPSV" [ drop handle-lpsv t ] }
+        ! { "LPSV" [ drop handle-LPSV t ] }
         [ drop unrecognized-command t ]
     } case [ handle-client-loop ] when ;
 
 : handle-client ( -- )
-    "" [
+    [
-        host-name <ftp-client> client set
+        "" [
-        send-banner handle-client-loop
+            host-name <ftp-client> client set
-    ] with-directory ;
+            send-banner handle-client-loop
+        ] with-directory
+    ] with-destructors ;
 
 : ftpd ( port -- )
     internet-server "ftp.server"

extra/globs/globs.factor

@@ -35,4 +35,4 @@ PRIVATE>
 : <glob> 'glob' just parse-1 just ;
 
 : glob-matches? ( input glob -- ? )
-    >r >lower r> <glob> parse nil? not ;
+    [ >lower ] [ <glob> ] bi* parse nil? not ;

extra/html/parser/analyzer/analyzer.factor

@@ -1,8 +1,11 @@
 USING: assocs html.parser kernel math sequences strings ascii
 arrays shuffle unicode.case namespaces splitting http
-sequences.lib ;
+sequences.lib accessors io combinators http.client ;
 IN: html.parser.analyzer
 
+: scrape-html ( url -- vector )
+    http-get parse-html ;
+
 : (find-relative)
     [ >r + dup r> ?nth* [ 2drop f f ] unless ] [ 2drop f ] if ;
 
@@ -41,8 +44,8 @@ IN: html.parser.analyzer
 
 : remove-blank-text ( vector -- vector' )
     [
-        dup tag-name text = [
+        dup name>> text = [
-            tag-text [ blank? ] all? not
+            text>> [ blank? ] all? not
         ] [
             drop t
         ] if
@@ -50,49 +53,50 @@ IN: html.parser.analyzer
 
 : trim-text ( vector -- vector' )
     [
-        dup tag-name text = [
+        dup name>> text = [
-            [ tag-text [ blank? ] trim ] keep
+            [ text>> [ blank? ] trim ] keep
             [ set-tag-text ] keep
         ] when
     ] map ;
 
 : find-by-id ( id vector -- vector )
-    [ tag-attributes "id" swap at = ] with filter ;
+    [ attributes>> "id" swap at = ] with filter ;
 
 : find-by-class ( id vector -- vector )
-    [ tag-attributes "class" swap at = ] with filter ;
+    [ attributes>> "class" swap at = ] with filter ;
 
 : find-by-name ( str vector -- vector )
     >r >lower r>
-    [ tag-name = ] with filter ;
+    [ name>> = ] with filter ;
 
 : find-first-name ( str vector -- i/f tag/f )
     >r >lower r>
-    [ tag-name = ] with find ;
+    [ name>> = ] with find ;
 
 : find-matching-close ( str vector -- i/f tag/f )
     >r >lower r>
-    [ [ tag-name = ] keep tag-closing? and ] with find ;
+    [ [ name>> = ] keep closing?>> and ] with find ;
 
 : find-by-attribute-key ( key vector -- vector )
     >r >lower r>
-    [ tag-attributes at ] with filter
+    [ attributes>> at ] with filter
     sift ;
 
 : find-by-attribute-key-value ( value key vector -- vector )
     >r >lower r>
-    [ tag-attributes at over = ] with filter nip
+    [ attributes>> at over = ] with filter nip
     sift ;
 
 : find-first-attribute-key-value ( value key vector -- i/f tag/f )
     >r >lower r>
-    [ tag-attributes at over = ] with find rot drop ;
+    [ attributes>> at over = ] with find rot drop ;
 
 : find-between* ( i/f tag/f vector -- vector )
     pick integer? [
         rot tail-slice
-        >r tag-name r>
+        >r name>> r>
-        [ find-matching-close drop 1+ ] keep swap head
+        [ find-matching-close drop dup [ 1+ ] when ] keep
+        swap [ head ] [ first ] if*
     ] [
         3drop V{ } clone
     ] if ;
@@ -105,31 +109,63 @@ IN: html.parser.analyzer
 : find-between-first ( string vector -- vector' )
     [ find-first-name ] keep find-between ;
 
+: find-between-all ( vector quot -- seq )
+    [ [ [ closing?>> not ] bi and ] curry find-all ] curry
+    [ [ >r first2 r> find-between* ] curry map ] bi ;
+
 : tag-link ( tag -- link/f )
-    tag-attributes [ "href" swap at ] [ f ] if* ;
+    attributes>> [ "href" swap at ] [ f ] if* ;
 
-: find-links ( vector -- vector )
+: find-links ( vector -- vector' )
-    [ tag-name "a" = ] filter
+    [ [ name>> "a" = ] [ attributes>> "href" swap at ] bi and ]
-    [ tag-link ] filter ;
+    find-between-all ;
 
+: link. ( vector -- )
+    [ second text>> write bl ]
+    [ first tag-link write nl ] bi ;
 
 : find-by-text ( seq quot -- tag )
-    [ dup tag-name text = ] prepose find drop ;
+    [ dup name>> text = ] prepose find drop ;
 
 : find-opening-tags-by-name ( name seq -- seq )
-    [ [ tag-name = ] keep tag-closing? not and ] with find-all ;
+    [ [ name>> = ] keep closing?>> not and ] with find-all ;
 
 : href-contains? ( str tag -- ? )
-    tag-attributes "href" swap at* [ subseq? ] [ 2drop f ] if ;
+    attributes>> "href" swap at* [ subseq? ] [ 2drop f ] if ;
+
+
+: find-forms ( vector -- vector' )
+    "form" over find-opening-tags-by-name
+    over [ >r first2 r> find-between* ] curry map
+    [ [ name>> { "form" "input" } member? ] filter ] map ;
+
+: find-html-objects ( string vector -- vector' )
+    find-opening-tags-by-name
+    over [ >r first2 r> find-between* ] curry map ;
+
+: form-action ( vector -- string )
+    [ name>> "form" = ] find nip 
+    attributes>> "action" swap at ;
+
+: hidden-form-values ( vector -- strings )
+    [ attributes>> "type" swap at "hidden" = ] filter ;
+
+: input. ( tag -- )
+    dup name>> print
+    attributes>>
+    [ bl bl bl bl [ write "=" write ] [ write bl ] bi* nl ] assoc-each ;
+
+: form. ( vector -- )
+    [ closing?>> not ] filter
+    [
+        {
+            { [ dup name>> "form" = ]
+                [ "form action: " write attributes>> "action" swap at print
+            ] }
+            { [ dup name>> "input" = ] [ input. ] }
+            [ drop ]
+        } cond
+    ] each ;
 
 : query>assoc* ( str -- hash )
     "?" split1 nip query>assoc ;
-
-! clear "http://fark.com" http-get parse-html find-links [ "go.pl" swap start ] filter [ "=" split peek ] map
-
-! clear "http://www.sailwx.info/shiptrack/cruiseships.phtml" http-get parse-html remove-blank-text
-! "a" over find-opening-tags-by-name
-! [ nip "shipposition.phtml?call=GBTT" swap href-contains? ] assoc-filter
-! first first 8 + over nth
-! tag-attributes "href" swap at query>assoc*
-! "lat" over at "lon" rot at

extra/html/parser/parser.factor

@@ -91,7 +91,7 @@ SYMBOL: tagstack
         read-dtd
     ] if ;
 
-: read-tag ( -- )
+: read-tag ( -- string )
     [ get-char CHAR: > = get-char CHAR: < = or ] take-until
     get-char CHAR: < = [ next* ] unless ;
 
@@ -135,7 +135,7 @@ SYMBOL: tagstack
         (parse-tag) make-tag push-tag
     ] if ;
 
-: (parse-html) ( tag -- )
+: (parse-html) ( -- )
     get-next [
         parse-text
         parse-tag

extra/http/http.factor

@@ -386,7 +386,7 @@ M: object protocol-addr
     drop [ host>> ] [ port>> ] bi <inet> ;
 
 M: https protocol-addr
-    call-next-method <ssl> ;
+    call-next-method <secure> ;
 
 : request-addr ( request -- addr )
     dup protocol>> protocol-addr ;

extra/io/ports/ports-docs.factor

@@ -62,12 +62,8 @@ HELP: (wait-to-read)
 { $contract "Suspends the current thread until the port's buffer has data available for reading." } ;
 
 HELP: wait-to-read
-{ $values { "port" input-port } }
+{ $values { "port" input-port } { "eof?" "a boolean" } }
-{ $description "If the port's buffer has unread data, returns immediately, otherwise suspends the current thread until some data is available for reading." } ;
+{ $description "If the port's buffer has unread data, returns immediately, otherwise suspends the current thread until some data is available for reading. If the buffer was empty and no more data could be read, outputs " { $link t } " to indicate end-of-file; otherwise outputs " { $link f } "." } ;
-
-HELP: unless-eof
-{ $values { "port" input-port } { "quot" "a quotation with stack effect " { $snippet "( port -- value )" } } { "value" object } }
-{ $description "If the port has reached end of file, outputs " { $link f } ", otherwise applies the quotation to the port." } ;
 
 HELP: can-write?
 { $values { "len" "a positive integer" } { "buffer" buffer } { "?" "a boolean" } }

extra/io/ports/ports.factor

@@ -25,27 +25,24 @@ TUPLE: buffered-port < port buffer ;
     <port>
         default-buffer-size get <buffer> >>buffer ; inline
 
-TUPLE: input-port < buffered-port eof ;
+TUPLE: input-port < buffered-port ;
 
 : <input-port> ( handle -- input-port )
     input-port <buffered-port> ;
 
 HOOK: (wait-to-read) io-backend ( port -- )
 
-: wait-to-read ( port -- )
+: wait-to-read ( port -- eof? )
-    dup buffer>> buffer-empty? [ (wait-to-read) ] [ drop ] if ;
+    dup buffer>> buffer-empty? [
-
+        dup (wait-to-read) buffer>> buffer-empty?
-: unless-eof ( port quot -- value )
+    ] [ drop f ] if ;
-    >r dup buffer>> buffer-empty? over eof>> and
-    [ f >>eof drop f ] r> if ; inline
 
 M: input-port stream-read1
     dup check-disposed
-    dup wait-to-read [ buffer>> buffer-pop ] unless-eof ;
+    dup wait-to-read [ drop f ] [ buffer>> buffer-pop ] if ;
 
 : read-step ( count port -- byte-array/f )
-    [ wait-to-read ] keep
+    dup wait-to-read [ 2drop f ] [ buffer>> buffer-read ] if ;
-    [ dupd buffer>> buffer-read ] unless-eof nip ;
 
 M: input-port stream-read-partial ( max stream -- byte-array/f )
     dup check-disposed

extra/io/sockets/sockets-docs.factor

@@ -37,7 +37,7 @@ ARTICLE: "network-packet" "Packet-oriented networking"
 { $subsection receive }
 "Packet-oriented sockets are closed by calling " { $link dispose } "."
 $nl
-"Address specifiers have the following interpretation with connection-oriented networking words:"
+"Address specifiers have the following interpretation with packet-oriented networking words:"
 { $list
     { { $link local } " - Unix domain datagram sockets on Unix systems" }
     { { $link inet4 } " - a TCP/IP connection to an IPv4 address and port number; no name lookup is performed" }

extra/io/unix/backend/backend.factor

@@ -108,9 +108,6 @@ M: io-timeout summary drop "I/O operation timed out" ;
 : io-error ( n -- ) 0 < [ (io-error) ] when ;
  
 ! Readers
-: eof ( reader -- )
-    dup buffer>> buffer-empty? [ t >>eof ] when drop ;
-
 : (refill) ( port -- n )
     [ handle>> ]
     [ buffer>> buffer-end ]
@@ -123,8 +120,7 @@ GENERIC: refill ( port handle -- event/f )
 M: fd refill
     fd>> over buffer>> [ buffer-end ] [ buffer-capacity ] bi read
     {
-        { [ dup 0 = ] [ drop eof f ] }
+        { [ dup 0 >= ] [ swap buffer>> n>buffer f ] }
-        { [ dup 0 > ] [ swap buffer>> n>buffer f ] }
         { [ err_no EINTR = ] [ 2drop +retry+ ] }
         { [ err_no EAGAIN = ] [ 2drop +input+ ] }
         [ (io-error) ]

extra/io/unix/linux/monitors/monitors.factor

@@ -111,7 +111,7 @@ M: linux-monitor dispose* ( monitor -- )
 
 : inotify-read-loop ( port -- )
     dup check-disposed
-    dup wait-to-read
+    dup wait-to-read drop
     0 over buffer>> parse-file-notifications
     0 over buffer>> buffer-reset
     inotify-read-loop ;

extra/io/unix/sockets/secure/secure-tests.factor

@@ -72,7 +72,7 @@ concurrency.promises byte-arrays ;
             "resource:extra/openssl/test/server.pem" >>key-file
             "resource:extra/openssl/test/root.pem" >>ca-file
             "resource:extra/openssl/test/dh1024.pem" >>dh-file
-            "password" >byte-array >>password
+            "password" >>password
         [
             "127.0.0.1" 0 <inet4> <secure> ascii <server> [
                 dup addr>> addrspec>> port>> "port" get fulfill

extra/io/unix/sockets/secure/secure.factor

@@ -26,11 +26,11 @@ M: ssl-handle handle-fd file>> handle-fd ;
     over handle>> handle>> over SSL_get_error ; inline
 
 ! Input ports
-: check-read-response ( port r -- event ) USING: namespaces io prettyprint ;
+: check-read-response ( port r -- event )
     check-response
     {
         { SSL_ERROR_NONE [ swap buffer>> n>buffer f ] }
-        { SSL_ERROR_ZERO_RETURN [ drop eof f ] }
+        { SSL_ERROR_ZERO_RETURN [ 2drop f ] }
         { SSL_ERROR_WANT_READ [ 2drop +input+ ] }
         { SSL_ERROR_WANT_WRITE [ 2drop +output+ ] }
         { SSL_ERROR_SYSCALL [ syscall-error ] }

extra/io/windows/nt/backend/backend.factor

@@ -110,11 +110,7 @@ M: winnt (wait-to-write)
     ] with-destructors ;
 
 : finish-read ( n port -- )
-    over zero? [
+    [ update-file-ptr ] [ buffer>> n>buffer ] 2bi ;
-        t >>eof 2drop
-    ] [
-        [ buffer>> n>buffer ] [ update-file-ptr ] 2bi
-    ] if ;
 
 M: winnt (wait-to-read) ( port -- )
     [

extra/openssl/openssl-tests.factor

@@ -1,21 +1,21 @@
 USING: io.sockets.secure io.encodings.ascii alien.strings
 openssl namespaces accessors tools.test continuations kernel ;
 
-openssl ssl-backend [
+openssl secure-socket-backend [
     [ ] [
-        <ssl-config>
+        <secure-config>
             "resource:extra/openssl/test/server.pem" >>key-file
             "resource:extra/openssl/test/root.pem" >>ca-file
             "resource:extra/openssl/test/dh1024.pem" >>dh-file
-            "password" ascii string>alien >>password
+            "password" >>password
-        [ ] with-ssl-context
+        [ ] with-secure-context
     ] unit-test
 
     [
-        <ssl-config>
+        <secure-config>
             "resource:extra/openssl/test/server.pem" >>key-file
             "resource:extra/openssl/test/root.pem" >>ca-file
-            "wrong password" ascii string>alien >>password
+            "wrong password" >>password
-        [ ] with-ssl-context
+        [ ] with-secure-context
     ] must-fail
 ] with-variable

extra/openssl/openssl.factor

@@ -5,7 +5,7 @@ math.order combinators init alien alien.c-types alien.strings libc
 continuations destructors debugger inspector
 locals unicode.case
 openssl.libcrypto openssl.libssl
-io.backend io.ports io.files io.encodings.ascii io.sockets.secure ;
+io.backend io.ports io.files io.encodings.8-bit io.sockets.secure ;
 IN: openssl
 
 ! This code is based on http://www.rtfm.com/openssl-examples/
@@ -68,7 +68,7 @@ TUPLE: openssl-context < secure-context aliens ;
     ] alien-callback ;
 
 : default-pasword ( ctx -- alien )
-    [ config>> password>> malloc-byte-array ] [ aliens>> ] bi
+    [ config>> password>> latin1 malloc-string ] [ aliens>> ] bi
     [ push ] [ drop ] 2bi ;
 
 : set-default-password ( ctx -- )
@@ -181,7 +181,7 @@ M: ssl-handle dispose*
     X509_get_subject_name
     NID_commonName 256 <byte-array>
     [ 256 X509_NAME_get_text_by_NID ] keep
-    swap -1 = [ drop f ] [ ascii alien>string ] if ;
+    swap -1 = [ drop f ] [ latin1 alien>string ] if ;
 
 : check-common-name ( host ssl-handle -- )
     SSL_get_peer_certificate common-name 2dup [ >lower ] bi@ =

extra/shell/shell.factor

@@ -1,7 +1,7 @@
 
 USING: kernel parser words continuations namespaces debugger
        sequences combinators splitting prettyprint
-       system io io.files io.launcher io.encodings.utf8 sequences.deep
+       system io io.files io.launcher io.encodings.utf8 io.pipes sequences.deep
        accessors multi-methods newfx shell.parser ;
 
 IN: shell
@@ -95,8 +95,7 @@ METHOD: expand { object } ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: pipeline-chant ( pipeline-chant -- )
+: pipeline-chant ( pipeline-chant -- ) commands>> run-pipeline drop ;
-  drop "ix: pipelines not supported" print ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 

extra/unix/unix.factor

@@ -26,6 +26,8 @@ TYPEDEF: uint socklen_t
 : ESRCH 3 ; inline
 : EEXIST 17 ; inline
 
+: NGROUPS_MAX 16 ; inline
+
 C-STRUCT: group
     { "char*" "gr_name" }
     { "char*" "gr_passwd" }