diff --git a/extra/hexdump/authors.txt b/basis/io/files/listing/authors.txt similarity index 100% rename from extra/hexdump/authors.txt rename to basis/io/files/listing/authors.txt diff --git a/basis/io/files/listing/listing-tests.factor b/basis/io/files/listing/listing-tests.factor new file mode 100644 index 0000000000..a2347c8db9 --- /dev/null +++ b/basis/io/files/listing/listing-tests.factor @@ -0,0 +1,6 @@ +! Copyright (C) 2008 Your name. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test io.files.listing strings kernel ; +IN: io.files.listing.tests + +[ ] [ "" directory. ] unit-test diff --git a/basis/io/files/listing/listing.factor b/basis/io/files/listing/listing.factor new file mode 100755 index 0000000000..a740b2b7be --- /dev/null +++ b/basis/io/files/listing/listing.factor @@ -0,0 +1,35 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays combinators io io.files kernel +math.parser sequences system vocabs.loader calendar ; + +IN: io.files.listing + +: ls-time ( timestamp -- string ) + [ hour>> ] [ minute>> ] bi + [ number>string 2 CHAR: 0 pad-left ] bi@ ":" swap 3append ; + +: ls-timestamp ( timestamp -- string ) + [ month>> month-abbreviation ] + [ day>> number>string 2 CHAR: \s pad-left ] + [ + dup year>> dup now year>> = + [ drop ls-time ] [ nip number>string ] if + 5 CHAR: \s pad-left + ] tri 3array " " join ; + +: read>string ( ? -- string ) "r" "-" ? ; inline + +: write>string ( ? -- string ) "w" "-" ? ; inline + +: execute>string ( ? -- string ) "x" "-" ? ; inline + +HOOK: (directory.) os ( path -- lines ) + +: directory. ( path -- ) + [ (directory.) ] with-directory-files [ print ] each ; + +{ + { [ os unix? ] [ "io.files.listing.unix" ] } + { [ os windows? ] [ "io.files.listing.windows" ] } +} cond require diff --git a/basis/io/files/listing/tags.txt b/basis/io/files/listing/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/files/listing/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/files/listing/unix/authors.txt b/basis/io/files/listing/unix/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/io/files/listing/unix/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/basis/io/files/listing/unix/tags.txt b/basis/io/files/listing/unix/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/files/listing/unix/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/files/listing/unix/unix.factor b/basis/io/files/listing/unix/unix.factor new file mode 100755 index 0000000000..f024b1238e --- /dev/null +++ b/basis/io/files/listing/unix/unix.factor @@ -0,0 +1,43 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors combinators kernel system unicode.case +io.unix.files io.files.listing generalizations strings +arrays sequences io.files math.parser unix.groups unix.users ; +IN: io.files.listing.unix + +: unix-execute>string ( str bools -- str' ) + swap { + { { t t } [ >lower ] } + { { t f } [ >upper ] } + { { f t } [ drop "x" ] } + [ 2drop "-" ] + } case ; + +: permissions-string ( permissions -- str ) + { + [ type>> file-type>ch 1string ] + [ user-read? read>string ] + [ user-write? write>string ] + [ [ uid? ] [ user-execute? ] bi 2array "s" unix-execute>string ] + [ group-read? read>string ] + [ group-write? write>string ] + [ [ gid? ] [ group-execute? ] bi 2array "s" unix-execute>string ] + [ other-read? read>string ] + [ other-write? write>string ] + [ [ sticky? ] [ other-execute? ] bi 2array "t" unix-execute>string ] + } cleave 10 narray concat ; + +M: unix (directory.) ( path -- lines ) + [ [ + [ + dup file-info + { + [ permissions-string ] + [ nlink>> number>string 3 CHAR: \s pad-left ] + ! [ uid>> ] + ! [ gid>> ] + [ size>> number>string 15 CHAR: \s pad-left ] + [ modified>> ls-timestamp ] + } cleave 4 narray swap suffix " " join + ] map + ] with-group-cache ] with-user-cache ; diff --git a/basis/io/files/listing/windows/authors.txt b/basis/io/files/listing/windows/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/io/files/listing/windows/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/basis/io/files/listing/windows/tags.txt b/basis/io/files/listing/windows/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/files/listing/windows/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/files/listing/windows/windows.factor b/basis/io/files/listing/windows/windows.factor new file mode 100755 index 0000000000..53481fc7f8 --- /dev/null +++ b/basis/io/files/listing/windows/windows.factor @@ -0,0 +1,21 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors calendar.format combinators io.files +kernel math.parser sequences splitting system io.files.listing +generalizations ; +IN: io.files.listing.windows + +: directory-or-size ( file-info -- str ) + dup directory? [ + drop "" 20 CHAR: \s pad-right + ] [ + size>> number>string 20 CHAR: \s pad-left + ] if ; + +M: windows (directory.) ( entries -- lines ) + [ + dup file-info { + [ modified>> timestamp>ymdhms ] + [ directory-or-size ] + } cleave 2 narray swap suffix " " join + ] map ; diff --git a/basis/io/unix/files/files.factor b/basis/io/unix/files/files.factor index 9ebfdaaa5a..3f254e7713 100644 --- a/basis/io/unix/files/files.factor +++ b/basis/io/unix/files/files.factor @@ -172,6 +172,30 @@ M: unix (directory-entries) ( path -- seq ) PRIVATE> +: ch>file-type ( ch -- type ) + { + { CHAR: b [ +block-device+ ] } + { CHAR: c [ +character-device+ ] } + { CHAR: d [ +directory+ ] } + { CHAR: l [ +symbolic-link+ ] } + { CHAR: s [ +socket+ ] } + { CHAR: p [ +fifo+ ] } + { CHAR: - [ +regular-file+ ] } + [ drop +unknown+ ] + } case ; + +: file-type>ch ( type -- string ) + { + { +block-device+ [ CHAR: b ] } + { +character-device+ [ CHAR: c ] } + { +directory+ [ CHAR: d ] } + { +symbolic-link+ [ CHAR: l ] } + { +socket+ [ CHAR: s ] } + { +fifo+ [ CHAR: p ] } + { +regular-file+ [ CHAR: - ] } + [ drop CHAR: - ] + } case ; + : UID OCT: 0004000 ; inline : GID OCT: 0002000 ; inline : STICKY OCT: 0001000 ; inline diff --git a/basis/io/windows/files/files.factor b/basis/io/windows/files/files.factor index e3b96b98d8..d0409ce59a 100755 --- a/basis/io/windows/files/files.factor +++ b/basis/io/windows/files/files.factor @@ -149,35 +149,39 @@ SYMBOLS: +read-only+ +hidden+ +system+ +sparse-file+ +reparse-point+ +compressed+ +offline+ +not-content-indexed+ +encrypted+ ; -: win32-file-attribute ( n attr symbol -- n ) - >r dupd mask? r> swap [ , ] [ drop ] if ; +TUPLE: windows-file-info < file-info attributes ; + +: win32-file-attribute ( n attr symbol -- ) + rot mask? [ , ] [ drop ] if ; : win32-file-attributes ( n -- seq ) [ - FILE_ATTRIBUTE_READONLY +read-only+ win32-file-attribute - FILE_ATTRIBUTE_HIDDEN +hidden+ win32-file-attribute - FILE_ATTRIBUTE_SYSTEM +system+ win32-file-attribute - FILE_ATTRIBUTE_DIRECTORY +directory+ win32-file-attribute - FILE_ATTRIBUTE_ARCHIVE +archive+ win32-file-attribute - FILE_ATTRIBUTE_DEVICE +device+ win32-file-attribute - FILE_ATTRIBUTE_NORMAL +normal+ win32-file-attribute - FILE_ATTRIBUTE_TEMPORARY +temporary+ win32-file-attribute - FILE_ATTRIBUTE_SPARSE_FILE +sparse-file+ win32-file-attribute - FILE_ATTRIBUTE_REPARSE_POINT +reparse-point+ win32-file-attribute - FILE_ATTRIBUTE_COMPRESSED +compressed+ win32-file-attribute - FILE_ATTRIBUTE_OFFLINE +offline+ win32-file-attribute - FILE_ATTRIBUTE_NOT_CONTENT_INDEXED +not-content-indexed+ win32-file-attribute - FILE_ATTRIBUTE_ENCRYPTED +encrypted+ win32-file-attribute - drop + { + [ +read-only+ FILE_ATTRIBUTE_READONLY win32-file-attribute ] + [ +hidden+ FILE_ATTRIBUTE_HIDDEN win32-file-attribute ] + [ +system+ FILE_ATTRIBUTE_SYSTEM win32-file-attribute ] + [ +directory+ FILE_ATTRIBUTE_DIRECTORY win32-file-attribute ] + [ +archive+ FILE_ATTRIBUTE_ARCHIVE win32-file-attribute ] + [ +device+ FILE_ATTRIBUTE_DEVICE win32-file-attribute ] + [ +normal+ FILE_ATTRIBUTE_NORMAL win32-file-attribute ] + [ +temporary+ FILE_ATTRIBUTE_TEMPORARY win32-file-attribute ] + [ +sparse-file+ FILE_ATTRIBUTE_SPARSE_FILE win32-file-attribute ] + [ +reparse-point+ FILE_ATTRIBUTE_REPARSE_POINT win32-file-attribute ] + [ +compressed+ FILE_ATTRIBUTE_COMPRESSED win32-file-attribute ] + [ +offline+ FILE_ATTRIBUTE_OFFLINE win32-file-attribute ] + [ +not-content-indexed+ FILE_ATTRIBUTE_NOT_CONTENT_INDEXED win32-file-attribute ] + [ +encrypted+ FILE_ATTRIBUTE_ENCRYPTED win32-file-attribute ] + } cleave ] { } make ; : win32-file-type ( n -- symbol ) FILE_ATTRIBUTE_DIRECTORY mask? +directory+ +regular-file+ ? ; : WIN32_FIND_DATA>file-info ( WIN32_FIND_DATA -- file-info ) - [ \ file-info new ] dip + [ \ windows-file-info new ] dip { [ WIN32_FIND_DATA-dwFileAttributes win32-file-type >>type ] + [ WIN32_FIND_DATA-dwFileAttributes win32-file-attributes >>attributes ] [ [ WIN32_FIND_DATA-nFileSizeLow ] [ WIN32_FIND_DATA-nFileSizeHigh ] bi >64bit >>size @@ -196,9 +200,10 @@ SYMBOLS: +read-only+ +hidden+ +system+ ] keep ; : BY_HANDLE_FILE_INFORMATION>file-info ( HANDLE_FILE_INFORMATION -- file-info ) - [ \ file-info new ] dip + [ \ windows-file-info new ] dip { [ BY_HANDLE_FILE_INFORMATION-dwFileAttributes win32-file-type >>type ] + [ BY_HANDLE_FILE_INFORMATION-dwFileAttributes win32-file-attributes >>attributes ] [ [ BY_HANDLE_FILE_INFORMATION-nFileSizeLow ] [ BY_HANDLE_FILE_INFORMATION-nFileSizeHigh ] bi >64bit >>size diff --git a/basis/tools/hexdump/authors.txt b/basis/tools/hexdump/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/tools/hexdump/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/hexdump/hexdump-docs.factor b/basis/tools/hexdump/hexdump-docs.factor similarity index 79% rename from extra/hexdump/hexdump-docs.factor rename to basis/tools/hexdump/hexdump-docs.factor index 4278e92f0e..9579fb7f81 100644 --- a/extra/hexdump/hexdump-docs.factor +++ b/basis/tools/hexdump/hexdump-docs.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: help.markup help.syntax kernel sequences strings ; -IN: hexdump +IN: tools.hexdump HELP: hexdump. { $values { "seq" sequence } } @@ -12,11 +12,11 @@ HELP: hexdump { $description "Converts a sequence to its hexadecimal and ASCII representation sixteen characters at a time. Lines are separated by a newline character." } { $see-also hexdump. } ; -ARTICLE: "hexdump" "Hexdump" -"The " { $vocab-link "hexdump" } " vocabulary provides a traditional hexdump view of a sequence." $nl +ARTICLE: "tools.hexdump" "Hexdump" +"The " { $vocab-link "tools.hexdump" } " vocabulary provides a traditional hexdump view of a sequence." $nl "Write hexdump to string:" { $subsection hexdump } "Write the hexdump to the output stream:" { $subsection hexdump. } ; -ABOUT: "hexdump" +ABOUT: "tools.hexdump" diff --git a/extra/hexdump/hexdump-tests.factor b/basis/tools/hexdump/hexdump-tests.factor similarity index 95% rename from extra/hexdump/hexdump-tests.factor rename to basis/tools/hexdump/hexdump-tests.factor index b3c03196f5..7202e4402c 100644 --- a/extra/hexdump/hexdump-tests.factor +++ b/basis/tools/hexdump/hexdump-tests.factor @@ -1,5 +1,5 @@ -IN: hexdump.tests -USING: hexdump kernel sequences tools.test ; +USING: tools.hexdump kernel sequences tools.test ; +IN: tools.hexdump.tests [ t ] [ "" hexdump "Length: 0, 0h\n" = ] unit-test [ t ] [ "abcdefghijklmnopqrstuvwxyz" hexdump "Length: 26, 1ah\n00000000h: 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 abcdefghijklmnop\n00000010h: 71 72 73 74 75 76 77 78 79 7a qrstuvwxyz\n" = ] unit-test diff --git a/extra/hexdump/hexdump.factor b/basis/tools/hexdump/hexdump.factor similarity index 98% rename from extra/hexdump/hexdump.factor rename to basis/tools/hexdump/hexdump.factor index ecbc2d6169..c8b9f4accc 100644 --- a/extra/hexdump/hexdump.factor +++ b/basis/tools/hexdump/hexdump.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: arrays io io.streams.string kernel math math.parser namespaces sequences splitting grouping strings ascii ; -IN: hexdump +IN: tools.hexdump > push ; : ftp-send ( string -- ) write "\r\n" write flush ; - : ftp-ipv4 1 ; inline : ftp-ipv6 2 ; inline -: ch>type ( ch -- type ) - { - { CHAR: d [ +directory+ ] } - { CHAR: l [ +symbolic-link+ ] } - { CHAR: - [ +regular-file+ ] } - [ drop +unknown+ ] - } case ; - -: type>ch ( type -- string ) - { - { +directory+ [ CHAR: d ] } - { +symbolic-link+ [ CHAR: l ] } - { +regular-file+ [ CHAR: - ] } - [ drop CHAR: - ] - } case ; - -: file-info>string ( file-info name -- string ) - [ - [ - [ 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 - [ [ link-info ] keep file-info>string ] map ; +: directory-list ( -- seq ) "" ls ; diff --git a/extra/ftp/server/server.factor b/extra/ftp/server/server.factor index 170155bd43..e40af2afbe 100644 --- a/extra/ftp/server/server.factor +++ b/extra/ftp/server/server.factor @@ -6,12 +6,16 @@ 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 sequences.lib -hexdump ; +continuations math concurrency.promises byte-arrays +io.backend sequences.lib tools.hexdump ; IN: ftp.server SYMBOL: client +: ftp-server-directory ( -- str ) + \ ftp-server-directory get-global "resource:temp" or + normalize-path ; + TUPLE: ftp-command raw tokenized ; : ( -- obj ) @@ -238,10 +242,16 @@ M: ftp-put service-command ( stream obj -- ) ! : handle-LPRT ( obj -- ) tokenized>> "," split ; ERROR: not-a-directory ; +ERROR: no-permissions ; : handle-CWD ( obj -- ) [ - tokenized>> second dup directory? [ + tokenized>> second dup normalize-path + dup ftp-server-directory head? [ + no-permissions + ] unless + + file-info directory? [ set-current-directory 250 "Directory successully changed." server-response ] [ @@ -256,6 +266,7 @@ ERROR: not-a-directory ; : handle-client-loop ( -- ) readln + USE: prettyprint global [ dup . flush ] bind [ >>raw ] [ tokenize-command >>tokenized ] bi dup tokenized>> first >upper { @@ -313,7 +324,7 @@ TUPLE: ftp-server < threaded-server ; M: ftp-server handle-client* ( server -- ) drop [ - "" [ + ftp-server-directory [ host-name client set send-banner handle-client-loop ] with-directory @@ -323,6 +334,7 @@ M: ftp-server handle-client* ( server -- ) ftp-server new-threaded-server swap >>insecure "ftp.server" >>name + 5 minutes >>timeout latin1 >>encoding ; : ftpd ( port -- ) diff --git a/extra/tar/tar.factor b/extra/tar/tar.factor index 286ac0183a..e3c14854d3 100755 --- a/extra/tar/tar.factor +++ b/extra/tar/tar.factor @@ -1,6 +1,6 @@ USING: combinators io io.files io.streams.string kernel math math.parser continuations namespaces pack prettyprint sequences -strings system hexdump io.encodings.binary summary accessors +strings system tools.hexdump io.encodings.binary summary accessors io.backend symbols byte-arrays ; IN: tar