diff --git a/basis/io/unix/files/files-docs.factor b/basis/io/unix/files/files-docs.factor index 7b4ce10b86..5b5e257c5e 100644 --- a/basis/io/unix/files/files-docs.factor +++ b/basis/io/unix/files/files-docs.factor @@ -28,7 +28,7 @@ HELP: file-username { "string" string } } { $description "Returns the username for a given file." } ; -HELP: file-username-id +HELP: file-user-id { $values { "path" "a pathname string" } { "uid" integer } } @@ -107,15 +107,15 @@ HELP: set-file-times { "path" "a pathname string" } { "timestamps" "an array of two timestamps" } } { $description "Sets the access and write timestamps for a file as provided in the input array. A value of " { $link f } " provided for either of the timestamps will not change that timestamp." } ; -HELP: set-file-username +HELP: set-file-user { $values { "path" "a pathname string" } { "string/id" "a string or a user id" } } { $description "Sets a file's user id from the given user id or username." } ; -HELP: set-file-write-time +HELP: set-file-modified-time { $values { "path" "a pathname string" } { "timestamp" timestamp } } -{ $description "Sets a file's last write timestamp." } ; +{ $description "Sets a file's last modified timestamp, or write timestamp." } ; HELP: set-gid { $values @@ -251,16 +251,16 @@ ARTICLE: "unix-file-timestamps" "Unix file timestamps" { $subsection set-file-times } "Setting just the last access time:" { $subsection set-file-access-time } -"Setting just the last write time:" -{ $subsection set-file-write-time } ; +"Setting just the last modified time:" +{ $subsection set-file-modified-time } ; ARTICLE: "unix-file-ids" "Unix file user and group ids" "Reading file user data:" -{ $subsection file-username-id } +{ $subsection file-user-id } { $subsection file-username } "Setting file user data:" -{ $subsection set-file-username } +{ $subsection set-file-user } "Reading file group data:" { $subsection file-group-id } { $subsection file-group-name } diff --git a/basis/io/unix/files/files-tests.factor b/basis/io/unix/files/files-tests.factor index 040b191d27..28c25c0964 100644 --- a/basis/io/unix/files/files-tests.factor +++ b/basis/io/unix/files/files-tests.factor @@ -1,4 +1,6 @@ -USING: tools.test io.files ; +USING: tools.test io.files continuations kernel io.unix.files +math.bitwise calendar accessors math.functions math unix.users +unix.groups arrays sequences ; IN: io.unix.files.tests [ "/usr/libexec/" ] [ "/usr/libexec/awk/" parent-directory ] unit-test @@ -27,3 +29,109 @@ IN: io.unix.files.tests [ "/lib/bux" ] [ "/usr" "/lib/bux" append-path ] unit-test [ "/lib/bux/" ] [ "/usr" "/lib/bux/" append-path ] unit-test [ t ] [ "/foo" absolute-path? ] unit-test + +: test-file ( -- path ) + "permissions" temp-file ; + +: prepare-test-file ( -- ) + [ test-file delete-file ] ignore-errors + test-file touch-file ; + +: perms ( -- n ) + test-file file-permissions OCT: 7777 mask ; + +prepare-test-file + +[ t ] +[ test-file { USER-ALL GROUP-ALL OTHER-ALL } flags set-file-permissions perms OCT: 777 = ] unit-test + +[ t ] [ test-file user-read? ] unit-test +[ t ] [ test-file user-write? ] unit-test +[ t ] [ test-file user-execute? ] unit-test +[ t ] [ test-file group-read? ] unit-test +[ t ] [ test-file group-write? ] unit-test +[ t ] [ test-file group-execute? ] unit-test +[ t ] [ test-file other-read? ] unit-test +[ t ] [ test-file other-write? ] unit-test +[ t ] [ test-file other-execute? ] unit-test + +[ t ] +[ test-file f set-other-execute perms OCT: 776 = ] unit-test + +[ t ] +[ test-file f set-other-write perms OCT: 774 = ] unit-test + +[ t ] +[ test-file f set-other-read perms OCT: 770 = ] unit-test + +[ t ] +[ test-file f set-group-execute perms OCT: 760 = ] unit-test + +[ t ] +[ test-file f set-group-write perms OCT: 740 = ] unit-test + +[ t ] +[ test-file f set-group-read perms OCT: 700 = ] unit-test + +[ t ] +[ test-file f set-user-execute perms OCT: 600 = ] unit-test + +[ t ] +[ test-file f set-user-write perms OCT: 400 = ] unit-test + +[ t ] +[ test-file f set-user-read perms OCT: 000 = ] unit-test + +[ t ] +[ test-file { USER-ALL GROUP-ALL OTHER-EXECUTE } flags set-file-permissions perms OCT: 771 = ] unit-test + +prepare-test-file + +[ t ] +[ + test-file now + [ set-file-access-time ] 2keep + [ file-info accessed>> ] + [ [ truncate >integer ] change-second ] bi* = +] unit-test + +[ t ] +[ + test-file now + [ set-file-modified-time ] 2keep + [ file-info modified>> ] + [ [ truncate >integer ] change-second ] bi* = +] unit-test + +[ t ] +[ + test-file now [ dup 2array set-file-times ] 2keep + [ file-info [ modified>> ] [ accessed>> ] bi ] dip + 3array + [ [ truncate >integer ] change-second ] map all-equal? +] unit-test + +[ ] [ test-file f now 2array set-file-times ] unit-test +[ ] [ test-file now f 2array set-file-times ] unit-test +[ ] [ test-file f f 2array set-file-times ] unit-test + + +[ ] [ test-file real-username set-file-user ] unit-test +[ ] [ test-file real-user-id set-file-user ] unit-test +[ ] [ test-file real-group-name set-file-group ] unit-test +[ ] [ test-file real-group-id set-file-group ] unit-test + +[ t ] [ test-file file-username real-username = ] unit-test +[ t ] [ test-file file-group-name real-group-name = ] unit-test + +[ ] +[ test-file real-user-id real-group-id set-file-ids ] unit-test + +[ ] +[ test-file f real-group-id set-file-ids ] unit-test + +[ ] +[ test-file real-user-id f set-file-ids ] unit-test + +[ ] +[ test-file f f set-file-ids ] unit-test diff --git a/basis/io/unix/files/files.factor b/basis/io/unix/files/files.factor index 49510f9841..40ef9ad859 100644 --- a/basis/io/unix/files/files.factor +++ b/basis/io/unix/files/files.factor @@ -144,7 +144,7 @@ os { : chmod-set-bit ( path mask ? -- ) [ dup stat-mode ] 2dip - [ set-bit ] [ clear-bit ] if chmod io-error ; + [ bitor ] [ unmask ] if chmod io-error ; : file-mode? ( path mask -- ? ) [ stat-mode ] dip mask? ; @@ -220,22 +220,22 @@ PRIVATE> : set-file-access-time ( path timestamp -- ) f 2array set-file-times ; -: set-file-write-time ( path timestamp -- ) +: set-file-modified-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-user ( path string/id -- ) GENERIC: set-file-group ( path string/id -- ) -M: integer set-file-username ( path uid -- ) +M: integer set-file-user ( path uid -- ) f set-file-ids ; -M: string set-file-username ( path string -- ) - username-id f set-file-ids ; +M: string set-file-user ( path string -- ) + user-id f set-file-ids ; M: integer set-file-group ( path gid -- ) f swap set-file-ids ; @@ -244,11 +244,11 @@ M: string set-file-group ( path string -- ) group-id f swap set-file-ids ; -: file-username-id ( path -- uid ) +: file-user-id ( path -- uid ) normalize-path file-info uid>> ; : file-username ( path -- string ) - file-username-id username ; + file-user-id username ; : file-group-id ( path -- gid ) normalize-path file-info gid>> ;