steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

io.files.info.unix.linux: handles the possible permission denied error in M: linux file-systems

char-rename
Björn Lindqvist 2016-11-19 02:07:49 +01:00
parent 00d4572e6c
commit a1c503c6e4
1 changed files with 12 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
basis/io/files/info/unix/linux/linux.factor
View File

@ -1,9 +1,10 @@
! Copyright (C) 2008 Doug Coleman. ! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs classes.struct combinators csv USING: accessors assocs classes.struct combinators
io.backend io.encodings.utf8 io.files.info io.files.info.unix combinators.short-circuit continuations csv fry io.backend
io.pathnames kernel libc math math.parser sequences splitting io.encodings.utf8 io.files.info io.files.info.unix io.pathnames kernel
strings system unix.statfs.linux unix.statvfs.linux ; libc math math.parser sequences splitting strings system
unix.statfs.linux unix.statvfs.linux ;
FROM: csv => delimiter ; FROM: csv => delimiter ;
IN: io.files.info.unix.linux IN: io.files.info.unix.linux
@ -67,15 +68,18 @@ frequency pass-number ;
CHAR: \s [ "/etc/mtab" utf8 file>csv ] with-delimiter CHAR: \s [ "/etc/mtab" utf8 file>csv ] with-delimiter
[ mtab-csv>mtab-entry ] map ; [ mtab-csv>mtab-entry ] map ;
M: linux file-systems : mtab-entry>file-system-info ( mtab-entry -- file-system-info/f )
parse-mtab [ '[
[ mount-point>> file-system-info ] keep _ [ mount-point>> file-system-info ] keep
{ {
[ file-system-name>> >>device-name ] [ file-system-name>> >>device-name ]
[ mount-point>> >>mount-point ] [ mount-point>> >>mount-point ]
[ type>> >>type ] [ type>> >>type ]
} cleave } cleave
] map ; ] [ { [ libc-error? ] [ errno>> EACCES = ] } 1&& ] ignore-error/f ;
M: linux file-systems
parse-mtab [ mtab-entry>file-system-info ] map sift ;
: (find-mount-point) ( path mtab-paths -- mtab-entry ) : (find-mount-point) ( path mtab-paths -- mtab-entry )
2dup at* [ 2dup at* [