setting permissions, file times

basis/io/unix/files/files.factor

@@ -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 ;