From f5f6c400db70d983424211a8dfec79f1dbe4d167 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 19 Oct 2008 18:19:15 -0500 Subject: [PATCH 01/14] change windows file-system-info implementation --- basis/io/windows/files/files.factor | 9 ++++++--- basis/io/windows/nt/files/files.factor | 5 +++-- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/basis/io/windows/files/files.factor b/basis/io/windows/files/files.factor index e4fe0fbc63..80caf5222f 100644 --- a/basis/io/windows/files/files.factor +++ b/basis/io/windows/files/files.factor @@ -246,12 +246,14 @@ M: winnt file-info ( path -- info ) M: winnt link-info ( path -- info ) file-info ; +HOOK: root-directory os ( string -- string' ) + TUPLE: winnt-file-system-info < file-system-info total-bytes total-free-bytes ; M: winnt file-system-info ( path -- file-system-info ) - normalize-path - dup file-info directory? [ parent-directory ] unless + normalize-path root-directory + dup "ULARGE_INTEGER" "ULARGE_INTEGER" "ULARGE_INTEGER" @@ -259,7 +261,8 @@ M: winnt file-system-info ( path -- file-system-info ) \ winnt-file-system-info new swap *ulonglong >>total-free-bytes swap *ulonglong >>total-bytes - swap *ulonglong >>free-space ; + swap *ulonglong >>free-space + swap "\\\\?\\" ?head drop root-directory >>name ; : file-times ( path -- timestamp timestamp timestamp ) [ diff --git a/basis/io/windows/nt/files/files.factor b/basis/io/windows/nt/files/files.factor index 9b77a9f128..2fbc809263 100644 --- a/basis/io/windows/nt/files/files.factor +++ b/basis/io/windows/nt/files/files.factor @@ -31,12 +31,13 @@ M: winnt root-directory? ( path -- ? ) ERROR: not-absolute-path ; -: root-directory ( string -- string' ) +M: winnt root-directory ( string -- string' ) + unicode-prefix ?head drop dup { [ length 2 >= ] [ second CHAR: : = ] [ first Letter? ] - } 1&& [ 2 head ] [ not-absolute-path ] if ; + } 1&& [ 2 head "\\" append ] [ not-absolute-path ] if ; : prepend-prefix ( string -- string' ) dup unicode-prefix head? [ From b2ef848df497436d3807515ae84613c77fd57f3e Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 22 Oct 2008 09:54:59 -0500 Subject: [PATCH 02/14] Add 'dns.resolver' --- extra/dns/resolver/resolver.factor | 66 ++++++++++++++++++++++++++++++ 1 file changed, 66 insertions(+) create mode 100644 extra/dns/resolver/resolver.factor diff --git a/extra/dns/resolver/resolver.factor b/extra/dns/resolver/resolver.factor new file mode 100644 index 0000000000..dff1afbb18 --- /dev/null +++ b/extra/dns/resolver/resolver.factor @@ -0,0 +1,66 @@ + +USING: kernel accessors namespaces continuations + io io.sockets io.binary io.timeouts io.encodings.binary + destructors + locals strings sequences random prettyprint calendar dns ; + +IN: dns.resolver + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: send-receive-udp ( BA SERVER -- ba ) + T{ inet4 f f 0 } + T{ duration { second 3 } } over set-timeout + [| SOCKET | BA SERVER SOCKET send SOCKET receive drop ] + with-disposal ; + +:: send-receive-tcp ( BA SERVER -- ba ) + [let | BA [ BA length 2 >be BA append ] | + SERVER binary + [ + T{ duration { second 3 } } input-stream get set-timeout + BA write flush 2 read be> read + ] + with-client ] ; + +:: send-receive-server ( BA SERVER -- msg ) + [let | RESULT [ BA SERVER send-receive-udp parse-message ] | + RESULT tc>> 1 = + [ BA SERVER send-receive-tcp parse-message ] + [ RESULT ] + if ] ; + +: >dns-inet4 ( obj -- inet4 ) dup string? [ 53 ] [ ] if ; + +:: send-receive-servers ( BA SERVERS -- msg ) + SERVERS empty? [ "send-receive-servers: servers list empty" throw ] when + [let | SERVER [ SERVERS random >dns-inet4 ] | + ! if this throws an error ... + [ BA SERVER send-receive-server ] + ! we try with the other servers... + [ drop BA SERVER SERVERS remove send-receive-servers ] + recover ] ; + +:: ask-servers ( MSG SERVERS -- msg ) + MSG message->ba SERVERS send-receive-servers ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: fully-qualified ( name -- name ) dup "." tail? [ ] [ "." append ] if ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: dns-servers ( -- seq ) \ dns-servers get ; + +! : dns-server ( -- server ) dns-servers random ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: dns-ip ( name -- ips ) + fully-qualified + [let | MSG [ A IN query boa query->message dns-servers ask-servers ] | + MSG rcode>> NO-ERROR = + [ MSG answer-section>> [ type>> A = ] filter [ rdata>> ] map ] + [ "dns-ip: rcode = " MSG rcode>> unparse append throw ] + if ] ; + From 92abf2825660adaafcc0efe21d8dd1c11389ac2d Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 22 Oct 2008 10:21:36 -0500 Subject: [PATCH 03/14] dns.resolver: use 'resolv.conf' servers by default --- extra/dns/resolver/resolver.factor | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/extra/dns/resolver/resolver.factor b/extra/dns/resolver/resolver.factor index dff1afbb18..f7983965d5 100644 --- a/extra/dns/resolver/resolver.factor +++ b/extra/dns/resolver/resolver.factor @@ -2,7 +2,7 @@ USING: kernel accessors namespaces continuations io io.sockets io.binary io.timeouts io.encodings.binary destructors - locals strings sequences random prettyprint calendar dns ; + locals strings sequences random prettyprint calendar dns dns.misc ; IN: dns.resolver @@ -50,7 +50,11 @@ IN: dns.resolver ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: dns-servers ( -- seq ) \ dns-servers get ; +: dns-servers ( -- seq ) + \ dns-servers get + [ ] + [ resolv-conf-servers \ dns-servers set dns-servers ] + if* ; ! : dns-server ( -- server ) dns-servers random ; From 371b1f8f206d44a82815cf0e3cff6f17d49d2a82 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 22 Oct 2008 18:46:24 -0500 Subject: [PATCH 04/14] fix mounted on macosx --- basis/unix/statfs/macosx/macosx.factor | 3 +++ basis/unix/statfs/statfs.factor | 5 ++--- basis/unix/types/types.factor | 18 +++++++++--------- basis/unix/unix.factor | 7 +++++++ 4 files changed, 21 insertions(+), 12 deletions(-) diff --git a/basis/unix/statfs/macosx/macosx.factor b/basis/unix/statfs/macosx/macosx.factor index 4bd9f55132..048c292cea 100644 --- a/basis/unix/statfs/macosx/macosx.factor +++ b/basis/unix/statfs/macosx/macosx.factor @@ -128,6 +128,9 @@ M: macosx mounted* ( -- array ) [ *void* ] dip "statfs64" heap-size [ * memory>byte-array ] keep group ; +M: macosx >mounted + >file-system-info ; + M: macosx >file-system-info ( byte-array -- file-system-info ) [ \ macosx-file-system-info new ] dip { diff --git a/basis/unix/statfs/statfs.factor b/basis/unix/statfs/statfs.factor index f00ffe77cd..9aef2246c0 100644 --- a/basis/unix/statfs/statfs.factor +++ b/basis/unix/statfs/statfs.factor @@ -10,14 +10,13 @@ flags filesystem-subtype file-system-type-name mount-on mount-from ; HOOK: mounted* os ( -- array ) -HOOK: mounted-struct>mounted os ( byte-array -- mounted ) +HOOK: >mounted os ( byte-array -- mounted ) TUPLE: file-system-info root-directory total-free-size total-size ; HOOK: >file-system-info os ( struct -- statfs ) -: mounted ( -- array ) - mounted* [ mounted-struct>mounted ] map ; +: mounted ( -- array ) mounted* [ >mounted ] map ; : mounted-drive ( path -- mounted/f ) mounted diff --git a/basis/unix/types/types.factor b/basis/unix/types/types.factor index 51db6f5da0..65845874b1 100644 --- a/basis/unix/types/types.factor +++ b/basis/unix/types/types.factor @@ -2,15 +2,6 @@ USING: kernel system alien.syntax combinators vocabs.loader system ; IN: unix.types -TYPEDEF: void* caddr_t -TYPEDEF: uint in_addr_t -TYPEDEF: uint socklen_t - -TYPEDEF: __uint64_t fsblkcnt_t -TYPEDEF: fsblkcnt_t __fsblkcnt_t -TYPEDEF: __uint64_t fsfilcnt_t -TYPEDEF: fsfilcnt_t __fsfilcnt_t - TYPEDEF: char int8_t TYPEDEF: short int16_t TYPEDEF: int int32_t @@ -36,6 +27,15 @@ TYPEDEF: ushort __uint16_t TYPEDEF: uint __uint32_t TYPEDEF: ulonglong __uint64_t +TYPEDEF: void* caddr_t +TYPEDEF: uint in_addr_t +TYPEDEF: uint socklen_t + +TYPEDEF: __uint64_t fsblkcnt_t +TYPEDEF: fsblkcnt_t __fsblkcnt_t +TYPEDEF: __uint64_t fsfilcnt_t +TYPEDEF: fsfilcnt_t __fsfilcnt_t +TYPEDEF: __uint64_t rlim_t os { { linux [ "unix.types.linux" require ] } diff --git a/basis/unix/unix.factor b/basis/unix/unix.factor index 2fcb83dc2c..4950daef2c 100644 --- a/basis/unix/unix.factor +++ b/basis/unix/unix.factor @@ -116,6 +116,13 @@ FUNCTION: passwd* getpwnam ( char* login ) ; 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 getgrouplist ( char* name, int basegid, int* groups, int* ngroups ) ; +FUNCTION: int getrlimit ( int resource, rlimit* rlp ) ; +FUNCTION: int setrlimit ( int resource, rlimit* rlp ) ; + +FUNCTION: int getpriority ( int which, id_t who ) ; +FUNCTION: int setpriority ( int which, id_t who, int prio ) ; + +FUNCTION: int getrusage ( int who, rusage* r_usage ) ; FUNCTION: group* getgrent ; FUNCTION: int gethostname ( char* name, int len ) ; From f9b90d035b8c7dcb263d590abf37534f860b99d0 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 22 Oct 2008 19:01:45 -0500 Subject: [PATCH 05/14] implement mounted on linux --- basis/unix/statfs/linux/linux.factor | 24 ++++++++++++++++++++++++ basis/unix/statfs/macosx/macosx.factor | 3 --- basis/unix/statfs/statfs.factor | 2 +- 3 files changed, 25 insertions(+), 4 deletions(-) diff --git a/basis/unix/statfs/linux/linux.factor b/basis/unix/statfs/linux/linux.factor index b4413fba15..94ed8cb8cf 100644 --- a/basis/unix/statfs/linux/linux.factor +++ b/basis/unix/statfs/linux/linux.factor @@ -8,3 +8,27 @@ cell-bits { { 32 [ "unix.statfs.linux.32" require ] } { 64 [ "unix.statfs.linux.64" require ] } } case + +TUPLE: mtab-entry file-system-name mount-point type options +frequency pass-number ; + +: mtab-csv>mtab-entry ( csv -- mtab-entry ) + [ mtab-entry new ] dip + { + [ first >>file-system-name ] + [ second >>mount-point ] + [ third >>type ] + [ fourth csv first >>options ] + [ 4 swap nth >>frequency ] + [ 5 swap nth >>pass-number ] + } cleave ; + +: parse-mtab ( -- array ) + [ + "/etc/mtab" utf8 + CHAR: \s delimiter set csv + ] with-scope + [ mtab-csv>mtab-entry ] map ; + +M: linux mounted* + parse-mtab [ mount-point>> >file-system-info ] map ; diff --git a/basis/unix/statfs/macosx/macosx.factor b/basis/unix/statfs/macosx/macosx.factor index 048c292cea..4bd9f55132 100644 --- a/basis/unix/statfs/macosx/macosx.factor +++ b/basis/unix/statfs/macosx/macosx.factor @@ -128,9 +128,6 @@ M: macosx mounted* ( -- array ) [ *void* ] dip "statfs64" heap-size [ * memory>byte-array ] keep group ; -M: macosx >mounted - >file-system-info ; - M: macosx >file-system-info ( byte-array -- file-system-info ) [ \ macosx-file-system-info new ] dip { diff --git a/basis/unix/statfs/statfs.factor b/basis/unix/statfs/statfs.factor index 9aef2246c0..cfa0c159d1 100644 --- a/basis/unix/statfs/statfs.factor +++ b/basis/unix/statfs/statfs.factor @@ -16,7 +16,7 @@ TUPLE: file-system-info root-directory total-free-size total-size ; HOOK: >file-system-info os ( struct -- statfs ) -: mounted ( -- array ) mounted* [ >mounted ] map ; +: mounted ( -- array ) mounted* [ >file-system-info ] map ; : mounted-drive ( path -- mounted/f ) mounted From b4b02d29fad5bd10e1cf2eb097721f531d7572df Mon Sep 17 00:00:00 2001 From: erg Date: Wed, 22 Oct 2008 19:54:22 -0500 Subject: [PATCH 06/14] fix mounted on linux --- basis/unix/statfs/linux/32/32.factor | 4 ++-- basis/unix/statfs/linux/linux.factor | 8 +++++--- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/basis/unix/statfs/linux/32/32.factor b/basis/unix/statfs/linux/32/32.factor index c6ec0bc658..6658d5942d 100644 --- a/basis/unix/statfs/linux/32/32.factor +++ b/basis/unix/statfs/linux/32/32.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types combinators kernel io.files unix.stat +USING: alien.c-types combinators kernel unix.stat math accessors system unix io.backend layouts vocabs.loader -alien.syntax ; +alien.syntax unix.statfs io.files ; IN: unix.statfs.linux C-STRUCT: statfs diff --git a/basis/unix/statfs/linux/linux.factor b/basis/unix/statfs/linux/linux.factor index 94ed8cb8cf..6f4b1d619d 100644 --- a/basis/unix/statfs/linux/linux.factor +++ b/basis/unix/statfs/linux/linux.factor @@ -1,7 +1,9 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: alien.c-types combinators kernel io.files unix.stat -math accessors system unix io.backend layouts vocabs.loader ; +math accessors system unix io.backend layouts vocabs.loader +sequences csv io.streams.string io.encodings.utf8 namespaces +unix.statfs io.files ; IN: unix.statfs.linux cell-bits { @@ -30,5 +32,5 @@ frequency pass-number ; ] with-scope [ mtab-csv>mtab-entry ] map ; -M: linux mounted* - parse-mtab [ mount-point>> >file-system-info ] map ; +M: linux mounted + parse-mtab [ mount-point>> file-system-info ] map ; From 89e9fa8b6bdd1c994a0e64a2bd7534aff1039354 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 22 Oct 2008 19:56:46 -0500 Subject: [PATCH 07/14] mounted* -> mounted --- basis/unix/statfs/macosx/macosx.factor | 5 +++-- basis/unix/statfs/statfs.factor | 10 +--------- 2 files changed, 4 insertions(+), 11 deletions(-) diff --git a/basis/unix/statfs/macosx/macosx.factor b/basis/unix/statfs/macosx/macosx.factor index 4bd9f55132..675e65a2d8 100644 --- a/basis/unix/statfs/macosx/macosx.factor +++ b/basis/unix/statfs/macosx/macosx.factor @@ -123,10 +123,11 @@ block-size io-size blocks blocks-free blocks-available files files-free file-system-id owner type flags filesystem-subtype file-system-type-name mount-from ; -M: macosx mounted* ( -- array ) +M: macosx mounted ( -- array ) f dup 0 getmntinfo64 dup io-error [ *void* ] dip - "statfs64" heap-size [ * memory>byte-array ] keep group ; + "statfs64" heap-size [ * memory>byte-array ] keep group + [ >file-system-info ] map ; M: macosx >file-system-info ( byte-array -- file-system-info ) [ \ macosx-file-system-info new ] dip diff --git a/basis/unix/statfs/statfs.factor b/basis/unix/statfs/statfs.factor index cfa0c159d1..20010370ae 100644 --- a/basis/unix/statfs/statfs.factor +++ b/basis/unix/statfs/statfs.factor @@ -9,19 +9,11 @@ blocks-available files files-free file-system-id owner type flags filesystem-subtype file-system-type-name mount-on mount-from ; -HOOK: mounted* os ( -- array ) -HOOK: >mounted os ( byte-array -- mounted ) - TUPLE: file-system-info root-directory total-free-size total-size ; HOOK: >file-system-info os ( struct -- statfs ) -: mounted ( -- array ) mounted* [ >file-system-info ] map ; - -: mounted-drive ( path -- mounted/f ) - mounted - [ [ mount-on>> ] bi@ <=> ] sort - [ mount-on>> head? ] with find nip ; +HOOK: mounted os ( -- array ) os { { linux [ "unix.statfs.linux" require ] } From 278b55ee5766553eb37b0776b02424b022f5dbf5 Mon Sep 17 00:00:00 2001 From: erg Date: Wed, 22 Oct 2008 20:04:10 -0500 Subject: [PATCH 08/14] include mount point in file-system-info --- basis/unix/statfs/linux/linux.factor | 5 ++++- basis/unix/statfs/statfs.factor | 5 ----- core/io/files/files.factor | 2 +- 3 files changed, 5 insertions(+), 7 deletions(-) diff --git a/basis/unix/statfs/linux/linux.factor b/basis/unix/statfs/linux/linux.factor index 6f4b1d619d..caf2e8334c 100644 --- a/basis/unix/statfs/linux/linux.factor +++ b/basis/unix/statfs/linux/linux.factor @@ -33,4 +33,7 @@ frequency pass-number ; [ mtab-csv>mtab-entry ] map ; M: linux mounted - parse-mtab [ mount-point>> file-system-info ] map ; + parse-mtab [ + mount-point>> + [ file-system-info ] keep >>name + ] map ; diff --git a/basis/unix/statfs/statfs.factor b/basis/unix/statfs/statfs.factor index 20010370ae..e77ef37b0f 100644 --- a/basis/unix/statfs/statfs.factor +++ b/basis/unix/statfs/statfs.factor @@ -4,11 +4,6 @@ USING: sequences system vocabs.loader combinators accessors kernel math.order sorting ; IN: unix.statfs -TUPLE: mounted block-size io-size blocks blocks-free -blocks-available files files-free file-system-id owner type -flags filesystem-subtype file-system-type-name mount-on -mount-from ; - TUPLE: file-system-info root-directory total-free-size total-size ; HOOK: >file-system-info os ( struct -- statfs ) diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 1f6a48b50e..fd45343043 100644 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -184,7 +184,7 @@ SYMBOL: +unknown+ ! File-system -TUPLE: file-system-info mount-on free-space ; +TUPLE: file-system-info name free-space ; HOOK: file-system-info os ( path -- file-system-info ) From 46fbd8c5202f549edc042e2a235fa5a96c027af9 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 22 Oct 2008 20:18:58 -0500 Subject: [PATCH 09/14] mounton -> name --- basis/unix/statfs/macosx/macosx.factor | 2 +- basis/unix/statfs/netbsd/netbsd.factor | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/basis/unix/statfs/macosx/macosx.factor b/basis/unix/statfs/macosx/macosx.factor index 675e65a2d8..becce262b8 100644 --- a/basis/unix/statfs/macosx/macosx.factor +++ b/basis/unix/statfs/macosx/macosx.factor @@ -136,7 +136,7 @@ M: macosx >file-system-info ( byte-array -- file-system-info ) [ statfs64-f_bavail ] [ statfs64-f_bsize ] bi * >>free-space ] - [ statfs64-f_mntonname utf8 alien>string >>mount-on ] + [ statfs64-f_mntonname utf8 alien>string >>name ] [ statfs64-f_bsize >>block-size ] [ statfs64-f_iosize >>io-size ] diff --git a/basis/unix/statfs/netbsd/netbsd.factor b/basis/unix/statfs/netbsd/netbsd.factor index dd1ccd4c9a..5aff13cceb 100644 --- a/basis/unix/statfs/netbsd/netbsd.factor +++ b/basis/unix/statfs/netbsd/netbsd.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax kernel io.files unix.stat math unix +USING: alien.syntax kernel unix.stat math unix combinators system io.backend accessors alien.c-types -io.encodings.utf8 alien.strings unix.types ; +io.encodings.utf8 alien.strings unix.types unix.statfs io.files ; IN: unix.statfs.netbsd : _VFS_NAMELEN 32 ; inline @@ -69,7 +69,7 @@ M: netbsd >file-system-info ( byte-array -- netbsd-file-system-info ) [ statvfs-f_owner >>owner ] [ statvfs-f_spare >>spare ] [ statvfs-f_fstypename utf8 alien>string >>file-system-type-name ] - [ statvfs-f_mntonname utf8 alien>string >>mount-on ] + [ statvfs-f_mntonname utf8 alien>string >>name ] [ statvfs-f_mntfromname utf8 alien>string >>mount-from ] } cleave ; From 4ddfc834231b0c33220500dd2e92897c554ec548 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 22 Oct 2008 20:22:35 -0500 Subject: [PATCH 10/14] id_t type --- basis/unix/types/macosx/macosx.factor | 8 +------- basis/unix/types/types.factor | 1 + 2 files changed, 2 insertions(+), 7 deletions(-) diff --git a/basis/unix/types/macosx/macosx.factor b/basis/unix/types/macosx/macosx.factor index 156e756641..ac62776ed7 100644 --- a/basis/unix/types/macosx/macosx.factor +++ b/basis/unix/types/macosx/macosx.factor @@ -1,19 +1,13 @@ - USING: alien.syntax ; - IN: unix.types -! Darwin 9.1.0 ppc - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Darwin 9.1.0 TYPEDEF: ushort __uint16_t TYPEDEF: uint __uint32_t TYPEDEF: int __int32_t TYPEDEF: longlong __int64_t -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - TYPEDEF: __int32_t dev_t TYPEDEF: __uint32_t ino_t TYPEDEF: __uint16_t mode_t diff --git a/basis/unix/types/types.factor b/basis/unix/types/types.factor index 65845874b1..f7ce6406fe 100644 --- a/basis/unix/types/types.factor +++ b/basis/unix/types/types.factor @@ -36,6 +36,7 @@ TYPEDEF: fsblkcnt_t __fsblkcnt_t TYPEDEF: __uint64_t fsfilcnt_t TYPEDEF: fsfilcnt_t __fsfilcnt_t TYPEDEF: __uint64_t rlim_t +TYPEDEF: uint32_t id_t os { { linux [ "unix.types.linux" require ] } From bccf9d96986fc6aa170876e12f162e86641a5db8 Mon Sep 17 00:00:00 2001 From: erg Date: Wed, 22 Oct 2008 20:28:30 -0500 Subject: [PATCH 11/14] add device-name and type to file-system-info --- basis/unix/statfs/linux/linux.factor | 8 ++++++-- core/io/files/files.factor | 2 +- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/basis/unix/statfs/linux/linux.factor b/basis/unix/statfs/linux/linux.factor index caf2e8334c..5e6e5360ef 100644 --- a/basis/unix/statfs/linux/linux.factor +++ b/basis/unix/statfs/linux/linux.factor @@ -34,6 +34,10 @@ frequency pass-number ; M: linux mounted parse-mtab [ - mount-point>> - [ file-system-info ] keep >>name + [ mount-point>> file-system-info ] keep + { + [ file-system-name>> >>device-name ] + [ mount-point>> >>name ] + [ type>> >>type ] + } cleave ] map ; diff --git a/core/io/files/files.factor b/core/io/files/files.factor index fd45343043..f643f4ca3c 100644 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -184,7 +184,7 @@ SYMBOL: +unknown+ ! File-system -TUPLE: file-system-info name free-space ; +TUPLE: file-system-info device-name name type free-space ; HOOK: file-system-info os ( path -- file-system-info ) From c9167e2ab2222165783de57cbf76521c877c759f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 22 Oct 2008 20:32:39 -0500 Subject: [PATCH 12/14] better file-system-info on mac --- basis/unix/statfs/macosx/macosx.factor | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/basis/unix/statfs/macosx/macosx.factor b/basis/unix/statfs/macosx/macosx.factor index becce262b8..e065fc6118 100644 --- a/basis/unix/statfs/macosx/macosx.factor +++ b/basis/unix/statfs/macosx/macosx.factor @@ -120,8 +120,7 @@ FUNCTION: int getmntinfo64 ( statfs64** mntbufp, int flags ) ; TUPLE: macosx-file-system-info < file-system-info block-size io-size blocks blocks-free blocks-available files -files-free file-system-id owner type flags filesystem-subtype -file-system-type-name mount-from ; +files-free file-system-id owner type-id flags filesystem-subtype ; M: macosx mounted ( -- array ) f dup 0 getmntinfo64 dup io-error @@ -147,16 +146,16 @@ M: macosx >file-system-info ( byte-array -- file-system-info ) [ statfs64-f_ffree >>files-free ] [ statfs64-f_fsid >>file-system-id ] [ statfs64-f_owner >>owner ] - [ statfs64-f_type >>type ] + [ statfs64-f_type >>type-id ] [ statfs64-f_flags >>flags ] [ statfs64-f_fssubtype >>filesystem-subtype ] [ statfs64-f_fstypename utf8 alien>string - >>file-system-type-name + >>type ] [ statfs64-f_mntfromname - utf8 alien>string >>mount-from + utf8 alien>string >>device-name ] } cleave ; From b85b0f6820762d73d9383f97ec103ae7904115be Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 22 Oct 2008 21:43:19 -0500 Subject: [PATCH 13/14] fix typo --- basis/unix/statfs/freebsd/freebsd.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/unix/statfs/freebsd/freebsd.factor b/basis/unix/statfs/freebsd/freebsd.factor index 6c5a45c4d2..64ee8716c2 100644 --- a/basis/unix/statfs/freebsd/freebsd.factor +++ b/basis/unix/statfs/freebsd/freebsd.factor @@ -23,7 +23,7 @@ C-STRUCT: statvfs FUNCTION: int statvfs ( char* path, statvfs* buf ) ; TUPLE: freebsd-file-system-info < file-system-info -bavail bfree blocks favail ffree ffiles +bavail bfree blocks favail ffree files bsize flag frsize fsid namemax ; M: freebsd >file-system-info ( struct -- statfs ) From e776bd29e16e2326c22d7244aaec6bcab18425cf Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 22 Oct 2008 22:02:33 -0500 Subject: [PATCH 14/14] add type to file-system-info --- basis/io/windows/files/files.factor | 48 ++++++++++++++++++++++---- basis/windows/kernel32/kernel32.factor | 44 +++++++++++++++++++---- 2 files changed, 78 insertions(+), 14 deletions(-) diff --git a/basis/io/windows/files/files.factor b/basis/io/windows/files/files.factor index 80caf5222f..d7b0b49dd1 100644 --- a/basis/io/windows/files/files.factor +++ b/basis/io/windows/files/files.factor @@ -5,7 +5,7 @@ io.windows kernel math splitting fry alien.strings windows windows.kernel32 windows.time calendar combinators math.functions sequences namespaces make words symbols system io.ports destructors accessors math.bitwise continuations -windows.errors arrays ; +windows.errors arrays byte-arrays ; IN: io.windows.files : open-file ( path access-mode create-mode flags -- handle ) @@ -251,18 +251,52 @@ HOOK: root-directory os ( string -- string' ) TUPLE: winnt-file-system-info < file-system-info total-bytes total-free-bytes ; +: file-system-type ( normalized-path -- str ) + MAX_PATH 1+ + MAX_PATH 1+ + "DWORD" "DWORD" "DWORD" + MAX_PATH 1+ + MAX_PATH 1+ + [ GetVolumeInformation win32-error=0/f ] 2keep drop + utf16n alien>string ; + +: file-system-space ( normalized-path -- free-space total-bytes total-free-bytes ) + "ULARGE_INTEGER" + "ULARGE_INTEGER" + "ULARGE_INTEGER" + [ GetDiskFreeSpaceEx win32-error=0/f ] 3keep ; + M: winnt file-system-info ( path -- file-system-info ) normalize-path root-directory - dup - "ULARGE_INTEGER" - "ULARGE_INTEGER" - "ULARGE_INTEGER" - [ GetDiskFreeSpaceEx win32-error=0/f ] 3keep + dup [ file-system-type ] [ file-system-space ] bi \ winnt-file-system-info new swap *ulonglong >>total-free-bytes swap *ulonglong >>total-bytes swap *ulonglong >>free-space - swap "\\\\?\\" ?head drop root-directory >>name ; + swap >>type + swap >>name ; + +: find-first-volume ( word -- string handle ) + MAX_PATH 1+ dup length + dupd + FindFirstVolume dup win32-error=0/f + [ utf16n alien>string ] dip ; + +: find-next-volume ( handle -- string ) + MAX_PATH 1+ dup length + [ FindNextVolume win32-error=0/f ] 2keep drop + utf16n alien>string ; + +: mounted ( -- array ) + find-first-volume + [ + '[ + [ _ find-next-volume dup ] + [ ] + [ drop ] produce + swap prefix + ] + ] [ '[ _ FindVolumeClose win32-error=0/f ] ] bi [ ] cleanup ; : file-times ( path -- timestamp timestamp timestamp ) [ diff --git a/basis/windows/kernel32/kernel32.factor b/basis/windows/kernel32/kernel32.factor index dfac6a5236..eb90fb522e 100644 --- a/basis/windows/kernel32/kernel32.factor +++ b/basis/windows/kernel32/kernel32.factor @@ -812,22 +812,42 @@ FUNCTION: HANDLE FindFirstFileW ( LPCTSTR lpFileName, LPWIN32_FIND_DATA lpFindFi ALIAS: FindFirstFile FindFirstFileW ! FUNCTION: FindFirstVolumeA ! FUNCTION: FindFirstVolumeMountPointA -! FUNCTION: FindFirstVolumeMountPointW -! FUNCTION: FindFirstVolumeW + +FUNCTION: HANDLE FindFirstVolumeMountPointW ( + LPTSTR lpszRootPathName, + LPTSTR lpszVolumeMountPoint, + DWORD cchBufferLength +) ; +ALIAS: FindFirstVolumeMountPoint FindFirstVolumeMountPointW + +FUNCTION: HANDLE FindFirstVolumeW ( LPTSTR lpszVolumeName, DWORD cchBufferLength ) ; +ALIAS: FindFirstVolume FindFirstVolumeW + FUNCTION: BOOL FindNextChangeNotification ( HANDLE hChangeHandle ) ; + ! FUNCTION: FindNextFileA FUNCTION: BOOL FindNextFileW ( HANDLE hFindFile, LPWIN32_FIND_DATA lpFindFileData ) ; ALIAS: FindNextFile FindNextFileW + ! FUNCTION: FindNextVolumeA ! FUNCTION: FindNextVolumeMountPointA -! FUNCTION: FindNextVolumeMountPointW -! FUNCTION: FindNextVolumeW + +FUNCTION: BOOL FindNextVolumeMountPointW ( + HANDLE hFindVolumeMountPoint, + LPTSTR lpszVolumeMountPoint, + DWORD cchBufferLength +) ; +ALIAS: FindNextVolumeMountPoint FindNextVolumeMountPointW + +FUNCTION: BOOL FindNextVolumeW ( HANDLE hFindVolume, LPTSTR lpszVolumeName, DWORD cchBufferLength ) ; +ALIAS: FindNextVolume FindNextVolumeW + ! FUNCTION: FindResourceA ! FUNCTION: FindResourceExA ! FUNCTION: FindResourceExW ! FUNCTION: FindResourceW -! FUNCTION: FindVolumeClose -! FUNCTION: FindVolumeMountPointClose +FUNCTION: BOOL FindVolumeClose ( HANDLE hFindVolume ) ; +FUNCTION: BOOL FindVolumeMountPointClose ( HANDLE hFindVolumeMountPoint ) ; ! FUNCTION: FlushConsoleInputBuffer ! FUNCTION: FlushFileBuffers ! FUNCTION: FlushInstructionCache @@ -1094,7 +1114,17 @@ FUNCTION: DWORD GetVersion ( ) ; FUNCTION: BOOL GetVersionExW ( LPOSVERSIONINFO lpVersionInfo ) ; ALIAS: GetVersionEx GetVersionExW ! FUNCTION: GetVolumeInformationA -! FUNCTION: GetVolumeInformationW +FUNCTION: BOOL GetVolumeInformationW ( + LPCTSTR lpRootPathName, + LPTSTR lpVolumNameBuffer, + DWORD nVolumeNameSize, + LPDWORD lpVolumeSerialNumber, + LPDWORD lpMaximumComponentLength, + LPDWORD lpFileSystemFlags, + LPCTSTR lpFileSystemNameBuffer, + DWORD nFileSystemNameSize +) ; +ALIAS: GetVolumeInformation GetVolumeInformationW ! FUNCTION: GetVolumeNameForVolumeMountPointA ! FUNCTION: GetVolumeNameForVolumeMountPointW ! FUNCTION: GetVolumePathNameA