Merge branch 'master' of github.com:erg/factor

diff --git a/basis/unix/groups/groups-docs.factor b/basis/unix/groups/groups-docs.factor
index 3afe344d53a0263c26afb11024cb56b29800b72b..e75e320ab97ae221ae505181ed57c6ce0c9ac0db 100644 (file)
--- a/basis/unix/groups/groups-docs.factor
+++ b/basis/unix/groups/groups-docs.factor
@@ -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."

diff --git a/basis/unix/groups/groups-tests.factor b/basis/unix/groups/groups-tests.factor
index eae202007760030b07eaecefba45a2ab09558930..bdb059cbca2c875a8f2bd3ea0d301e4f3659a092 100644 (file)
--- a/basis/unix/groups/groups-tests.factor
+++ b/basis/unix/groups/groups-tests.factor
@@ -27,3 +27,7 @@ IN: unix.groups.tests
 [ "888888888888888" ] [ 888888888888888 group-name ] unit-test
 [ 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

diff --git a/basis/unix/groups/groups.factor b/basis/unix/groups/groups.factor
index 7be124ced4c2f2568927259f4192d80e6c2eedcb..e6eff0f6e190e5ec105a24b22c9bf893d78cea48 100644 (file)
--- a/basis/unix/groups/groups.factor
+++ b/basis/unix/groups/groups.factor
@@ -61,6 +61,11 @@ PRIVATE>
 : group-id ( string -- id/f )
     group-struct dup [ gr_gid>> ] when ;
 
+ERROR: no-group string ;
+
+: ?group-id ( string -- id )
+    dup group-struct [ nip gr_gid>> ] [ no-group ] if* ;
+
 <PRIVATE
 
 : >groups ( byte-array n -- groups )
@@ -104,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 -- )
@@ -122,14 +133,14 @@ GENERIC: set-effective-group ( obj -- )
 
 PRIVATE>
     
-M: string set-real-group ( string -- )
-    group-id (set-real-group) ;
-
 M: integer set-real-group ( id -- )
     (set-real-group) ;
 
+M: string set-real-group ( string -- )
+    ?group-id (set-real-group) ;
+
 M: integer set-effective-group ( id -- )    
     (set-effective-group) ;
 
 M: string set-effective-group ( string -- )
-    group-id (set-effective-group) ;
+    ?group-id (set-effective-group) ;

diff --git a/basis/unix/users/users-docs.factor b/basis/unix/users/users-docs.factor
index e676f6fef646ff840c91023a93ba302750e3e14f..8cc9585cb93d747aad6d36017575a9697820692c 100644 (file)
--- a/basis/unix/users/users-docs.factor
+++ b/basis/unix/users/users-docs.factor
@@ -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

diff --git a/basis/unix/users/users-tests.factor b/basis/unix/users/users-tests.factor
index f2059a1a8c51c7bb74b03abcb258b3d478b65169..0093f0ee4b53e65bab218e13f496ca263bafc816 100644 (file)
--- a/basis/unix/users/users-tests.factor
+++ b/basis/unix/users/users-tests.factor
@@ -27,3 +27,7 @@ IN: unix.users.tests
 [ f ] [ 89898989898989898989898989898 user-passwd ] unit-test
 
 [ 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

diff --git a/basis/unix/users/users.factor b/basis/unix/users/users.factor
index 0575538b87aa8cc256b0871c7254e0753ce1def9..3abca314ac6feae9a98145d964470de6d1b07ca4 100644 (file)
--- a/basis/unix/users/users.factor
+++ b/basis/unix/users/users.factor
@@ -64,6 +64,11 @@ M: string user-passwd ( string -- passwd/f )
 : user-id ( string -- id/f )
     user-passwd dup [ uid>> ] when ;
 
+ERROR: no-user string ;
+
+: ?user-id ( string -- id/f )
+    dup user-passwd [ nip uid>> ] [ no-user ] if* ;
+
 : real-user-id ( -- id )
     unix.ffi:getuid ; inline
 
@@ -80,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 -- )
@@ -100,17 +111,17 @@ GENERIC: set-effective-user ( string/id -- )
 
 PRIVATE>
 
-M: string set-real-user ( string -- )
-    user-id (set-real-user) ;
-
 M: integer set-real-user ( id -- )
     (set-real-user) ;
 
+M: string set-real-user ( string -- )
+    ?user-id (set-real-user) ;
+
 M: integer set-effective-user ( id -- )
     (set-effective-user) ; 
 
 M: string set-effective-user ( string -- )
-    user-id (set-effective-user) ;
+    ?user-id (set-effective-user) ;
 
 os {
     { [ dup bsd? ] [ drop "unix.users.bsd" require ] }