1 ! Copyright (C) 2008 Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors assocs classes.struct combinators
4 combinators.short-circuit continuations csv fry io.backend
5 io.encodings.utf8 io.files.info io.files.info.unix io.pathnames kernel
6 libc math math.parser sequences splitting strings system
7 unix.statfs.linux unix.statvfs.linux ;
8 FROM: csv => delimiter ;
9 IN: io.files.info.unix.linux
11 TUPLE: linux-file-system-info < unix-file-system-info
14 M: linux new-file-system-info linux-file-system-info new ;
16 M: linux file-system-statfs
17 \ statfs64 new [ statfs64 io-error ] keep ;
19 M: linux statfs>file-system-info
22 [ f_bsize>> >>block-size ]
23 [ f_blocks>> >>blocks ]
24 [ f_bfree>> >>blocks-free ]
25 [ f_bavail>> >>blocks-available ]
27 [ f_ffree>> >>files-free ]
29 [ f_namelen>> >>namelen ]
30 [ f_frsize>> >>preferred-block-size ]
31 ! [ statfs64-f_spare >>spare ]
34 M: linux file-system-statvfs
35 \ statvfs64 new [ statvfs64 io-error ] keep ;
37 M: linux statvfs>file-system-info
40 [ f_namemax>> >>name-max ]
43 TUPLE: mtab-entry file-system-name mount-point type options
44 frequency pass-number ;
46 ! octal escape sequences, e.g. "/media/erg/4TB\\040E"
47 : decode-mount-point ( string -- string' )
51 [ 3 cut [ oct> 1string ] dip append ] map append concat
56 : mtab-csv>mtab-entry ( csv -- mtab-entry )
57 [ mtab-entry new ] dip
59 [ first >>file-system-name ]
60 [ second decode-mount-point >>mount-point ]
62 [ fourth string>csv first >>options ]
63 [ 4 swap ?nth [ 0 ] unless* >>frequency ]
64 [ 5 swap ?nth [ 0 ] unless* >>pass-number ]
67 : parse-mtab ( -- array )
68 CHAR: \s [ "/etc/mtab" utf8 file>csv ] with-delimiter
69 [ mtab-csv>mtab-entry ] map ;
71 : (file-system-info) ( path -- file-system-info )
72 [ new-file-system-info ] dip
73 [ file-system-statfs statfs>file-system-info ]
74 [ file-system-statvfs statvfs>file-system-info ] bi
75 file-system-calculations ; inline
77 : mtab-entry>file-system-info ( mtab-entry -- file-system-info/f )
79 _ [ mount-point>> (file-system-info) ] [ ] bi
81 [ file-system-name>> >>device-name ]
82 [ mount-point>> >>mount-point ]
85 ] [ { [ libc-error? ] [ errno>> EACCES = ] } 1&& ] ignore-error/f ;
88 parse-mtab [ [ mount-point>> ] keep ] H{ } map>assoc ;
91 parse-mtab [ mtab-entry>file-system-info ] map sift ;
93 M: linux file-system-info
94 normalize-path [ (file-system-info) ] [ ] bi
97 [ file-system-name>> >>device-name drop ]
98 [ mount-point>> >>mount-point drop ]