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

Allow with-*-group/user to be a no-op if first parameter is f

db4
Doug Coleman 2010-06-17 13:20:51 -05:00
parent 27af7ffe50
commit 82f38ce9a1
6 changed files with 30 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -65,8 +65,8 @@ HELP: user-groups
HELP: with-effective-group
{ $values
{ "string/id" "a string or a group id" } { "quot" quotation } }
{ $description "Sets the effective group name and calls the quotation. Restors the effective group name on success or on error after the call." } ;
{ "string/id/f" "a string, a group id, or f" } { "quot" quotation } }
{ $description "Sets the effective group name and calls the quotation. Restors the effective group name on success or on error after the call. If the first parameter is " { $link f } ", the quotation is called as the current user." } ;
HELP: with-group-cache
{ $values
@ -75,8 +75,8 @@ HELP: with-group-cache
HELP: with-real-group
{ $values
{ "string/id" "a string or a group id" } { "quot" quotation } }
{ $description "Sets the real group name and calls the quotation. Restores the current group name on success or on error after the call." } ;
{ "string/id/f" "a string or a group id" } { "quot" quotation } }
{ $description "Sets the real group name and calls the quotation. Restores the current group name on success or on error after the call. If the first parameter is " { $link f } ", the quotation is called as the current user." } ;
ARTICLE: "unix.groups" "Unix groups"
"The " { $vocab-link "unix.groups" } " vocabulary contains words that return information about Unix groups."

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

@ -28,3 +28,6 @@ IN: unix.groups.tests
[ f ]
[ "please-oh-please-don't-have-a-group-named-this123lalala" group-struct ] unit-test
[ "please-oh-please-don't-have-a-group-named-this123lalala" ?group-id ] must-fail
[ 3 ] [ f [ 3 ] with-effective-group ] unit-test
[ 3 ] [ f [ 3 ] with-real-group ] unit-test

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

@ -109,14 +109,20 @@ GENERIC: set-real-group ( obj -- )
GENERIC: set-effective-group ( obj -- )
: with-real-group ( string/id quot -- )
: (with-real-group) ( string/id quot -- )
'[ _ set-real-group @ ]
real-group-id '[ _ set-real-group ] [ ] cleanup ; inline
: with-effective-group ( string/id quot -- )
: with-real-group ( string/id/f quot -- )
over [ (with-real-group) ] [ nip call ] if ; inline
: (with-effective-group) ( string/id quot -- )
'[ _ set-effective-group @ ]
effective-group-id '[ _ set-effective-group ] [ ] cleanup ; inline
: with-effective-group ( string/id/f quot -- )
over [ (with-effective-group) ] [ nip call ] if ; inline
<PRIVATE
: (set-real-group) ( id -- )

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

@ -67,8 +67,8 @@ HELP: user-id
HELP: with-effective-user
{ $values
{ "string/id" "a string or a uid" } { "quot" quotation } }
{ $description "Sets the effective user-name and calls the quotation. Restores the current user-name on success or on error after the call." } ;
{ "string/id/f" "a string, a uid, or f" } { "quot" quotation } }
{ $description "Sets the effective user-name and calls the quotation. Restores the current user-name on success or on error after the call. If the first parameter is " { $link f } ", the quotation is called as the current user." } ;
HELP: with-user-cache
{ $values
@ -77,8 +77,8 @@ HELP: with-user-cache
HELP: with-real-user
{ $values
{ "string/id" "a string or a uid" } { "quot" quotation } }
{ $description "Sets the real user-name and calls the quotation. Restores the current user-name on success or on error after the call." } ;
{ "string/id/f" "a string, a uid, or f" } { "quot" quotation } }
{ $description "Sets the real user-name and calls the quotation. Restores the current user-name on success or on error after the call. If the first parameter is " { $link f } ", the quotation is called as the current user." } ;
{
real-user-name real-user-id set-real-user

3
basis/unix/users/users-tests.factor
View File

@ -28,3 +28,6 @@ IN: unix.users.tests
[ f ] [ "thisusershouldnotexistabcdefg12345asdfasdfasdfasdfasdfasdfasdf" user-id ] unit-test
[ "thisusershouldnotexistabcdefg12345asdfasdfasdfasdfasdfasdfasdf" ?user-id ] must-fail
[ 3 ] [ f [ 3 ] with-effective-user ] unit-test
[ 3 ] [ f [ 3 ] with-real-user ] unit-test

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

@ -85,16 +85,22 @@ GENERIC: set-real-user ( string/id -- )
GENERIC: set-effective-user ( string/id -- )
: with-real-user ( string/id quot -- )
: (with-real-user) ( string/id quot -- )
'[ _ set-real-user @ ]
real-user-id '[ _ set-real-user ]
[ ] cleanup ; inline
: with-effective-user ( string/id quot -- )
: with-real-user ( string/id/f quot -- )
over [ (with-real-user) ] [ nip call ] if ; inline
: (with-effective-user) ( string/id quot -- )
'[ _ set-effective-user @ ]
effective-user-id '[ _ set-effective-user ]
[ ] cleanup ; inline
: with-effective-user ( string/id/f quot -- )
over [ (with-effective-user) ] [ nip call ] if ; inline
<PRIVATE
: (set-real-user) ( id -- )