! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel system math math.bitwise strings arrays
-sequences combinators combinators.short-circuit alien.c-types
-vocabs.loader calendar calendar.unix io.files.info
-io.files.types io.backend io.directories unix unix.stat unix.time unix.users
-unix.groups ;
+USING: accessors alien.c-types alien.data arrays calendar
+calendar.unix classes.struct combinators
+combinators.short-circuit io.backend io.directories
+io.files.info io.files.types kernel literals math math.bitwise
+sequences specialized-arrays strings system unix unix.ffi
+unix.groups unix.stat unix.time unix.users vocabs ;
IN: io.files.info.unix
+SPECIALIZED-ARRAY: timeval
TUPLE: unix-file-system-info < file-system-info
block-size preferred-block-size
HOOK: new-file-system-info os ( -- file-system-info )
-M: unix new-file-system-info ( -- ) unix-file-system-info new ;
+M: unix new-file-system-info unix-file-system-info new ;
HOOK: file-system-statfs os ( path -- statfs )
[ new-file-info ] dip
{
[ stat>type >>type ]
- [ stat-st_size >>size ]
- [ stat-st_mode >>permissions ]
- [ stat-st_ctimespec timespec>unix-time >>created ]
- [ stat-st_mtimespec timespec>unix-time >>modified ]
- [ stat-st_atimespec timespec>unix-time >>accessed ]
- [ stat-st_uid >>uid ]
- [ stat-st_gid >>gid ]
- [ stat-st_dev >>dev ]
- [ stat-st_ino >>ino ]
- [ stat-st_nlink >>nlink ]
- [ stat-st_rdev >>rdev ]
- [ stat-st_blocks >>blocks ]
- [ stat-st_blksize >>blocksize ]
+ [ st_size>> >>size ]
+ [ st_mode>> >>permissions ]
+ [ st_ctimespec>> timespec>unix-time >>created ]
+ [ st_mtimespec>> timespec>unix-time >>modified ]
+ [ st_atimespec>> timespec>unix-time >>accessed ]
+ [ st_uid>> >>uid ]
+ [ st_gid>> >>gid ]
+ [ st_dev>> >>dev ]
+ [ st_ino>> >>ino ]
+ [ st_nlink>> >>nlink ]
+ [ st_rdev>> >>rdev ]
+ [ st_blocks>> >>blocks ]
+ [ st_blksize>> >>blocksize ]
[ drop dup blocks>> standard-unix-block-size * >>size-on-disk ]
} cleave ;
} case ;
M: unix stat>type ( stat -- type )
- stat-st_mode n>file-type ;
+ st_mode>> n>file-type ;
<PRIVATE
: stat-mode ( path -- mode )
- normalize-path file-status stat-st_mode ;
+ normalize-path file-status st_mode>> ;
: chmod-set-bit ( path mask ? -- )
[ dup stat-mode ] 2dip
- [ bitor ] [ unmask ] if chmod io-error ;
+ [ bitor ] [ unmask ] if [ chmod ] unix-system-call drop ;
GENERIC# file-mode? 1 ( obj mask -- ? )
PRIVATE>
-CONSTANT: UID OCT: 0004000
-CONSTANT: GID OCT: 0002000
-CONSTANT: STICKY OCT: 0001000
-CONSTANT: USER-ALL OCT: 0000700
-CONSTANT: USER-READ OCT: 0000400
-CONSTANT: USER-WRITE OCT: 0000200
-CONSTANT: USER-EXECUTE OCT: 0000100
-CONSTANT: GROUP-ALL OCT: 0000070
-CONSTANT: GROUP-READ OCT: 0000040
-CONSTANT: GROUP-WRITE OCT: 0000020
-CONSTANT: GROUP-EXECUTE OCT: 0000010
-CONSTANT: OTHER-ALL OCT: 0000007
-CONSTANT: OTHER-READ OCT: 0000004
-CONSTANT: OTHER-WRITE OCT: 0000002
-CONSTANT: OTHER-EXECUTE OCT: 0000001
+CONSTANT: UID 0o0004000
+CONSTANT: GID 0o0002000
+CONSTANT: STICKY 0o0001000
+CONSTANT: USER-ALL 0o0000700
+CONSTANT: USER-READ 0o0000400
+CONSTANT: USER-WRITE 0o0000200
+CONSTANT: USER-EXECUTE 0o0000100
+CONSTANT: GROUP-ALL 0o0000070
+CONSTANT: GROUP-READ 0o0000040
+CONSTANT: GROUP-WRITE 0o0000020
+CONSTANT: GROUP-EXECUTE 0o0000010
+CONSTANT: OTHER-ALL 0o0000007
+CONSTANT: OTHER-READ 0o0000004
+CONSTANT: OTHER-WRITE 0o0000002
+CONSTANT: OTHER-EXECUTE 0o0000001
+CONSTANT: ALL-READ 0o0000444
+CONSTANT: ALL-WRITE 0o0000222
+CONSTANT: ALL-EXECUTE 0o0000111
: uid? ( obj -- ? ) UID file-mode? ;
: gid? ( obj -- ? ) GID file-mode? ;
: set-other-execute ( path ? -- ) OTHER-EXECUTE swap chmod-set-bit ;
: set-file-permissions ( path n -- )
- [ normalize-path ] dip chmod io-error ;
+ [ normalize-path ] dip [ chmod ] unix-system-call drop ;
: file-permissions ( path -- n )
normalize-path file-info permissions>> ;
+: add-file-permissions ( path n -- )
+ over file-permissions bitor set-file-permissions ;
+
+: remove-file-permissions ( path n -- )
+ over file-permissions [ bitnot ] dip bitand set-file-permissions ;
+
M: unix copy-file-and-info ( from to -- )
[ copy-file ] [ swap file-permissions set-file-permissions ] 2bi ;
<PRIVATE
-: make-timeval-array ( array -- byte-array )
- [ [ "timeval" <c-object> ] unless* ] map concat ;
-
: timestamp>timeval ( timestamp -- timeval )
unix-1970 time- duration>microseconds make-timeval ;
: timestamps>byte-array ( timestamps -- byte-array )
- [ dup [ timestamp>timeval ] when ] map make-timeval-array ;
+ [ [ timestamp>timeval ] [ \ timeval <struct> ] if* ] map
+ timeval >c-array ;
PRIVATE>
: set-file-times ( path timestamps -- )
#! set access, write
[ normalize-path ] dip
- timestamps>byte-array utimes io-error ;
+ timestamps>byte-array [ utimes ] unix-system-call drop ;
: set-file-access-time ( path timestamp -- )
f 2array set-file-times ;
f swap 2array set-file-times ;
: set-file-ids ( path uid gid -- )
- [ normalize-path ] 2dip
- [ [ -1 ] unless* ] bi@ chown io-error ;
+ [ normalize-path ] 2dip [ -1 or ] bi@
+ [ chown ] unix-system-call drop ;
GENERIC: set-file-user ( path string/id -- )
{ +regular-file+ [ file-type>executable ] }
[ drop file-type>executable ]
} case ;
+
+"io.files.info.unix." os name>> append require