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

add users tests, fix naming inconsistencies

db4
Doug Coleman 2008-10-08 13:22:53 -05:00
parent e7e0e7ad69
commit f026177e27
3 changed files with 65 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
basis/unix/users/users-docs.factor
View File

@ -15,7 +15,7 @@ HELP: effective-username
{ "string" string } }
{ $description "Returns the effective username for the current user." } ;
HELP: effective-username-id
HELP: effective-user-id
{ $values
{ "id" integer } }
@ -45,21 +45,21 @@ HELP: real-username
{ "string" string } }
{ $description "The real username of the current user." } ;
HELP: real-username-id
HELP: real-user-id
{ $values
{ "id" integer } }
{ $description "The real user id of the current user." } ;
HELP: set-effective-username
HELP: set-effective-user
{ $values
{ "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
{ "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
{ $values
@ -73,13 +73,13 @@ HELP: username
{ "string" string } }
{ $description "Returns the username associated with the user id." } ;
HELP: username-id
HELP: user-id
{ $values
{ "string" string }
{ "id" integer } }
{ $description "Returns the user id associated with the username." } ;
HELP: with-effective-username
HELP: with-effective-user
{ $values
{ "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." } ;
@ -89,15 +89,15 @@ HELP: with-passwd-cache
{ "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." } ;
HELP: with-real-username
HELP: with-real-user
{ $values
{ "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." } ;
{
real-username real-username-id set-real-username
effective-username effective-username-id
set-effective-username
real-username real-user-id set-real-user
effective-username effective-user-id
set-effective-user
} related-words
ARTICLE: "unix.users" "unix.users"
@ -107,14 +107,14 @@ ARTICLE: "unix.users" "unix.users"
"Returning a passwd tuple:"
"Real user:"
{ $subsection real-username }
{ $subsection real-username-id }
{ $subsection set-real-username }
{ $subsection real-user-id }
{ $subsection set-real-user }
"Effective user:"
{ $subsection effective-username }
{ $subsection effective-username-id }
{ $subsection set-effective-username }
{ $subsection effective-user-id }
{ $subsection set-effective-user }
"Combinators to change users:"
{ $subsection with-real-username }
{ $subsection with-effective-username } ;
{ $subsection with-real-user }
{ $subsection with-effective-user } ;
ABOUT: "unix.users"

24
basis/unix/users/users-tests.factor Normal file
View File

@ -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

46
basis/unix/users/users.factor
View File

@ -57,56 +57,56 @@ M: string user-passwd ( string -- passwd/f )
: username ( id -- string )
user-passwd username>> ;
: username-id ( string -- id )
: user-id ( string -- id )
user-passwd uid>> ;
: real-username-id ( -- id )
: real-user-id ( -- id )
getuid ; inline
: real-username ( -- string )
real-username-id username ; inline
real-user-id username ; inline
: effective-username-id ( -- id )
: effective-user-id ( -- id )
geteuid ; inline
: 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 -- )
'[ _ set-real-username @ ]
real-username-id '[ _ set-real-username ]
: with-real-user ( string/id quot -- )
'[ _ set-real-user @ ]
real-user-id '[ _ set-real-user ]
[ ] cleanup ; inline
: with-effective-username ( string/id quot -- )
'[ _ set-effective-username @ ]
effective-username-id '[ _ set-effective-username ]
: with-effective-user ( string/id quot -- )
'[ _ set-effective-user @ ]
effective-user-id '[ _ set-effective-user ]
[ ] cleanup ; inline
<PRIVATE
: (set-real-username) ( id -- )
: (set-real-user) ( id -- )
setuid io-error ; inline
: (set-effective-username) ( id -- )
: (set-effective-user) ( id -- )
seteuid io-error ; inline
PRIVATE>
M: string set-real-username ( string -- )
username-id (set-real-username) ;
M: string set-real-user ( string -- )
user-id (set-real-user) ;
M: integer set-real-username ( id -- )
(set-real-username) ;
M: integer set-real-user ( id -- )
(set-real-user) ;
M: integer set-effective-username ( id -- )
(set-effective-username) ;
M: integer set-effective-user ( id -- )
(set-effective-user) ;
M: string set-effective-username ( string -- )
username-id (set-effective-username) ;
M: string set-effective-user ( string -- )
user-id (set-effective-user) ;
os {
{ [ dup bsd? ] [ drop "unix.users.bsd" require ] }