Fix conflict

extra/ftp/client/client.factor

@@ -1,12 +1,13 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors classes.singleton combinators continuations
+USING: accessors arrays classes.singleton combinators
-io io.encodings.binary io.encodings.ascii io.files io.sockets
+continuations io io.encodings.binary io.encodings.ascii
-kernel math math.parser sequences splitting namespaces strings ;
+io.files io.sockets kernel io.streams.duplex math
+math.parser sequences splitting namespaces strings fry ;
 IN: ftp.client
 
-TUPLE: ftp-client host port stream user password mode ;
+TUPLE: ftp-client host port user password mode ;
-TUPLE: ftp-response n strings ;
+TUPLE: ftp-response n strings parsed ;
 
 SINGLETON: active
 SINGLETON: passive
@@ -20,7 +21,7 @@ SINGLETON: passive
         swap >>host
         21 >>port
         "anonymous" >>user
-        "factor-ftp@factorcode.org" >>password ;
+        "ftp@my.org" >>password ;
 
 : add-response-line ( ftp-response string -- ftp-response )
     over strings>> push ;
@@ -31,108 +32,164 @@ SINGLETON: passive
 : ftp-response-code ( string -- n/f )
     dup fourth CHAR: - = [ drop f ] [ (ftp-response-code) ] if ;
 
-: last-code ( ftp-response -- n )
+: read-response-loop ( ftp-response -- ftp-response )
-    strings>> peek (ftp-response-code) ;
+    readln
-
-: read-response-until ( stream ftp-response n -- ftp-response )
-    >r over stream-readln
     [ add-response-line ] [ ftp-response-code ] bi
-    r> tuck = [ drop nip ] [ read-response-until ] if ;
+    over n>> = [ read-response-loop ] unless ;
 
-: read-response ( stream -- ftp-response )
+: read-response ( -- ftp-response )
-    <ftp-response>
+    <ftp-response> readln
-    over stream-readln
+    [ (ftp-response-code) >>n ]
-    [ add-response-line ] [ fourth CHAR: - = ] bi
+    [ add-response-line ]
-    [ dup last-code read-response-until ]
+    [ fourth CHAR: - = ] tri
-    [ nip ] if dup last-code >>n ;
+    [ read-response-loop ] when ;
 
-: ftp-read ( ftp-client -- ftp-response )
+: ftp-send ( string -- )
-    stream>> read-response ;
+    write "\r\n" write flush ;
 
-: ftp-send ( str ftp-client -- )
+: ftp-command ( string -- ftp-response )
-    stream>>
+    ftp-send read-response ;
-    [ stream-write ]
-    [ "\r\n" swap stream-write ]
-    [ stream-flush ] tri ;
-
-: ftp-command ( string ftp-client -- ftp-response )
-    [ ftp-send ] [ ftp-read ] bi ;
 
 : ftp-user ( ftp-client -- ftp-response )
-    [ user>> "USER " prepend ] [ ftp-command ] bi ;
+    user>> "USER " prepend ftp-command ;
 
 : ftp-password ( ftp-client -- ftp-response )
-    [ password>> "PASS " prepend ] [ ftp-command ] bi ;
+    password>> "PASS " prepend ftp-command ;
 
-: ftp-set-binary ( ftp-client -- ftp-response )
+: ftp-set-binary ( -- ftp-response )
-    >r "TYPE I" r> ftp-command ;
+    "TYPE I" ftp-command ;
 
-: ftp-pwd ( ftp-client -- ftp-response )
+: ftp-pwd ( -- ftp-response )
-    >r "PWD" r> ftp-command ;
+    "PWD" ftp-command ;
 
-: ftp-list ( ftp-client -- ftp-response )
+: ftp-list ( -- ftp-response )
-    >r "LIST" r> ftp-command ;
+    "LIST" ftp-command ;
 
-: ftp-quit ( ftp-client -- ftp-response )
+: ftp-quit ( -- ftp-response )
-    >r "QUIT" r> ftp-command ;
+    "QUIT" ftp-command ;
 
-: ftp-cwd ( directory ftp-client -- ftp-response )
+: ftp-cwd ( directory -- ftp-response )
-    >r "CWD " prepend r> ftp-command ;
+    "CWD " prepend ftp-command ;
 
