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

fix group-name on netbsd

db4
Doug Coleman 2009-01-09 15:28:10 -06:00
parent 2714de3b85
commit 56808874f1
3 changed files with 17 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
basis/unix/groups/groups-docs.factor
View File

@ -24,8 +24,8 @@ HELP: group-cache
HELP: group-id
{ $values
{ "string" string }
{ "id" integer } }
{ $description "Returns the group id given a group name." } ;
{ "id/f" "an integer or f" } }
{ $description "Returns the group id given a group name. Returns " { $link f } " if the group does not exist." } ;
HELP: group-name
{ $values
@ -36,7 +36,7 @@ HELP: group-name
HELP: group-struct
{ $values
{ "obj" object }
{ "group" "a group struct" } }
{ "group/f" "a group struct or f" } }
{ $description "Returns an alien group struct to be turned into a group tuple by calling subsequent words." } ;
HELP: real-group-id

2
basis/unix/groups/groups-tests.factor
View File

@ -27,3 +27,5 @@ 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

20
basis/unix/groups/groups.factor
View File

@ -13,7 +13,7 @@ TUPLE: group id name passwd members ;
SYMBOL: group-cache
GENERIC: group-struct ( obj -- group )
GENERIC: group-struct ( obj -- group/f )
<PRIVATE
@ -24,11 +24,14 @@ GENERIC: group-struct ( obj -- group )
"group" <c-object> tuck 4096
[ <byte-array> ] keep f <void*> ;
M: integer group-struct ( id -- group )
(group-struct) getgrgid_r io-error ;
: check-group-struct ( group-struct ptr -- group-struct/f )
*void* [ drop f ] unless ;
M: string group-struct ( string -- group )
(group-struct) getgrnam_r 0 = [ (io-error) ] unless ;
M: integer group-struct ( id -- group/f )
(group-struct) [ getgrgid_r io-error ] keep check-group-struct ;
M: string group-struct ( string -- group/f )
(group-struct) [ getgrnam_r io-error ] keep check-group-struct ;
: group-struct>group ( group-struct -- group )
[ \ group new ] dip
@ -43,14 +46,15 @@ PRIVATE>
: group-name ( id -- string )
dup group-cache get [
"yo" print
dupd at* [ name>> nip ] [ drop number>string ] if
] [
group-struct group-gr_name
group-struct [ group-gr_name ] [ f ] if*
] if*
[ nip ] [ number>string ] if* ;
: group-id ( string -- id )
group-struct group-gr_gid ;
: group-id ( string -- id/f )
group-struct [ group-gr_gid ] [ f ] if* ;
<PRIVATE