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

setting permissions, file times

db4
Doug Coleman 2008-10-07 19:25:22 -05:00
parent 5916fcea75
commit 5afbade0a5
1 changed files with 99 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

102
basis/io/unix/files/files.factor
View File

@ -1,11 +1,11 @@
! Copyright (C) 2005, 2008 Slava Pestov.
! Copyright (C) 2005, 2008 Slava Pestov, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: io.backend io.ports io.unix.backend io.files io
unix unix.stat unix.time kernel math continuations
math.bitwise byte-arrays alien combinators calendar
io.encodings.binary accessors sequences strings system
io.files.private destructors vocabs.loader calendar.unix ;
io.files.private destructors vocabs.loader calendar.unix
unix.stat alien.c-types arrays unix.users unix.groups ;
IN: io.unix.files
M: unix cwd ( -- path )
@ -136,3 +136,99 @@ os {
{ freebsd [ "io.unix.files.bsd" require ] }
{ linux [ ] }
} case
<PRIVATE
: stat-mode ( path -- mode )
normalize-path file-status stat-st_mode ;
: chmod-set-bit ( path mask ? -- )
[ dup stat-mode ] 2dip
[ set-bit ] [ clear-bit ] if chmod io-error ;
: file-mode? ( path mask -- ? ) [ stat-mode ] dip mask? ;
PRIVATE>
: set-uid? ( path -- ? ) UID file-mode? ;
: set-gid? ( path -- ? ) GID file-mode? ;
: set-sticky? ( path -- ? ) STICKY file-mode? ;
: user-read? ( path -- ? ) USER-READ file-mode? ;
: user-write? ( path -- ? ) USER-WRITE file-mode? ;
: user-execute? ( path -- ? ) USER-EXECUTE file-mode? ;
: group-read? ( path -- ? ) GROUP-READ file-mode? ;
: group-write? ( path -- ? ) GROUP-WRITE file-mode? ;
: group-execute? ( path -- ? ) GROUP-EXECUTE file-mode? ;
: other-read? ( path -- ? ) OTHER-READ file-mode? ;
: other-write? ( path -- ? ) OTHER-WRITE file-mode? ;
: other-execute? ( path -- ? ) OTHER-EXECUTE file-mode? ;
: set-uid ( path ? -- ) UID swap chmod-set-bit ;
: set-gid ( path ? -- ) GID swap chmod-set-bit ;
: set-sticky ( path ? -- ) STICKY swap chmod-set-bit ;
: set-user-read ( path ? -- ) USER-READ swap chmod-set-bit ;
: set-user-write ( path ? -- ) USER-WRITE swap chmod-set-bit ;
: set-user-execute ( path ? -- ) USER-EXECUTE swap chmod-set-bit ;
: set-group-read ( path ? -- ) GROUP-READ swap chmod-set-bit ;
: set-group-write ( path ? -- ) GROUP-WRITE swap chmod-set-bit ;
: set-group-execute ( path ? -- ) GROUP-EXECUTE swap chmod-set-bit ;
: set-other-read ( path ? -- ) OTHER-READ swap chmod-set-bit ;
: set-other-write ( path ? -- ) OTHER-WRITE swap chmod-set-bit ;
: set-other-execute ( path ? -- ) OTHER-EXECUTE swap chmod-set-bit ;
: set-file-permissions ( path octal-n -- )
[ normalize-path ] dip chmod io-error ;
<PRIVATE
: make-timeval-array ( array -- byte-array )
[ length "timeval" <c-array> ] keep
dup length [ over [ pick set-timeval-nth ] [ 2drop ] if ] 2each ;
: timestamp>timeval ( timestamp -- timeval )
unix-1970 time- duration>milliseconds make-timeval ;
: timestamps>byte-array ( timestamps -- byte-array )
[ dup [ timestamp>timeval ] when ] map make-timeval-array ;
PRIVATE>
: set-file-times ( path timestamps -- )
#! set access, write
[ normalize-path ] dip
timestamps>byte-array utimes io-error ;
: set-file-access-time ( path timestamp -- )
f 2array set-file-times ;
: set-file-write-time ( path timestamp -- )
f swap 2array set-file-times ;
: set-file-ids ( path uid gid -- )
[ normalize-path ] 2dip
[ [ -1 ] unless* ] bi@ chown io-error ;
GENERIC: set-file-username ( path string/id -- )
GENERIC: set-file-group ( path string/id -- )
M: integer set-file-username ( path uid -- )
f set-file-ids ;
M: string set-file-username ( path string -- )
username-id f set-file-ids ;
M: integer set-file-group ( path gid -- )
f swap set-file-ids ;
M: string set-file-group ( path string -- )
group-id
f swap set-file-ids ;
: file-uid ( path -- uid ) normalize-path file-info uid>> ;
: file-user-name ( path -- string ) file-uid username ;
: file-gid ( path -- gid ) normalize-path file-info gid>> ;
: file-group ( path -- string ) file-gid group-name ;