-: ftp-retr ( filename ftp-client -- ftp-response )
+: ftp-retr ( filename -- ftp-response )
-    >r "RETR " prepend r> ftp-command ;
+    "RETR " prepend ftp-command ;
 
 : parse-epsv ( ftp-response -- port )
     strings>> first
     "|" split 2 tail* first string>number ;
 
-: ftp-epsv ( ftp-client -- ftp-response )
+: ch>attribute ( ch -- symbol )
-    >r "EPSV" r> ftp-command ;
+    {
+        { CHAR: d [ +directory+ ] }
+        { CHAR: l [ +symbolic-link+ ] }
+        { CHAR: - [ +regular-file+ ] }
+        [ drop +unknown+ ]
+    } case ;
 
-M: ftp-client dispose ( ftp-client -- )
+TUPLE: remote-file
-    [ ftp-quit drop ] [ stream>> dispose ] bi ;
+    type permissions links owner group size month day time year name ;
+
+: <remote-file> ( -- remote-file ) remote-file new ;
+
+: parse-permissions ( remote-file str -- remote-file )
+    [ first ch>attribute >>type ] [ rest >>permissions ] bi ;
+
+: parse-list-9 ( lines -- seq )
+    [
+        <remote-file> swap {
+            [ 0 swap nth parse-permissions ]
+            [ 1 swap nth string>number >>links ]
+            [ 2 swap nth >>owner ]
+            [ 3 swap nth >>group ]
+            [ 4 swap nth string>number >>size ]
+            [ 5 swap nth >>month ]
+            [ 6 swap nth >>day ]
+            [ 7 swap nth >>time ]
+            [ 8 swap nth >>name ]
+        } cleave
+    ] map ;
+
+: parse-list-8 ( lines -- seq )
+    [
+        <remote-file> swap {
+            [ 0 swap nth parse-permissions ]
+            [ 1 swap nth string>number >>links ]
+            [ 2 swap nth >>owner ]
+            [ 3 swap nth >>size ]
+            [ 4 swap nth >>month ]
+            [ 5 swap nth >>day ]
+            [ 6 swap nth >>time ]
+            [ 7 swap nth >>name ]
+        } cleave
+    ] map ;
+
+: parse-list-3 ( lines -- seq )
+    [
+        <remote-file> swap {
+            [ 0 swap nth parse-permissions ]
+            [ 1 swap nth string>number >>links ]
+            [ 2 swap nth >>name ]
+        } cleave
+    ] map ;
+
+: parse-list ( ftp-response -- ftp-response )
+    dup strings>>
+    [ " " split [ empty? not ] filter ] map
+    dup length {
+        { 9 [ parse-list-9 ] }
+        { 8 [ parse-list-8 ] }
+        { 3 [ parse-list-3 ] }
+        [ drop ]
+    } case >>parsed ;
+
+: ftp-epsv ( -- ftp-response )
+    "EPSV" ftp-command ;
 
 ERROR: ftp-error got expected ;
 : ftp-assert ( ftp-response n -- )
     2dup >r n>> r> = [ 2drop ] [ ftp-error ] if ;
 
-: ftp-connect ( ftp-client -- )
-    dup
-    [ host>> ] [ port>> ] bi <inet> ascii <client>
-    >>stream drop ;
-
 : ftp-login ( ftp-client -- )
-    {
+    read-response 220 ftp-assert
-        [ ftp-connect ]
-        [ ftp-read 220 ftp-assert ]
     [ ftp-user 331 ftp-assert ]
-        [ ftp-password 230 ftp-assert ]
+    [ ftp-password 230 ftp-assert ] bi
-        [ ftp-set-binary 200 ftp-assert ]
+    ftp-set-binary 200 ftp-assert ;
-    } cleave ;
 
-: start-2nd ( ftp-client -- port )
+: open-remote-port ( -- port )
-    ftp-epsv [ 229 ftp-assert ] [ parse-epsv ] bi ;
+    ftp-epsv
+    [ 229 ftp-assert ] [ parse-epsv ] bi ;
 
 : list ( ftp-client -- ftp-response )
-    dup [ host>> ] [ start-2nd ] bi <inet> ascii <client>
+    host>> open-remote-port <inet> ascii <client>
-    over ftp-list 150 ftp-assert
+    ftp-list 150 ftp-assert
-    lines <ftp-response> swap >>strings
+    lines
-    >r ftp-read 226 ftp-assert r> ;
+    <ftp-response> swap >>strings
+    read-response 226 ftp-assert
+    parse-list ;
 
 : ftp-get ( filename ftp-client -- ftp-response )
