Fix a couple bugs in unix.users and add unit tests
parent
e626431a7e
commit
ffe0aac310
|
@ -50,7 +50,7 @@ HELP: set-real-user
|
||||||
HELP: user-passwd
|
HELP: user-passwd
|
||||||
{ $values
|
{ $values
|
||||||
{ "obj" object }
|
{ "obj" object }
|
||||||
{ "passwd" passwd } }
|
{ "passwd/f" "passwd or f" } }
|
||||||
{ $description "Returns the passwd tuple given a username string or user id." } ;
|
{ $description "Returns the passwd tuple given a username string or user id." } ;
|
||||||
|
|
||||||
HELP: username
|
HELP: username
|
||||||
|
|
|
@ -24,3 +24,7 @@ IN: unix.users.tests
|
||||||
[ ] [ effective-user-id [ ] with-effective-user ] unit-test
|
[ ] [ effective-user-id [ ] with-effective-user ] unit-test
|
||||||
|
|
||||||
[ ] [ [ ] with-user-cache ] unit-test
|
[ ] [ [ ] with-user-cache ] unit-test
|
||||||
|
|
||||||
|
[ "9999999999999999999" ] [ 9999999999999999999 username ] unit-test
|
||||||
|
|
||||||
|
[ f ] [ 89898989898989898989898989898 user-passwd ] unit-test
|
||||||
|
|
|
@ -47,17 +47,18 @@ SYMBOL: user-cache
|
||||||
: with-user-cache ( quot -- )
|
: with-user-cache ( quot -- )
|
||||||
[ <user-cache> user-cache ] dip with-variable ; inline
|
[ <user-cache> user-cache ] dip with-variable ; inline
|
||||||
|
|
||||||
GENERIC: user-passwd ( obj -- passwd )
|
GENERIC: user-passwd ( obj -- passwd/f )
|
||||||
|
|
||||||
M: integer user-passwd ( id -- passwd/f )
|
M: integer user-passwd ( id -- passwd/f )
|
||||||
user-cache get
|
user-cache get
|
||||||
[ at ] [ getpwuid passwd>new-passwd ] if* ;
|
[ at ] [ getpwuid [ passwd>new-passwd ] [ f ] if* ] if* ;
|
||||||
|
|
||||||
M: string user-passwd ( string -- passwd/f )
|
M: string user-passwd ( string -- passwd/f )
|
||||||
getpwnam dup [ passwd>new-passwd ] when ;
|
getpwnam dup [ passwd>new-passwd ] when ;
|
||||||
|
|
||||||
: username ( id -- string )
|
: username ( id -- string )
|
||||||
user-passwd username>> ;
|
dup user-passwd
|
||||||
|
[ nip username>> ] [ number>string ] if* ;
|
||||||
|
|
||||||
: user-id ( string -- id )
|
: user-id ( string -- id )
|
||||||
user-passwd uid>> ;
|
user-passwd uid>> ;
|
||||||
|
|
Loading…
Reference in New Issue