add statfs stuff

basis/unix/statfs/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

basis/unix/statfs/linux/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

basis/unix/statfs/linux/linux-tests.factor

@@ -0,0 +1,4 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test unix.statfs.linux ;
+IN: unix.statfs.linux.tests

basis/unix/statfs/linux/linux.factor

@@ -0,0 +1,28 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.c-types combinators kernel ;
+IN: unix.statfs.linux
+
+TUPLE: linux-file-system-info < file-system-info
+type bsize blocks bfree bavail files ffree fsid
+namelen frsize spare ;
+
+: statfs-struct>statfs ( struct -- statfs )
+    [ \ statfs new ] dip
+    {
+        [ statfs64-f_type >>type ]
+        [ statfs64-f_bsize >>bsize ]
+        [ statfs64-f_blocks >>blocks ]
+        [ statfs64-f_bfree >>bfree ]
+        [ statfs64-f_bavail >>bavail ]
+        [ statfs64-f_files >>files ]
+        [ statfs64-f_ffree >>ffree ]
+        [ statfs64-f_fsid >>fsid ]
+        [ statfs64-f_namelen >>namelen ]
+        [ statfs64-f_frsize >>frsize ]
+        [ statfs64-f_spare >>spare ]
+    } cleave ;
+
+: statfs ( path -- byte-array )
+    "statfs64" <c-object> [ statfs64 io-error ] keep ;
+

basis/unix/statfs/macosx/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

basis/unix/statfs/macosx/macosx-tests.factor

@@ -0,0 +1,4 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test unix.statfs.macosx ;
+IN: unix.statfs.macosx.tests

basis/unix/statfs/macosx/macosx.factor

@@ -0,0 +1,52 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.c-types io.encodings.utf8 io.encodings.string
+kernel sequences unix.stat accessors unix combinators math
+grouping system unix.statfs io.files io.backend alien.strings ;
+IN: unix.statfs.macosx
+
+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 ;
+
+M: macosx mounted* ( -- array )
+    f <void*> dup 0 getmntinfo64 dup io-error
+    [ *void* ] dip
+    "statfs64" heap-size [ * memory>byte-array ] keep group ;
+
+: statfs64>file-system-info ( byte-array -- file-system-info )
+    [ \ macosx-file-system-info new ] dip
+    {
+        [
+            [ statfs64-f_bavail ] [ statfs64-f_bsize ] bi *
+            >>free-space
+        ]
+        [ statfs64-f_mntonname utf8 alien>string >>mount-on ]
+        [ statfs64-f_bsize >>block-size ]
+
+        [ statfs64-f_iosize >>io-size ]
+        [ statfs64-f_blocks >>blocks ]
+        [ statfs64-f_bfree >>blocks-free ]
+        [ statfs64-f_bavail >>blocks-available ]
+        [ statfs64-f_files >>files ]
+        [ statfs64-f_ffree >>files-free ]
+        [ statfs64-f_fsid >>file-system-id ]
+        [ statfs64-f_owner >>owner ]
+        [ statfs64-f_type >>type ]
+        [ statfs64-f_flags >>flags ]
+        [ statfs64-f_fssubtype >>filesystem-subtype ]
+        [
+            statfs64-f_fstypename utf8 alien>string
+            >>file-system-type-name
+        ]
+        [
+            statfs64-f_mntfromname
+            utf8 alien>string >>mount-from
+        ]
+    } cleave ;
+
+M: macosx file-system-info ( path -- file-system-info )
+    normalize-path
+    "statfs64" <c-object> tuck statfs64 io-error
+    statfs64>file-system-info ;

basis/unix/statfs/statfs-tests.factor

@@ -0,0 +1,4 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test unix.statfs ;
+IN: unix.statfs.tests

basis/unix/statfs/statfs.factor

@@ -0,0 +1,31 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+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 ;
+
+HOOK: mounted* os ( -- array )
+HOOK: mounted-struct>mounted os ( byte-array -- mounted )
+
+TUPLE: file-system-info root-directory total-free-size total-size ;
+
+: mounted ( -- array )
+    mounted* [ mounted-struct>mounted ] map ;
+
+: mounted-drive ( path -- mounted/f )
+    mounted
+    [ [ mount-on>> ] bi@ <=> ] sort <reversed>
+    [ mount-on>> head? ] with find nip ;
+
+os {
+    { linux   [ "unix.statfs.linux"   require ] }
+    { macosx  [ "unix.statfs.macosx"  require ] }
+    ! { freebsd [ "unix.statfs.freebsd" require ] }
+    ! { netbsd  [ "unix.statfs.netbsd"  require ] }
+    ! { openbsd [ "unix.statfs.openbsd" require ] }
+} case