-    dup [ host>> ] [ start-2nd ] bi <inet> binary <client>
+    host>> open-remote-port <inet> binary <client>
-    rot tuck
+    swap
-    [ over ftp-retr 150 ftp-assert ]
+    [ ftp-retr 150 ftp-assert drop ]
-    [ binary <file-writer> stream-copy ] 2bi*
+    [ binary <file-writer> stream-copy ] 2bi
-    ftp-read dup 226 ftp-assert ;
+    read-response dup 226 ftp-assert ;
+
+: ftp-connect ( ftp-client -- stream )
+    [ host>> ] [ port>> ] bi <inet> ascii <client> ;
 
 GENERIC: ftp-download ( path obj -- )
 
+: with-ftp-client ( ftp-client quot -- )
+    dupd '[
+        , [ ftp-login ] [ @ ] bi
+        ftp-quit drop
+    ] >r ftp-connect r> with-stream ; inline
+
 M: ftp-client ftp-download ( path ftp-client -- )
-    dup ftp-login
+    [
-    [ >r parent-directory r> ftp-cwd drop ]
+        [ drop parent-directory ftp-cwd drop ]
-    [ >r file-name r> ftp-get drop ]
+        [ >r file-name r> ftp-get drop ] 2bi
-    [ dispose drop ] 2tri ;
+    ] with-ftp-client ;
 
 M: string ftp-download ( path string -- )
     <ftp-client> ftp-download ;

extra/io/unix/backend/backend.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien generic assocs kernel kernel.private math
-io.nonblocking sequences strings structs sbufs threads unix.ffi unix
+io.nonblocking sequences strings structs sbufs threads unix
 vectors io.buffers io.backend io.encodings math.parser
 continuations system libc qualified namespaces io.timeouts
 io.encodings.utf8 accessors ;

extra/io/unix/files/files.factor

@@ -45,7 +45,7 @@ M: unix (file-appender) ( path -- stream )
 
 M: unix touch-file ( path -- )
     normalize-path
-    dup exists? [ f utime ] [
+    dup exists? [ touch ] [
         touch-mode file-mode open close
     ] if ;
 

extra/io/unix/kqueue/kqueue.factor

@@ -3,7 +3,7 @@
 USING: alien.c-types kernel math math.bitfields namespaces
 locals accessors combinators threads vectors hashtables
 sequences assocs continuations sets
-unix.ffi unix unix.time unix.kqueue unix.process
+unix unix.time unix.kqueue unix.process
 io.nonblocking io.unix.backend io.launcher io.unix.launcher
 io.monitors ;
 IN: io.unix.kqueue

extra/io/unix/sockets/sockets.factor

@@ -5,7 +5,7 @@ namespaces threads sequences byte-arrays io.nonblocking
 io.binary io.unix.backend io.streams.duplex io.sockets.impl
 io.backend io.files io.files.private io.encodings.utf8
 math.parser continuations libc combinators system accessors
-destructors qualified unix.ffi unix ;
+qualified unix ;
 
 EXCLUDE: io => read write close ;
 EXCLUDE: io.sockets => accept ;
@@ -62,14 +62,11 @@ TUPLE: accept-task < input-task ;
     accept-task <io-task> ;
 
 : accept-sockaddr ( port -- fd sockaddr )
-    dup port-handle swap server-port-addr sockaddr-type
+    [ handle>> ] [ addr>> sockaddr-type ] bi
     dup <c-object> [ swap heap-size <int> accept ] keep ; inline
 
 : do-accept ( port fd sockaddr -- )
-    rot
+    swapd over addr>> parse-sockaddr >>client-addr (>>client) ;
-    [ server-port-addr parse-sockaddr ] keep
-    [ set-server-port-client-addr ] keep
-    set-server-port-client ;
 
 M: accept-task do-io-task
     io-task-port dup accept-sockaddr

extra/unix/ffi/ffi.factor

@@ -1,15 +0,0 @@
-
-USING: alien.syntax ;
-
-IN: unix.ffi
-
-FUNCTION: int open ( char* path, int flags, int prot ) ;
-
-C-STRUCT: utimbuf
-    { "time_t" "actime"  }
-    { "time_t" "modtime" } ;
-
-FUNCTION: int utime ( char* path, utimebuf* buf ) ;
-
-FUNCTION: int err_no ( ) ;
-FUNCTION: char* strerror ( int errno ) ;

extra/unix/system-call/system-call.factor

@@ -1,15 +0,0 @@
-
-USING: kernel continuations sequences math accessors inference macros
-       fry arrays.lib unix.ffi ;
-
-IN: unix.system-call
-
-ERROR: unix-system-call-error word args message ;
-
-MACRO: unix-system-call ( quot -- )
-    [ ] [ infer in>> ] [ first ] tri
-   '[
-        [ @ dup 0 < [ dup throw ] [ ] if ]
-        [ drop , narray , swap err_no strerror unix-system-call-error ]
-        recover
-    ] ;

