Fix a bug when calling all-groups twice. Add some users/groups utility words, unit...

diff --git a/basis/unix/ffi/ffi.factor b/basis/unix/ffi/ffi.factor
index 26cdc22bc17b1d1fe28d530a8cd4b6221422a00c..640c7df5b63f88cd3a5ee1c40569083309f43f38 100644 (file)
--- a/basis/unix/ffi/ffi.factor
+++ b/basis/unix/ffi/ffi.factor
@@ -94,6 +94,7 @@ FUNCTION: int getpriority ( int which, id_t who ) ;
 FUNCTION: int setpriority ( int which, id_t who, int prio ) ;
 FUNCTION: int getrusage ( int who, rusage* r_usage ) ;
 FUNCTION: group* getgrent ;
+FUNCTION: void endgrent ( ) ;
 FUNCTION: int gethostname ( c-string name, int len ) ;
 FUNCTION: int getsockname ( int socket, sockaddr* address, socklen_t* address_len ) ;
 FUNCTION: int getpeername ( int socket, sockaddr* address, socklen_t* address_len ) ;

diff --git a/basis/unix/groups/groups-docs.factor b/basis/unix/groups/groups-docs.factor
index e75e320ab97ae221ae505181ed57c6ce0c9ac0db..31d1fe8ac4337412791f56bc4951621484111866 100644 (file)
--- a/basis/unix/groups/groups-docs.factor
+++ b/basis/unix/groups/groups-docs.factor
@@ -78,11 +78,36 @@ HELP: with-real-group
      { "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." } ;
 
+HELP: ?group-id
+{ $values
+    { "string" string }
+    { "id" "a group id" }
+}
+{ $description "Returns a group id or throws an exception." } ;
+
+HELP: all-group-names
+{ $values
+    
+    { "seq" sequence }
+}
+{ $description "Returns a sequence of group names as strings." } ;
+
+HELP: group-exists?
+{ $values
+    { "name/id" "a name or a group id" }
+    { "?" boolean }
+}
+{ $description "Returns a boolean representing the group's existence." } ;
+
 ARTICLE: "unix.groups" "Unix groups"
 "The " { $vocab-link "unix.groups" } " vocabulary contains words that return information about Unix groups."
 $nl
-"Listing all groups:"
+"Listing all group structures:"
 { $subsections all-groups }
+"Listing all group names:"
+{ $subsections all-group-names }
+"Checking if a group exists:"
+{ $subsections group-exists? }
 "Real groups:"
 { $subsections
     real-group-name
@@ -95,6 +120,10 @@ $nl
     effective-group-id
     set-effective-group
 }
+"Getting a group id from a group name or id:"
+{ $subsections
+    ?group-id
+}
 "Combinators to change groups:"
 { $subsections
     with-real-group

diff --git a/basis/unix/groups/groups-tests.factor b/basis/unix/groups/groups-tests.factor
index bdb059cbca2c875a8f2bd3ea0d301e4f3659a092..4f3b0172ac6cf05045a63fc16438b22ce475cf46 100644 (file)
--- a/basis/unix/groups/groups-tests.factor
+++ b/basis/unix/groups/groups-tests.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test unix.groups kernel strings math ;
+USING: kernel math sequences strings tools.test unix.groups ;
 IN: unix.groups.tests
 
 [ ] [ all-groups drop ] unit-test
@@ -25,9 +25,15 @@ IN: unix.groups.tests
 [ ] [ real-group-id group-name drop ] unit-test
 
 [ "888888888888888" ] [ 888888888888888 group-name ] unit-test
-[ f ]
-[ "please-oh-please-don't-have-a-group-named-this123lalala" group-struct ] unit-test
+[ f ] [ "please-oh-please-don't-have-a-group-named-this123lalala" group-struct ] unit-test
+[ f ] [ "please-oh-please-don't-have-a-group-named-this123lalala" group-exists? ] 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
+
+[ f ]
+[ all-groups drop all-groups empty? ] unit-test
+
+[ f ]
+[ all-group-names drop all-group-names empty? ] unit-test

diff --git a/basis/unix/groups/groups.factor b/basis/unix/groups/groups.factor
index e6eff0f6e190e5ec105a24b22c9bf893d78cea48..5da7c189aef1669d701b6590860b5645956d2684 100644 (file)
--- a/basis/unix/groups/groups.factor
+++ b/basis/unix/groups/groups.factor
@@ -1,15 +1,13 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types alien.strings io.encodings.utf8
-io.backend.unix kernel math sequences splitting strings
-combinators.short-circuit byte-arrays combinators
-accessors math.parser fry assocs namespaces continuations
-unix.users unix.utilities classes.struct unix ;
-IN: unix.groups
-
+USING: accessors alien alien.c-types alien.strings assocs
+byte-arrays classes.struct combinators
+combinators.short-circuit continuations fry io.backend.unix
+io.encodings.utf8 kernel math math.parser namespaces sequences
+splitting strings unix unix.ffi unix.users unix.utilities ;
 QUALIFIED: unix.ffi
-
 QUALIFIED: grouping
+IN: unix.groups
 
 TUPLE: group id name passwd members ;
 
@@ -88,7 +86,11 @@ M: integer user-groups ( id -- seq )
     user-name (user-groups) ;
     
 : all-groups ( -- seq )
-    [ unix.ffi:getgrent dup ] [ group-struct>group ] produce nip ;
+    [ unix.ffi:getgrent dup ] [ group-struct>group ] produce nip
+    endgrent ;
+
+: all-group-names ( -- seq )
+    all-groups [ name>> ] map ;
 
 : <group-cache> ( -- assoc )
     all-groups [ [ id>> ] keep ] H{ } map>assoc ;
@@ -105,6 +107,8 @@ M: integer user-groups ( id -- seq )
 : effective-group-name ( -- string )
     effective-group-id group-name ; inline
 
+: group-exists? ( name/id -- ? ) group-id >boolean ;
+
 GENERIC: set-real-group ( obj -- )
 
 GENERIC: set-effective-group ( obj -- )

diff --git a/basis/unix/users/users-docs.factor b/basis/unix/users/users-docs.factor
index 8cc9585cb93d747aad6d36017575a9697820692c..bca41dd5fc7b1a4411925d2a08da0578846342b6 100644 (file)
--- a/basis/unix/users/users-docs.factor
+++ b/basis/unix/users/users-docs.factor
@@ -86,11 +86,36 @@ HELP: with-real-user
     set-effective-user
 } related-words
 
