fix group-name on netbsd
parent
2714de3b85
commit
56808874f1
|
@ -24,8 +24,8 @@ HELP: group-cache
|
||||||
HELP: group-id
|
HELP: group-id
|
||||||
{ $values
|
{ $values
|
||||||
{ "string" string }
|
{ "string" string }
|
||||||
{ "id" integer } }
|
{ "id/f" "an integer or f" } }
|
||||||
{ $description "Returns the group id given a group name." } ;
|
{ $description "Returns the group id given a group name. Returns " { $link f } " if the group does not exist." } ;
|
||||||
|
|
||||||
HELP: group-name
|
HELP: group-name
|
||||||
{ $values
|
{ $values
|
||||||
|
@ -36,7 +36,7 @@ HELP: group-name
|
||||||
HELP: group-struct
|
HELP: group-struct
|
||||||
{ $values
|
{ $values
|
||||||
{ "obj" object }
|
{ "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." } ;
|
{ $description "Returns an alien group struct to be turned into a group tuple by calling subsequent words." } ;
|
||||||
|
|
||||||
HELP: real-group-id
|
HELP: real-group-id
|
||||||
|
|
|
@ -27,3 +27,5 @@ IN: unix.groups.tests
|
||||||
[ ] [ real-group-id group-name drop ] unit-test
|
[ ] [ real-group-id group-name drop ] unit-test
|
||||||
|
|
||||||
[ "888888888888888" ] [ 888888888888888 group-name ] unit-test
|
[ "888888888888888" ] [ 888888888888888 group-name ] unit-test
|
||||||
|
[ f ]
|
||||||
|
[ "please-oh-please-don't-have-a-group-named-this123lalala" group-struct ] unit-test
|
||||||
|
|
|
@ -13,7 +13,7 @@ TUPLE: group id name passwd members ;
|
||||||
|
|
||||||
SYMBOL: group-cache
|
SYMBOL: group-cache
|
||||||
|
|
||||||
GENERIC: group-struct ( obj -- group )
|
GENERIC: group-struct ( obj -- group/f )
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
|
@ -24,11 +24,14 @@ GENERIC: group-struct ( obj -- group )
|
||||||
"group" <c-object> tuck 4096
|
"group" <c-object> tuck 4096
|
||||||
[ <byte-array> ] keep f <void*> ;
|
[ <byte-array> ] keep f <void*> ;
|
||||||
|
|
||||||
M: integer group-struct ( id -- group )
|
: check-group-struct ( group-struct ptr -- group-struct/f )
|
||||||
(group-struct) getgrgid_r io-error ;
|
*void* [ drop f ] unless ;
|
||||||
|
|
||||||
M: string group-struct ( string -- group )
|
M: integer group-struct ( id -- group/f )
|
||||||
(group-struct) getgrnam_r 0 = [ (io-error) ] unless ;
|
(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-struct>group ( group-struct -- group )
|
||||||
[ \ group new ] dip
|
[ \ group new ] dip
|
||||||
|
@ -43,14 +46,15 @@ PRIVATE>
|
||||||
|
|
||||||
: group-name ( id -- string )
|
: group-name ( id -- string )
|
||||||
dup group-cache get [
|
dup group-cache get [
|
||||||
|
"yo" print
|
||||||
dupd at* [ name>> nip ] [ drop number>string ] if
|
dupd at* [ name>> nip ] [ drop number>string ] if
|
||||||
] [
|
] [
|
||||||
group-struct group-gr_name
|
group-struct [ group-gr_name ] [ f ] if*
|
||||||
] if*
|
] if*
|
||||||
[ nip ] [ number>string ] if* ;
|
[ nip ] [ number>string ] if* ;
|
||||||
|
|
||||||
: group-id ( string -- id )
|
: group-id ( string -- id/f )
|
||||||
group-struct group-gr_gid ;
|
group-struct [ group-gr_gid ] [ f ] if* ;
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue