add users tests, fix naming inconsistencies
parent
e7e0e7ad69
commit
f026177e27
|
@ -15,7 +15,7 @@ HELP: effective-username
|
||||||
{ "string" string } }
|
{ "string" string } }
|
||||||
{ $description "Returns the effective username for the current user." } ;
|
{ $description "Returns the effective username for the current user." } ;
|
||||||
|
|
||||||
HELP: effective-username-id
|
HELP: effective-user-id
|
||||||
{ $values
|
{ $values
|
||||||
|
|
||||||
{ "id" integer } }
|
{ "id" integer } }
|
||||||
|
@ -45,21 +45,21 @@ HELP: real-username
|
||||||
{ "string" string } }
|
{ "string" string } }
|
||||||
{ $description "The real username of the current user." } ;
|
{ $description "The real username of the current user." } ;
|
||||||
|
|
||||||
HELP: real-username-id
|
HELP: real-user-id
|
||||||
{ $values
|
{ $values
|
||||||
|
|
||||||
{ "id" integer } }
|
{ "id" integer } }
|
||||||
{ $description "The real user id of the current user." } ;
|
{ $description "The real user id of the current user." } ;
|
||||||
|
|
||||||
HELP: set-effective-username
|
HELP: set-effective-user
|
||||||
{ $values
|
{ $values
|
||||||
{ "string/id" "a string or a user id" } }
|
{ "string/id" "a string or a user id" } }
|
||||||
{ $description "Sets the current effective username." } ;
|
{ $description "Sets the current effective user given a username or a user id." } ;
|
||||||
|
|
||||||
HELP: set-real-username
|
HELP: set-real-user
|
||||||
{ $values
|
{ $values
|
||||||
{ "string/id" "a string or a user id" } }
|
{ "string/id" "a string or a user id" } }
|
||||||
{ $description "Sets the current real username." } ;
|
{ $description "Sets the current real user given a username or a user id." } ;
|
||||||
|
|
||||||
HELP: user-passwd
|
HELP: user-passwd
|
||||||
{ $values
|
{ $values
|
||||||
|
@ -73,13 +73,13 @@ HELP: username
|
||||||
{ "string" string } }
|
{ "string" string } }
|
||||||
{ $description "Returns the username associated with the user id." } ;
|
{ $description "Returns the username associated with the user id." } ;
|
||||||
|
|
||||||
HELP: username-id
|
HELP: user-id
|
||||||
{ $values
|
{ $values
|
||||||
{ "string" string }
|
{ "string" string }
|
||||||
{ "id" integer } }
|
{ "id" integer } }
|
||||||
{ $description "Returns the user id associated with the username." } ;
|
{ $description "Returns the user id associated with the username." } ;
|
||||||
|
|
||||||
HELP: with-effective-username
|
HELP: with-effective-user
|
||||||
{ $values
|
{ $values
|
||||||
{ "string/id" "a string or a uid" } { "quot" quotation } }
|
{ "string/id" "a string or a uid" } { "quot" quotation } }
|
||||||
{ $description "Sets the effective username and calls the quotation. Restores the current username on success or on error after the call." } ;
|
{ $description "Sets the effective username and calls the quotation. Restores the current username on success or on error after the call." } ;
|
||||||
|
@ -89,15 +89,15 @@ HELP: with-passwd-cache
|
||||||
{ "quot" quotation } }
|
{ "quot" quotation } }
|
||||||
{ $description "Iterates over the password file using library calls and creates a cache in the " { $link passwd-cache } " symbol. The cache is a hashtable indexed by user id. When looking up many users, this approach is much faster than calling system calls." } ;
|
{ $description "Iterates over the password file using library calls and creates a cache in the " { $link passwd-cache } " symbol. The cache is a hashtable indexed by user id. When looking up many users, this approach is much faster than calling system calls." } ;
|
||||||
|
|
||||||
HELP: with-real-username
|
HELP: with-real-user
|
||||||
{ $values
|
{ $values
|
||||||
{ "string/id" "a string or a uid" } { "quot" quotation } }
|
{ "string/id" "a string or a uid" } { "quot" quotation } }
|
||||||
{ $description "Sets the real username and calls the quotation. Restores the current username on success or on error after the call." } ;
|
{ $description "Sets the real username and calls the quotation. Restores the current username on success or on error after the call." } ;
|
||||||
|
|
||||||
{
|
{
|
||||||
real-username real-username-id set-real-username
|
real-username real-user-id set-real-user
|
||||||
effective-username effective-username-id
|
effective-username effective-user-id
|
||||||
set-effective-username
|
set-effective-user
|
||||||
} related-words
|
} related-words
|
||||||
|
|
||||||
ARTICLE: "unix.users" "unix.users"
|
ARTICLE: "unix.users" "unix.users"
|
||||||
|
@ -107,14 +107,14 @@ ARTICLE: "unix.users" "unix.users"
|
||||||
"Returning a passwd tuple:"
|
"Returning a passwd tuple:"
|
||||||
"Real user:"
|
"Real user:"
|
||||||
{ $subsection real-username }
|
{ $subsection real-username }
|
||||||
{ $subsection real-username-id }
|
{ $subsection real-user-id }
|
||||||
{ $subsection set-real-username }
|
{ $subsection set-real-user }
|
||||||
"Effective user:"
|
"Effective user:"
|
||||||
{ $subsection effective-username }
|
{ $subsection effective-username }
|
||||||
{ $subsection effective-username-id }
|
{ $subsection effective-user-id }
|
||||||
{ $subsection set-effective-username }
|
{ $subsection set-effective-user }
|
||||||
"Combinators to change users:"
|
"Combinators to change users:"
|
||||||
{ $subsection with-real-username }
|
{ $subsection with-real-user }
|
||||||
{ $subsection with-effective-username } ;
|
{ $subsection with-effective-user } ;
|
||||||
|
|
||||||
ABOUT: "unix.users"
|
ABOUT: "unix.users"
|
||||||
|
|
|
@ -0,0 +1,24 @@
|
||||||
|
! Copyright (C) 2008 Doug Coleman.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: tools.test unix.users kernel strings math ;
|
||||||
|
IN: unix.users.tests
|
||||||
|
|
||||||
|
|
||||||
|
[ ] [ all-users drop ] unit-test
|
||||||
|
|
||||||
|
\ all-users must-infer
|
||||||
|
|
||||||
|
[ t ] [ real-username string? ] unit-test
|
||||||
|
[ t ] [ effective-username string? ] unit-test
|
||||||
|
|
||||||
|
[ t ] [ real-user-id integer? ] unit-test
|
||||||
|
[ t ] [ effective-user-id integer? ] unit-test
|
||||||
|
|
||||||
|
[ ] [ real-user-id set-real-user ] unit-test
|
||||||
|
[ ] [ effective-user-id set-effective-user ] unit-test
|
||||||
|
|
||||||
|
[ ] [ real-username [ ] with-real-user ] unit-test
|
||||||
|
[ ] [ real-user-id [ ] with-real-user ] unit-test
|
||||||
|
|
||||||
|
[ ] [ effective-username [ ] with-effective-user ] unit-test
|
||||||
|
[ ] [ effective-user-id [ ] with-effective-user ] unit-test
|
|
@ -57,56 +57,56 @@ M: string user-passwd ( string -- passwd/f )
|
||||||
: username ( id -- string )
|
: username ( id -- string )
|
||||||
user-passwd username>> ;
|
user-passwd username>> ;
|
||||||
|
|
||||||
: username-id ( string -- id )
|
: user-id ( string -- id )
|
||||||
user-passwd uid>> ;
|
user-passwd uid>> ;
|
||||||
|
|
||||||
: real-username-id ( -- id )
|
: real-user-id ( -- id )
|
||||||
getuid ; inline
|
getuid ; inline
|
||||||
|
|
||||||
: real-username ( -- string )
|
: real-username ( -- string )
|
||||||
real-username-id username ; inline
|
real-user-id username ; inline
|
||||||
|
|
||||||
: effective-username-id ( -- id )
|
: effective-user-id ( -- id )
|
||||||
geteuid ; inline
|
geteuid ; inline
|
||||||
|
|
||||||
: effective-username ( -- string )
|
: effective-username ( -- string )
|
||||||
effective-username-id username ; inline
|
effective-user-id username ; inline
|
||||||
|
|
||||||
GENERIC: set-real-username ( string/id -- )
|
GENERIC: set-real-user ( string/id -- )
|
||||||
|
|
||||||
GENERIC: set-effective-username ( string/id -- )
|
GENERIC: set-effective-user ( string/id -- )
|
||||||
|
|
||||||
: with-real-username ( string/id quot -- )
|
: with-real-user ( string/id quot -- )
|
||||||
'[ _ set-real-username @ ]
|
'[ _ set-real-user @ ]
|
||||||
real-username-id '[ _ set-real-username ]
|
real-user-id '[ _ set-real-user ]
|
||||||
[ ] cleanup ; inline
|
[ ] cleanup ; inline
|
||||||
|
|
||||||
: with-effective-username ( string/id quot -- )
|
: with-effective-user ( string/id quot -- )
|
||||||
'[ _ set-effective-username @ ]
|
'[ _ set-effective-user @ ]
|
||||||
effective-username-id '[ _ set-effective-username ]
|
effective-user-id '[ _ set-effective-user ]
|
||||||
[ ] cleanup ; inline
|
[ ] cleanup ; inline
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
: (set-real-username) ( id -- )
|
: (set-real-user) ( id -- )
|
||||||
setuid io-error ; inline
|
setuid io-error ; inline
|
||||||
|
|
||||||
: (set-effective-username) ( id -- )
|
: (set-effective-user) ( id -- )
|
||||||
seteuid io-error ; inline
|
seteuid io-error ; inline
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
M: string set-real-username ( string -- )
|
M: string set-real-user ( string -- )
|
||||||
username-id (set-real-username) ;
|
user-id (set-real-user) ;
|
||||||
|
|
||||||
M: integer set-real-username ( id -- )
|
M: integer set-real-user ( id -- )
|
||||||
(set-real-username) ;
|
(set-real-user) ;
|
||||||
|
|
||||||
M: integer set-effective-username ( id -- )
|
M: integer set-effective-user ( id -- )
|
||||||
(set-effective-username) ;
|
(set-effective-user) ;
|
||||||
|
|
||||||
M: string set-effective-username ( string -- )
|
M: string set-effective-user ( string -- )
|
||||||
username-id (set-effective-username) ;
|
user-id (set-effective-user) ;
|
||||||
|
|
||||||
os {
|
os {
|
||||||
{ [ dup bsd? ] [ drop "unix.users.bsd" require ] }
|
{ [ dup bsd? ] [ drop "unix.users.bsd" require ] }
|
||||||
|
|
Loading…
Reference in New Issue