extra/unix/unix.factor

@@ -1,11 +1,11 @@
 ! Copyright (C) 2005, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 
-USING: alien alien.c-types alien.syntax kernel libc structs
+USING: alien alien.c-types alien.syntax kernel libc structs sequences
+       continuations
        math namespaces system combinators vocabs.loader qualified
-       unix.ffi unix.types unix.system-call ;
+       accessors inference macros fry arrays.lib 
-
+       unix.types ;
-QUALIFIED: unix.ffi
 
 IN: unix
 
@@ -45,9 +45,22 @@ C-STRUCT: passwd
     { "time_t" "pw_expire" }
     { "int"    "pw_fields" } ;
 
-! ! ! Unix functions
 LIBRARY: factor
+
 FUNCTION: void clear_err_no ( ) ;
+FUNCTION: int err_no ( ) ;
+
+ERROR: unix-system-call-error word args message ;
+
+DEFER: strerror
+
+MACRO: unix-system-call ( quot -- )
+    [ ] [ infer in>> ] [ first ] tri
+   '[
+        [ @ dup 0 < [ dup throw ] [ ] if ]
+        [ drop , narray , swap err_no strerror unix-system-call-error ]
+        recover
+    ] ;
 
 LIBRARY: libc
 
@@ -86,6 +99,7 @@ FUNCTION: int getgrnam_r ( char* name, group* grp, char* buffer, size_t bufsize,
 FUNCTION: int getpwnam_r ( char* login, passwd* pwd, char* buffer, size_t bufsize, passwd** result ) ;
 FUNCTION: int getgroups ( int gidsetlen, gid_t* gidset ) ;
 FUNCTION: int gethostname ( char* name, int len ) ;
+FUNCTION: int getsockname ( int socket, sockaddr* address, socklen_t* address_len ) ;
 FUNCTION: uid_t getuid ;
 FUNCTION: uint htonl ( uint n ) ;
 FUNCTION: ushort htons ( ushort n ) ;
@@ -99,9 +113,23 @@ FUNCTION: int munmap ( void* addr, size_t len ) ;
 FUNCTION: uint ntohl ( uint n ) ;
 FUNCTION: ushort ntohs ( ushort n ) ;
 
-: open ( path flags prot -- int ) [ unix.ffi:open ] unix-system-call ;
+FUNCTION: int open ( char* path, int flags, int prot ) ;
 
-: utime ( path buf -- ) [ unix.ffi:utime ] unix-system-call drop ;
+: open-file ( path flags mode -- fd ) [ open ] unix-system-call ;
+
+C-STRUCT: utimbuf
+    { "time_t" "actime"  }
+    { "time_t" "modtime" } ;
+
+FUNCTION: int utime ( char* path, utimebuf* buf ) ;
+
+: touch ( filename -- ) f [ utime ] unix-system-call drop ;
+
+: change-file-times ( filename access modification -- )
+    "utimebuf" <c-object>
+    tuck set-utimbuf-modtime
+    tuck set-utimbuf-actime
+    [ utime ] unix-system-call drop ;
 
 FUNCTION: int pclose ( void* file ) ;
 FUNCTION: int pipe ( int* filedes ) ;
@@ -123,6 +151,7 @@ FUNCTION: int setreuid ( uid_t ruid, uid_t euid ) ;
 FUNCTION: int setsockopt ( int s, int level, int optname, void* optval, socklen_t optlen ) ;
 FUNCTION: int setuid ( uid_t uid ) ;
 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 ) ;