Fix a bug when calling all-groups twice. Add some users/groups utility words, unit tests, and docs.
Doug Coleman
parent
c53a11bef9
commit
58de929a42
|
|
@ -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 ) ;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
||||
: <group-cache> ( -- 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 -- )
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
: <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 -- )
|
||||
|
|
|
|||
Loading…
Reference in New Issue