From 2a34339e6579b2a03ed304e59603d4c8acd0a8e5 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 1 Dec 2008 14:04:55 -0600 Subject: [PATCH] make a generic protocol for filling in the file-system-info obj in io.unix.files --- basis/io/unix/files/files.factor | 57 ++++++++++++++++-- basis/io/unix/files/freebsd/freebsd.factor | 24 ++++++++ basis/io/unix/files/freebsd/tags.txt | 1 + basis/io/unix/files/linux/linux.factor | 67 ++++++++++++++++++++++ basis/io/unix/files/linux/tags.txt | 1 + basis/io/unix/files/macosx/macosx.factor | 50 ++++++++++++++++ basis/io/unix/files/macosx/tags.txt | 1 + basis/io/unix/files/netbsd/netbsd.factor | 14 +++++ basis/io/unix/files/netbsd/tags.txt | 1 + basis/io/unix/files/openbsd/openbsd.factor | 24 ++++++++ basis/io/unix/files/openbsd/tags.txt | 1 + 11 files changed, 237 insertions(+), 4 deletions(-) create mode 100644 basis/io/unix/files/freebsd/freebsd.factor create mode 100644 basis/io/unix/files/freebsd/tags.txt create mode 100644 basis/io/unix/files/linux/linux.factor create mode 100644 basis/io/unix/files/linux/tags.txt create mode 100644 basis/io/unix/files/macosx/macosx.factor create mode 100644 basis/io/unix/files/macosx/tags.txt create mode 100644 basis/io/unix/files/netbsd/netbsd.factor create mode 100644 basis/io/unix/files/netbsd/tags.txt create mode 100644 basis/io/unix/files/openbsd/openbsd.factor create mode 100644 basis/io/unix/files/openbsd/tags.txt diff --git a/basis/io/unix/files/files.factor b/basis/io/unix/files/files.factor index 9fa1727e16..d1fb059b77 100644 --- a/basis/io/unix/files/files.factor +++ b/basis/io/unix/files/files.factor @@ -6,7 +6,7 @@ math.bitwise byte-arrays alien combinators calendar io.encodings.binary accessors sequences strings system io.files.private destructors vocabs.loader calendar.unix unix.stat alien.c-types arrays unix.users unix.groups -environment fry io.encodings.utf8 alien.strings unix.statfs +environment fry io.encodings.utf8 alien.strings combinators.short-circuit ; IN: io.unix.files @@ -76,15 +76,64 @@ M: unix copy-file ( from to -- ) [ swap file-info permissions>> chmod io-error ] 2bi ; -HOOK: stat>file-info os ( stat -- file-info ) +TUPLE: unix-file-system-info < file-system-info +block-size preferred-block-size +blocks blocks-free blocks-available +files files-free files-available +name-max flags id ; -HOOK: stat>type os ( stat -- file-info ) +HOOK: new-file-system-info os ( -- file-system-info ) -HOOK: new-file-info os ( -- class ) +M: unix new-file-system-info ( -- ) unix-file-system-info new ; + +HOOK: file-system-statfs os ( path -- statfs ) + +M: unix file-system-statfs drop f ; + +HOOK: file-system-statvfs os ( path -- statvfs ) + +M: unix file-system-statvfs drop f ; + +HOOK: statfs>file-system-info os ( file-system-info statfs -- file-system-info' ) + +M: unix statfs>file-system-info drop ; + +HOOK: statvfs>file-system-info os ( file-system-info statvfs -- file-system-info' ) + +M: unix statvfs>file-system-info drop ; + +: file-system-calculations ( file-system-info -- file-system-info' ) + { + [ dup [ blocks-available>> ] [ block-size>> ] bi * >>free-space drop ] + [ dup [ blocks>> ] [ block-size>> ] bi * >>total-space drop ] + [ dup [ total-space>> ] [ free-space>> ] bi - >>used-space drop ] + [ ] + } cleave ; + +M: unix file-system-info + normalize-path + [ new-file-system-info ] dip + [ file-system-statfs statfs>file-system-info ] + [ file-system-statvfs statvfs>file-system-info ] bi + file-system-calculations ; + +os { + { linux [ "io.unix.files.linux" require ] } + { macosx [ "io.unix.files.macosx" require ] } + { freebsd [ "io.unix.files.freebsd" require ] } + { netbsd [ "io.unix.files.netbsd" require ] } + { openbsd [ "io.unix.files.openbsd" require ] } +} case TUPLE: unix-file-info < file-info uid gid dev ino nlink rdev blocks blocksize ; +HOOK: new-file-info os ( -- file-info ) + +HOOK: stat>file-info os ( stat -- file-info ) + +HOOK: stat>type os ( stat -- file-info ) + M: unix file-info ( path -- info ) normalize-path file-status stat>file-info ; diff --git a/basis/io/unix/files/freebsd/freebsd.factor b/basis/io/unix/files/freebsd/freebsd.factor new file mode 100644 index 0000000000..48dfd37584 --- /dev/null +++ b/basis/io/unix/files/freebsd/freebsd.factor @@ -0,0 +1,24 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.syntax kernel unix math accessors +combinators system io.backend alien.c-types unix.statfs +io.files ; +IN: io.unix.files.freebsd + +M: freebsd file-system-statvfs ( path -- byte-array ) + "statvfs" tuck statvfs io-error ; + +M: freebsd statvfs>file-system-info ( file-system-info statvfs -- file-system-info ) + { + [ statvfs-f_bavail >>blocks-available ] + [ statvfs-f_bfree >>blocks-free ] + [ statvfs-f_blocks >>blocks ] + [ statvfs-f_favail >>files-available ] + [ statvfs-f_ffree >>files-free ] + [ statvfs-f_files >>files ] + [ statvfs-f_bsize >>block-size ] + [ statvfs-f_flag >>flags ] + [ statvfs-f_frsize >>preferred-block-size ] + [ statvfs-f_fsid >>id ] + [ statvfs-f_namemax >>name-max ] + } cleave ; diff --git a/basis/io/unix/files/freebsd/tags.txt b/basis/io/unix/files/freebsd/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/unix/files/freebsd/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/unix/files/linux/linux.factor b/basis/io/unix/files/linux/linux.factor new file mode 100644 index 0000000000..584015711f --- /dev/null +++ b/basis/io/unix/files/linux/linux.factor @@ -0,0 +1,67 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. + +IN: io.unix.files.linux + +TUPLE: linux-file-system-info < unix-file-system-info +namelen spare ; + +M: linux new-file-system-info unix-file-system-info new ; + +M: linux file-system-statfs ( path -- byte-array ) + "statfs64" tuck statfs64 io-error ; + +M: linux statfs>file-system-info ( struct -- statfs ) + { + [ statfs64-f_type >>type ] + [ statfs64-f_bsize >>block-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 >>id ] + [ statfs64-f_namelen >>namelen ] + [ statfs64-f_frsize >>preferred-block-size ] + [ statfs64-f_spare >>spare ] + } cleave ; + +M: linux file-system-statvfs ( path -- byte-array ) + "statvfs64" tuck statvfs64 io-error ; + +M: linux statvfs>file-system-info ( struct -- statfs ) + { + [ statvfs64-f_flag >>flags ] + [ statvfs64-f_namemax >>name-max ] + } cleave ; + +M: linux file-systems + parse-mtab [ + [ mount-point>> file-system-info ] keep + { + [ file-system-name>> >>device-name ] + [ mount-point>> >>mount-point ] + [ type>> >>type ] + } cleave + ] map ; + +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 ; diff --git a/basis/io/unix/files/linux/tags.txt b/basis/io/unix/files/linux/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/unix/files/linux/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/unix/files/macosx/macosx.factor b/basis/io/unix/files/macosx/macosx.factor new file mode 100644 index 0000000000..c5d12a012e --- /dev/null +++ b/basis/io/unix/files/macosx/macosx.factor @@ -0,0 +1,50 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors alien.c-types alien.strings combinators +grouping io.encodings.utf8 io.files kernel math sequences +system unix unix.statfs.macosx io.unix.files unix.statvfs.macosx ; +IN: io.unix.files.macosx + +TUPLE: macosx-file-system-info < unix-file-system-info +io-size owner type-id filesystem-subtype ; + +M: macosx file-systems ( -- array ) + f dup 0 getmntinfo64 dup io-error + [ *void* ] dip + "statfs64" heap-size [ * memory>byte-array ] keep group + [ [ new-file-system-info ] dip statfs>file-system-info ] map ; + +M: macosx new-file-system-info macosx-file-system-info new ; + +M: macosx file-system-statfs ( normalized-path -- statfs ) + "statfs64" tuck statfs64 io-error ; + +M: macosx file-system-statvfs ( normalized-path -- statvfs ) + "statvfs" tuck statvfs io-error ; + +M: macosx statfs>file-system-info ( file-system-info byte-array -- file-system-info' ) + { + [ 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 >>id ] + [ statfs64-f_owner >>owner ] + [ statfs64-f_type >>type-id ] + [ statfs64-f_flags >>flags ] + [ statfs64-f_fssubtype >>filesystem-subtype ] + [ statfs64-f_fstypename utf8 alien>string >>type ] + [ statfs64-f_mntonname utf8 alien>string >>mount-point ] + [ statfs64-f_mntfromname utf8 alien>string >>device-name ] + } cleave ; + +M: macosx statvfs>file-system-info ( file-system-info byte-array -- file-system-info' ) + { + [ statvfs-f_frsize >>preferred-block-size ] + [ statvfs-f_favail >>files-available ] + [ statvfs-f_namemax >>name-max ] + } cleave ; + diff --git a/basis/io/unix/files/macosx/tags.txt b/basis/io/unix/files/macosx/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/unix/files/macosx/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/unix/files/netbsd/netbsd.factor b/basis/io/unix/files/netbsd/netbsd.factor new file mode 100644 index 0000000000..429833a444 --- /dev/null +++ b/basis/io/unix/files/netbsd/netbsd.factor @@ -0,0 +1,14 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.syntax kernel unix.stat math unix +combinators system io.backend accessors alien.c-types +io.encodings.utf8 alien.strings unix.types unix.statfs io.files ; +IN: io.unix.files.netbsd + +TUPLE: netbsd-file-system-info < unix-file-system-info +owner io-size blocks-reserved +sync-reads sync-writes async-reads async-writes +fsidx fstype mnotonname mntfromname mount-from spare ; + +M: netbsd file-system-statvfs + "statvfs" tuck statvfs io-error ; diff --git a/basis/io/unix/files/netbsd/tags.txt b/basis/io/unix/files/netbsd/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/unix/files/netbsd/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/unix/files/openbsd/openbsd.factor b/basis/io/unix/files/openbsd/openbsd.factor new file mode 100644 index 0000000000..d348d281fb --- /dev/null +++ b/basis/io/unix/files/openbsd/openbsd.factor @@ -0,0 +1,24 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.syntax accessors combinators kernel +unix.types math system io.backend alien.c-types unix +unix.statfs io.files ; +IN: io.unix.files.openbsd + +M: openbsd >file-system-info ( file-system-info statvfs -- file-system-info' ) + { + [ statvfs-f_bsize >>block-size ] + [ statvfs-f_frsize >>preferred-block-size ] + [ statvfs-f_blocks >>blocks ] + [ statvfs-f_bfree >>blocks-free ] + [ statvfs-f_bavail >>blocks-avail ] + [ statvfs-f_files >>files ] + [ statvfs-f_ffree >>files-free ] + [ statvfs-f_favail >>files-available ] + [ statvfs-f_fsid >>id ] + [ statvfs-f_flag >>flags ] + [ statvfs-f_namemax >>name-max ] + } cleave ; + +M: openbsd file-system-statvfs ( normalized-path -- statvfs ) + "statvfs" tuck statvfs io-error ; diff --git a/basis/io/unix/files/openbsd/tags.txt b/basis/io/unix/files/openbsd/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/unix/files/openbsd/tags.txt @@ -0,0 +1 @@ +unportable