+HELP: ?user-id
+{ $values
+    { "string" string }
+    { "id/f" "an integer or " { $link f } }
+}
+{ $description "Returns a group id or throws an exception." } ;
+
+HELP: all-user-names
+{ $values
+    
+    { "seq" sequence }
+}
+{ $description "Returns a sequence of group names as strings." } ;
+
+HELP: user-exists?
+{ $values
+    { "name/id" "a string or an integer" }
+    { "?" boolean }
+}
+{ $description "Returns a boolean representing the user's existence." } ;
+
 ARTICLE: "unix.users" "Unix users"
 "The " { $vocab-link "unix.users" } " vocabulary contains words that return information about Unix users."
 $nl
 "Listing all users:"
 { $subsections all-users }
+"Listing all user names:"
+{ $subsections all-user-names }
+"Checking if a user exists:"
+{ $subsections user-exists? }
 "Real user:"
 { $subsections
     real-user-name

diff --git a/basis/unix/users/users-tests.factor b/basis/unix/users/users-tests.factor
index 0093f0ee4b53e65bab218e13f496ca263bafc816..5ab9a8c147a8fc5512bf42ffcb650bd3ee873e43 100644 (file)
--- a/basis/unix/users/users-tests.factor
+++ b/basis/unix/users/users-tests.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test unix.users kernel strings math ;
+USING: tools.test unix.users kernel strings math sequences ;
 IN: unix.users.tests
 
 [ ] [ all-users drop ] unit-test
@@ -27,7 +27,14 @@ IN: unix.users.tests
 [ f ] [ 89898989898989898989898989898 user-passwd ] unit-test
 
 [ f ] [ "thisusershouldnotexistabcdefg12345asdfasdfasdfasdfasdfasdfasdf" user-id ] unit-test
+[ f ] [ "thisusershouldnotexistabcdefg12345asdfasdfasdfasdfasdfasdfasdf" user-exists? ] unit-test
 [ "thisusershouldnotexistabcdefg12345asdfasdfasdfasdfasdfasdfasdf" ?user-id ] must-fail
 
 [ 3 ] [ f [ 3 ] with-effective-user ] unit-test
 [ 3 ] [ f [ 3 ] with-real-user ] unit-test
+
+[ f ]
+[ all-users drop all-users empty? ] unit-test
+
+[ f ]
+[ all-user-names drop all-user-names empty? ] unit-test

diff --git a/basis/unix/users/users.factor b/basis/unix/users/users.factor
index 3abca314ac6feae9a98145d964470de6d1b07ca4..cd0eb7ada387fc104ac47dd97654845400dc6916 100644 (file)
--- a/basis/unix/users/users.factor
+++ b/basis/unix/users/users.factor
@@ -40,6 +40,9 @@ PRIVATE>
         [ unix.ffi:getpwent dup ] [ passwd>new-passwd ] produce nip
     ] with-pwent ;
 
+: all-user-names ( -- seq )
+    all-users [ user-name>> ] map ;
+
 SYMBOL: user-cache
 
 : <user-cache> ( -- assoc )
@@ -81,6 +84,8 @@ ERROR: no-user string ;
 : effective-user-name ( -- string )
     effective-user-id user-name ; inline
 
+: user-exists? ( name/id -- ? ) user-id >boolean ;
+
 GENERIC: set-real-user ( string/id -- )
 
 GENERIC: set-effective-user ( string/id -- )