diff --git a/basis/unix/groups/groups-docs.factor b/basis/unix/groups/groups-docs.factor new file mode 100644 index 0000000000..ef2631ae3f --- /dev/null +++ b/basis/unix/groups/groups-docs.factor @@ -0,0 +1,108 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax io.streams.string kernel quotations sequences strings math ; +IN: unix.groups + +HELP: all-groups +{ $values + + { "seq" sequence } } +{ $description "Returns a sequence of " { $link group } " tuples that are platform-dependent and field for field complete with the Unix " { $link group } " structure." } ; + +HELP: effective-group-id +{ $values + + { "string" string } } +{ $description "Returns the effective group id for the current user." } ; + +HELP: effective-group-name +{ $values + + { "string" string } } +{ $description "Returns the effective group name for the current user." } ; + +HELP: group +{ $description "A platform-specific tuple corresponding to every field from the Unix group struct including the group name, the group id, the group passwd, and a list of users in each group." } ; + +HELP: group-cache +{ $description "A symbol containing a cache of groups returned from " { $link all-groups } " and indexed by group id. Can be more efficient than using the system call words for many group lookups." } ; + +HELP: group-id +{ $values + { "string" string } + { "id" integer } } +{ $description "Returns the group id given a group name." } ; + +HELP: group-name +{ $values + { "id" integer } + { "string" string } } +{ $description "Returns the group name given a group id." } ; + +HELP: group-struct +{ $values + { "obj" object } + { "group" "a group struct" } } +{ $description "Returns an alien group struct to be turned into a group tuple by calling subsequent words." } ; + +HELP: real-group-id +{ $values + + { "id" integer } } +{ $description "Returns the real group id for the current user." } ; + +HELP: real-group-name +{ $values + + { "string" string } } +{ $description "Returns the real group name for the current user." } ; + +HELP: set-effective-group +{ $values + { "obj" object } } +{ $description "Sets the effective group id for the current user." } ; + +HELP: set-real-group +{ $values + { "obj" object } } +{ $description "Sets the real group id for the current user." } ; + +HELP: user-groups +{ $values + { "string/id" "a string or a group id" } + { "seq" sequence } } +{ $description "Returns the sequence of groups to which the user belongs." } ; + +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." } ; + +HELP: with-group-cache +{ $values + { "quot" quotation } } +{ $description "Iterates over the group file using library calls and creates a cache in the " { $link group-cache } " symbol. The cache is a hashtable indexed by group id. When looking up many groups, this approach is much faster than calling system calls." } ; + +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." } ; + +ARTICLE: "unix.groups" "unix.groups" +"The " { $vocab-link "unix.groups" } " vocabulary contains words that return information about Unix groups." +"Listing all groups:" +{ $subsection all-groups } +"Returning a passwd tuple:" +"Real groups:" +{ $subsection real-group-name } +{ $subsection real-group-id } +{ $subsection set-real-group } +"Effective groups:" +{ $subsection effective-group-name } +{ $subsection effective-group-id } +{ $subsection set-effective-group } +"Combinators to change groups:" +{ $subsection with-real-group } +{ $subsection with-effective-group } ; + +ABOUT: "unix.groups" diff --git a/basis/unix/groups/groups.factor b/basis/unix/groups/groups.factor index 5a33bfe072..7f3aa9ae98 100644 --- a/basis/unix/groups/groups.factor +++ b/basis/unix/groups/groups.factor @@ -3,7 +3,8 @@ USING: alien alien.c-types alien.strings io.encodings.utf8 io.unix.backend kernel math sequences splitting unix strings combinators.short-circuit byte-arrays combinators qualified -accessors math.parser fry assocs namespaces continuations ; +accessors math.parser fry assocs namespaces continuations +unix.users ; IN: unix.groups QUALIFIED: grouping @@ -61,14 +62,22 @@ PRIVATE> : >groups ( byte-array n -- groups ) [ 4 grouping:group ] dip head-slice [ *uint group-name ] map ; -PRIVATE> - -: user-groups ( string -- seq ) +: (user-groups) ( string -- seq ) #! first group is -1337, legacy unix code -1337 NGROUPS_MAX [ 4 * ] keep [ getgrouplist io-error ] 2keep [ 4 tail-slice ] [ *int 1- ] bi* >groups ; +PRIVATE> + +GENERIC: user-groups ( string/id -- seq ) + +M: string user-groups ( string -- seq ) + (user-groups) ; + +M: integer user-groups ( id -- seq ) + username (user-groups) ; + : all-groups ( -- seq ) [ getgrent dup ] [ group-struct>group ] [ drop ] produce ;