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

user-read? is now generic, can take a filename or an integer from a stat struct

db4
Doug Coleman 2008-10-18 17:29:38 -05:00
parent b5dbda1948
commit 6aadd70623
3 changed files with 87 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
basis/io/unix/files/files-docs.factor
View File

@ -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:"

26
basis/io/unix/files/files-tests.factor
View File

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

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

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