! 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 classes.struct struct-arrays ;
+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 )
: 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 ;
: timestamps>byte-array ( timestamps -- byte-array )
[ [ timestamp>timeval ] [ \ timeval <struct> ] if* ] map
- \ timeval >struct-array ;
+ 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 or ] 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