From 6aadd70623c510fa999602fd3f39019d0d9378fe Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 18 Oct 2008 17:29:38 -0500 Subject: [PATCH] user-read? is now generic, can take a filename or an integer from a stat struct --- basis/io/unix/files/files-docs.factor | 46 ++++++++++++------------ basis/io/unix/files/files-tests.factor | 26 ++++++++++++++ basis/io/unix/files/files.factor | 50 +++++++++++++++++++------- 3 files changed, 87 insertions(+), 35 deletions(-) diff --git a/basis/io/unix/files/files-docs.factor b/basis/io/unix/files/files-docs.factor index 5b5e257c5e..5649b56abd 100644 --- a/basis/io/unix/files/files-docs.factor +++ b/basis/io/unix/files/files-docs.factor @@ -36,39 +36,39 @@ HELP: file-user-id HELP: group-execute? { $values - { "path" "a pathname string" } + { "obj" "a pathname string or an integer" } { "?" "a boolean" } } { $description "Tests whether the " { $snippet "group execute" } " bit is set on a file." } ; HELP: group-read? { $values - { "path" "a pathname string" } + { "obj" "a pathname string or an integer" } { "?" "a boolean" } } -{ $description "Tests whether the " { $snippet "group read" } " bit is set on a file." } ; +{ $description "Tests whether the " { $snippet "group read" } " bit is set on a file or an integer." } ; HELP: group-write? { $values - { "path" "a pathname string" } + { "obj" "a pathname string or an integer" } { "?" "a boolean" } } -{ $description "Tests whether the " { $snippet "group write" } " bit is set on a file." } ; +{ $description "Tests whether the " { $snippet "group write" } " bit is set on a file or an integer." } ; HELP: other-execute? { $values - { "path" "a pathname string" } + { "obj" "a pathname string or an integer" } { "?" "a boolean" } } -{ $description "Tests whether the " { $snippet "other execute" } " bit is set on a file." } ; +{ $description "Tests whether the " { $snippet "other execute" } " bit is set on a file or an integer." } ; HELP: other-read? { $values - { "path" "a pathname string" } + { "obj" "a pathname string or an integer" } { "?" "a boolean" } } -{ $description "Tests whether the " { $snippet "other read" } " bit is set on a file." } ; +{ $description "Tests whether the " { $snippet "other read" } " bit is set on a file or an integer." } ; HELP: other-write? { $values - { "path" "a pathname string" } + { "obj" "a pathname string or an integer" } { "?" "a boolean" } } -{ $description "Tests whether the " { $snippet "other write" } " bit is set on a file." } ; +{ $description "Tests whether the " { $snippet "other write" } " bit is set on a file or an integer." } ; HELP: set-file-access-time { $values @@ -124,9 +124,9 @@ HELP: set-gid HELP: gid? { $values - { "path" "a pathname string" } + { "obj" "a pathname string or an integer" } { "?" "a boolean" } } -{ $description "Tests whether the " { $snippet "gid" } " bit is set on a file." } ; +{ $description "Tests whether the " { $snippet "gid" } " bit is set on a file or an integer." } ; HELP: set-group-execute { $values @@ -165,9 +165,9 @@ HELP: set-sticky HELP: sticky? { $values - { "path" "a pathname string" } + { "obj" "a pathname string or an integer" } { "?" "a boolean" } } -{ $description "Tests whether the " { $snippet "sticky" } " bit of a file is set." } ; +{ $description "Tests whether the " { $snippet "sticky" } " bit is set on a file or an integer." } ; HELP: set-uid { $values @@ -176,9 +176,9 @@ HELP: set-uid HELP: uid? { $values - { "path" "a pathname string" } + { "obj" "a pathname string or an integer" } { "?" "a boolean" } } -{ $description "Tests whether the " { $snippet "uid" } " bit of a file is set." } ; +{ $description "Tests whether the " { $snippet "uid" } " bit is set on a file or an integer." } ; HELP: set-user-execute { $values @@ -197,21 +197,21 @@ HELP: set-user-write HELP: user-execute? { $values - { "path" "a pathname string" } + { "obj" "a pathname string or an integer" } { "?" "a boolean" } } -{ $description "Tests whether the " { $snippet "user execute" } " bit is set on a file." } ; +{ $description "Tests whether the " { $snippet "user execute" } " bit is set on a file or an integer." } ; HELP: user-read? { $values - { "path" "a pathname string" } + { "obj" "a pathname string or an integer" } { "?" "a boolean" } } -{ $description "Tests whether the " { $snippet "user read" } " bit is set on a file." } ; +{ $description "Tests whether the " { $snippet "user read" } " bit is set on a file or an integer." } ; HELP: user-write? { $values - { "path" "a pathname string" } + { "obj" "a pathname string or an integer" } { "?" "a boolean" } } -{ $description "Tests whether the " { $snippet "user write" } " bit is set on a file." } ; +{ $description "Tests whether the " { $snippet "user write" } " bit is set on a file or an integer." } ; ARTICLE: "unix-file-permissions" "Unix file permissions" "Reading all file permissions:" diff --git a/basis/io/unix/files/files-tests.factor b/basis/io/unix/files/files-tests.factor index 5a24c1314a..21a4d18759 100644 --- a/basis/io/unix/files/files-tests.factor +++ b/basis/io/unix/files/files-tests.factor @@ -135,3 +135,29 @@ prepare-test-file [ ] [ test-file f f set-file-ids ] unit-test + +[ t ] [ OCT: 4000 uid? ] unit-test +[ t ] [ OCT: 2000 gid? ] unit-test +[ t ] [ OCT: 1000 sticky? ] unit-test +[ t ] [ OCT: 400 user-read? ] unit-test +[ t ] [ OCT: 200 user-write? ] unit-test +[ t ] [ OCT: 100 user-execute? ] unit-test +[ t ] [ OCT: 040 group-read? ] unit-test +[ t ] [ OCT: 020 group-write? ] unit-test +[ t ] [ OCT: 010 group-execute? ] unit-test +[ t ] [ OCT: 004 other-read? ] unit-test +[ t ] [ OCT: 002 other-write? ] unit-test +[ t ] [ OCT: 001 other-execute? ] unit-test + +[ f ] [ 0 uid? ] unit-test +[ f ] [ 0 gid? ] unit-test +[ f ] [ 0 sticky? ] unit-test +[ f ] [ 0 user-read? ] unit-test +[ f ] [ 0 user-write? ] unit-test +[ f ] [ 0 user-execute? ] unit-test +[ f ] [ 0 group-read? ] unit-test +[ f ] [ 0 group-write? ] unit-test +[ f ] [ 0 group-execute? ] unit-test +[ f ] [ 0 other-read? ] unit-test +[ f ] [ 0 other-write? ] unit-test +[ f ] [ 0 other-execute? ] unit-test diff --git a/basis/io/unix/files/files.factor b/basis/io/unix/files/files.factor index 40ef9ad859..b5fa7783d0 100644 --- a/basis/io/unix/files/files.factor +++ b/basis/io/unix/files/files.factor @@ -166,18 +166,44 @@ PRIVATE> : OTHER-WRITE OCT: 0000002 ; inline : OTHER-EXECUTE OCT: 0000001 ; inline -: uid? ( path -- ? ) UID file-mode? ; -: gid? ( path -- ? ) GID file-mode? ; -: 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? ; +GENERIC: uid? ( obj -- ? ) +GENERIC: gid? ( obj -- ? ) +GENERIC: sticky? ( obj -- ? ) +GENERIC: user-read? ( obj -- ? ) +GENERIC: user-write? ( obj -- ? ) +GENERIC: user-execute? ( obj -- ? ) +GENERIC: group-read? ( obj -- ? ) +GENERIC: group-write? ( obj -- ? ) +GENERIC: group-execute? ( obj -- ? ) +GENERIC: other-read? ( obj -- ? ) +GENERIC: other-write? ( obj -- ? ) +GENERIC: other-execute? ( obj -- ? ) + +M: integer uid? ( integer -- ? ) UID mask? ; +M: integer gid? ( integer -- ? ) GID mask? ; +M: integer sticky? ( integer -- ? ) STICKY mask? ; +M: integer user-read? ( integer -- ? ) USER-READ mask? ; +M: integer user-write? ( integer -- ? ) USER-WRITE mask? ; +M: integer user-execute? ( integer -- ? ) USER-EXECUTE mask? ; +M: integer group-read? ( integer -- ? ) GROUP-READ mask? ; +M: integer group-write? ( integer -- ? ) GROUP-WRITE mask? ; +M: integer group-execute? ( integer -- ? ) GROUP-EXECUTE mask? ; +M: integer other-read? ( integer -- ? ) OTHER-READ mask? ; +M: integer other-write? ( integer -- ? ) OTHER-WRITE mask? ; +M: integer other-execute? ( integer -- ? ) OTHER-EXECUTE mask? ; + +M: string uid? ( path -- ? ) UID file-mode? ; +M: string gid? ( path -- ? ) GID file-mode? ; +M: string sticky? ( path -- ? ) STICKY file-mode? ; +M: string user-read? ( path -- ? ) USER-READ file-mode? ; +M: string user-write? ( path -- ? ) USER-WRITE file-mode? ; +M: string user-execute? ( path -- ? ) USER-EXECUTE file-mode? ; +M: string group-read? ( path -- ? ) GROUP-READ file-mode? ; +M: string group-write? ( path -- ? ) GROUP-WRITE file-mode? ; +M: string group-execute? ( path -- ? ) GROUP-EXECUTE file-mode? ; +M: string other-read? ( path -- ? ) OTHER-READ file-mode? ; +M: string other-write? ( path -- ? ) OTHER-WRITE file-mode? ; +M: string other-execute? ( path -- ? ) OTHER-EXECUTE file-mode? ; : set-uid ( path ? -- ) UID swap chmod-set-bit ; : set-gid ( path ? -- ) GID swap chmod-set-bit ;