diff --git a/basis/unix/ffi/ffi.factor b/basis/unix/ffi/ffi.factor index 26cdc22bc1..640c7df5b6 100644 --- a/basis/unix/ffi/ffi.factor +++ b/basis/unix/ffi/ffi.factor @@ -94,6 +94,7 @@ FUNCTION: int getpriority ( int which, id_t who ) ; FUNCTION: int setpriority ( int which, id_t who, int prio ) ; FUNCTION: int getrusage ( int who, rusage* r_usage ) ; FUNCTION: group* getgrent ; +FUNCTION: void endgrent ( ) ; FUNCTION: int gethostname ( c-string name, int len ) ; FUNCTION: int getsockname ( int socket, sockaddr* address, socklen_t* address_len ) ; FUNCTION: int getpeername ( int socket, sockaddr* address, socklen_t* address_len ) ; diff --git a/basis/unix/groups/groups-docs.factor b/basis/unix/groups/groups-docs.factor index e75e320ab9..31d1fe8ac4 100644 --- a/basis/unix/groups/groups-docs.factor +++ b/basis/unix/groups/groups-docs.factor @@ -78,11 +78,36 @@ HELP: with-real-group { "string/id/f" "a string or a group id" } { "quot" quotation } } { $description "Sets the real group name and calls the quotation. Restores the current group name on success or on error after the call. If the first parameter is " { $link f } ", the quotation is called as the current user." } ; +HELP: ?group-id +{ $values + { "string" string } + { "id" "a group id" } +} +{ $description "Returns a group id or throws an exception." } ; + +HELP: all-group-names +{ $values + + { "seq" sequence } +} +{ $description "Returns a sequence of group names as strings." } ; + +HELP: group-exists? +{ $values + { "name/id" "a name or a group id" } + { "?" boolean } +} +{ $description "Returns a boolean representing the group's existence." } ; + ARTICLE: "unix.groups" "Unix groups" "The " { $vocab-link "unix.groups" } " vocabulary contains words that return information about Unix groups." $nl -"Listing all groups:" +"Listing all group structures:" { $subsections all-groups } +"Listing all group names:" +{ $subsections all-group-names } +"Checking if a group exists:" +{ $subsections group-exists? } "Real groups:" { $subsections real-group-name @@ -95,6 +120,10 @@ $nl effective-group-id set-effective-group } +"Getting a group id from a group name or id:" +{ $subsections + ?group-id +} "Combinators to change groups:" { $subsections with-real-group diff --git a/basis/unix/groups/groups-tests.factor b/basis/unix/groups/groups-tests.factor index bdb059cbca..4f3b0172ac 100644 --- a/basis/unix/groups/groups-tests.factor +++ b/basis/unix/groups/groups-tests.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: tools.test unix.groups kernel strings math ; +USING: kernel math sequences strings tools.test unix.groups ; IN: unix.groups.tests [ ] [ all-groups drop ] unit-test @@ -25,9 +25,15 @@ IN: unix.groups.tests [ ] [ real-group-id group-name drop ] unit-test [ "888888888888888" ] [ 888888888888888 group-name ] unit-test -[ f ] -[ "please-oh-please-don't-have-a-group-named-this123lalala" group-struct ] unit-test +[ f ] [ "please-oh-please-don't-have-a-group-named-this123lalala" group-struct ] unit-test +[ f ] [ "please-oh-please-don't-have-a-group-named-this123lalala" group-exists? ] unit-test [ "please-oh-please-don't-have-a-group-named-this123lalala" ?group-id ] must-fail [ 3 ] [ f [ 3 ] with-effective-group ] unit-test [ 3 ] [ f [ 3 ] with-real-group ] unit-test + +[ f ] +[ all-groups drop all-groups empty? ] unit-test + +[ f ] +[ all-group-names drop all-group-names empty? ] unit-test diff --git a/basis/unix/groups/groups.factor b/basis/unix/groups/groups.factor index e6eff0f6e1..5da7c189ae 100644 --- a/basis/unix/groups/groups.factor +++ b/basis/unix/groups/groups.factor @@ -1,15 +1,13 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.c-types alien.strings io.encodings.utf8 -io.backend.unix kernel math sequences splitting strings -combinators.short-circuit byte-arrays combinators -accessors math.parser fry assocs namespaces continuations -unix.users unix.utilities classes.struct unix ; -IN: unix.groups - +USING: accessors alien alien.c-types alien.strings assocs +byte-arrays classes.struct combinators +combinators.short-circuit continuations fry io.backend.unix +io.encodings.utf8 kernel math math.parser namespaces sequences +splitting strings unix unix.ffi unix.users unix.utilities ; QUALIFIED: unix.ffi - QUALIFIED: grouping +IN: unix.groups TUPLE: group id name passwd members ; @@ -88,7 +86,11 @@ M: integer user-groups ( id -- seq ) user-name (user-groups) ; : all-groups ( -- seq ) - [ unix.ffi:getgrent dup ] [ group-struct>group ] produce nip ; + [ unix.ffi:getgrent dup ] [ group-struct>group ] produce nip + endgrent ; + +: all-group-names ( -- seq ) + all-groups [ name>> ] map ; : ( -- assoc ) all-groups [ [ id>> ] keep ] H{ } map>assoc ; @@ -105,6 +107,8 @@ M: integer user-groups ( id -- seq ) : effective-group-name ( -- string ) effective-group-id group-name ; inline +: group-exists? ( name/id -- ? ) group-id >boolean ; + GENERIC: set-real-group ( obj -- ) GENERIC: set-effective-group ( obj -- ) diff --git a/basis/unix/users/users-docs.factor b/basis/unix/users/users-docs.factor index 8cc9585cb9..bca41dd5fc 100644 --- a/basis/unix/users/users-docs.factor +++ b/basis/unix/users/users-docs.factor @@ -86,11 +86,36 @@ HELP: with-real-user set-effective-user } related-words +HELP: ?user-id +{ $values + { "string" string } + { "id/f" "an integer or " { $link f } } +} +{ $description "Returns a group id or throws an exception." } ; + +HELP: all-user-names +{ $values + + { "seq" sequence } +} +{ $description "Returns a sequence of group names as strings." } ; + +HELP: user-exists? +{ $values + { "name/id" "a string or an integer" } + { "?" boolean } +} +{ $description "Returns a boolean representing the user's existence." } ; + ARTICLE: "unix.users" "Unix users" "The " { $vocab-link "unix.users" } " vocabulary contains words that return information about Unix users." $nl "Listing all users:" { $subsections all-users } +"Listing all user names:" +{ $subsections all-user-names } +"Checking if a user exists:" +{ $subsections user-exists? } "Real user:" { $subsections real-user-name diff --git a/basis/unix/users/users-tests.factor b/basis/unix/users/users-tests.factor index 0093f0ee4b..5ab9a8c147 100644 --- a/basis/unix/users/users-tests.factor +++ b/basis/unix/users/users-tests.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: tools.test unix.users kernel strings math ; +USING: tools.test unix.users kernel strings math sequences ; IN: unix.users.tests [ ] [ all-users drop ] unit-test @@ -27,7 +27,14 @@ IN: unix.users.tests [ f ] [ 89898989898989898989898989898 user-passwd ] unit-test [ f ] [ "thisusershouldnotexistabcdefg12345asdfasdfasdfasdfasdfasdfasdf" user-id ] unit-test +[ f ] [ "thisusershouldnotexistabcdefg12345asdfasdfasdfasdfasdfasdfasdf" user-exists? ] unit-test [ "thisusershouldnotexistabcdefg12345asdfasdfasdfasdfasdfasdfasdf" ?user-id ] must-fail [ 3 ] [ f [ 3 ] with-effective-user ] unit-test [ 3 ] [ f [ 3 ] with-real-user ] unit-test + +[ f ] +[ all-users drop all-users empty? ] unit-test + +[ f ] +[ all-user-names drop all-user-names empty? ] unit-test diff --git a/basis/unix/users/users.factor b/basis/unix/users/users.factor index 3abca314ac..cd0eb7ada3 100644 --- a/basis/unix/users/users.factor +++ b/basis/unix/users/users.factor @@ -40,6 +40,9 @@ PRIVATE> [ unix.ffi:getpwent dup ] [ passwd>new-passwd ] produce nip ] with-pwent ; +: all-user-names ( -- seq ) + all-users [ user-name>> ] map ; + SYMBOL: user-cache : ( -- assoc ) @@ -81,6 +84,8 @@ ERROR: no-user string ; : effective-user-name ( -- string ) effective-user-id user-name ; inline +: user-exists? ( name/id -- ? ) user-id >boolean ; + GENERIC: set-real-user ( string/id -- ) GENERIC: set-effective-user ( string/id -- )