basis/io/files/info/unix/linux/linux.factor

   1 ! Copyright (C) 2008 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien.c-types alien.syntax combinators csv
   4 io.backend io.encodings.utf8 io.files io.files.info io.streams.string
   5 io.files.unix kernel math.order namespaces sequences sorting
   6 system unix unix.statfs.linux unix.statvfs.linux
   7 specialized-arrays.direct.uint arrays io.files.info.unix ;
   8 IN: io.files.info.unix.linux
   9
  10 TUPLE: linux-file-system-info < unix-file-system-info
  11 namelen ;
  12
  13 M: linux new-file-system-info linux-file-system-info new ;
  14
  15 M: linux file-system-statfs ( path -- byte-array )
  16     "statfs64" <c-object> tuck statfs64 io-error ;
  17
  18 M: linux statfs>file-system-info ( struct -- statfs )
  19     {
  20         [ statfs64-f_type >>type ]
  21         [ statfs64-f_bsize >>block-size ]
  22         [ statfs64-f_blocks >>blocks ]
  23         [ statfs64-f_bfree >>blocks-free ]
  24         [ statfs64-f_bavail >>blocks-available ]
  25         [ statfs64-f_files >>files ]
  26         [ statfs64-f_ffree >>files-free ]
  27         [ statfs64-f_fsid 2 <direct-uint-array> >array >>id ]
  28         [ statfs64-f_namelen >>namelen ]
  29         [ statfs64-f_frsize >>preferred-block-size ]
  30         ! [ statfs64-f_spare >>spare ]
  31     } cleave ;
  32
  33 M: linux file-system-statvfs ( path -- byte-array )
  34     "statvfs64" <c-object> tuck statvfs64 io-error ;
  35
  36 M: linux statvfs>file-system-info ( struct -- statfs )
  37     {
  38         [ statvfs64-f_flag >>flags ]
  39         [ statvfs64-f_namemax >>name-max ]
  40     } cleave ;
  41
  42 TUPLE: mtab-entry file-system-name mount-point type options
  43 frequency pass-number ;
  44
  45 : mtab-csv>mtab-entry ( csv -- mtab-entry )
  46     [ mtab-entry new ] dip
  47     {
  48         [ first >>file-system-name ]
  49         [ second >>mount-point ]
  50         [ third >>type ]
  51         [ fourth <string-reader> csv first >>options ]
  52         [ 4 swap nth >>frequency ]
  53         [ 5 swap nth >>pass-number ]
  54     } cleave ;
  55
  56 : parse-mtab ( -- array )
  57     [
  58         "/etc/mtab" utf8 <file-reader>
  59         CHAR: \s delimiter set csv
  60     ] with-scope
  61     [ mtab-csv>mtab-entry ] map ;
  62
  63 M: linux file-systems
  64     parse-mtab [
  65         [ mount-point>> file-system-info ] keep
  66         {
  67             [ file-system-name>> >>device-name ]
  68             [ mount-point>> >>mount-point ]
  69             [ type>> >>type ]
  70         } cleave
  71     ] map ;
  72
  73 ERROR: file-system-not-found ;
  74
  75 M: linux file-system-info ( path -- )
  76     normalize-path
  77     [
  78         [ new-file-system-info ] dip
  79         [ file-system-statfs statfs>file-system-info ]
  80         [ file-system-statvfs statvfs>file-system-info ] bi
  81         file-system-calculations
  82     ] keep
  83
  84     parse-mtab [ [ mount-point>> ] bi@ <=> invert-comparison ] sort
  85     [ mount-point>> head? ] with find nip [ file-system-not-found ] unless*
  86     {
  87         [ file-system-name>> >>device-name drop ]
  88         [ mount-point>> >>mount-point drop ]
  89         [ type>> >>type ]
  90     } 2cleave ;