! 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.unix.backend kernel math sequences splitting unix strings
-combinators.short-circuit byte-arrays combinators qualified
+io.backend.unix kernel math sequences splitting unix strings
+combinators.short-circuit byte-arrays combinators
accessors math.parser fry assocs namespaces continuations
-unix.users ;
+unix.users unix.utilities ;
IN: unix.groups
QUALIFIED: grouping
SYMBOL: group-cache
-GENERIC: group-struct ( obj -- group )
+GENERIC: group-struct ( obj -- group/f )
<PRIVATE
: group-members ( group-struct -- seq )
- group-gr_mem
- [ dup { [ ] [ *void* ] } 1&& ]
- [
- dup *void* utf8 alien>string
- [ alien-address "char**" heap-size + <alien> ] dip
- ] [ ] produce nip ;
+ group-gr_mem utf8 alien>strings ;
: (group-struct) ( id -- group-struct id group-struct byte-array length void* )
"group" <c-object> tuck 4096
[ <byte-array> ] keep f <void*> ;
-M: integer group-struct ( id -- group )
- (group-struct) getgrgid_r io-error ;
+: check-group-struct ( group-struct ptr -- group-struct/f )
+ *void* [ drop f ] unless ;
-M: string group-struct ( string -- group )
- (group-struct) getgrnam_r 0 = [ (io-error) ] unless ;
+M: integer group-struct ( id -- group/f )
+ (group-struct) [ getgrgid_r io-error ] keep check-group-struct ;
+
+M: string group-struct ( string -- group/f )
+ (group-struct) [ getgrnam_r io-error ] keep check-group-struct ;
: group-struct>group ( group-struct -- group )
[ \ group new ] dip
: group-name ( id -- string )
dup group-cache get [
- at
+ ?at [ name>> ] [ number>string ] if
] [
- group-struct group-gr_name
+ group-struct [ group-gr_name ] [ f ] if*
] if*
[ nip ] [ number>string ] if* ;
-: group-id ( string -- id )
- group-struct group-gr_gid ;
+: group-id ( string -- id/f )
+ group-struct [ group-gr_gid ] [ f ] if* ;
<PRIVATE
#! first group is -1337, legacy unix code
-1337 NGROUPS_MAX [ 4 * <byte-array> ] keep
<int> [ getgrouplist io-error ] 2keep
- [ 4 tail-slice ] [ *int 1- ] bi* >groups ;
+ [ 4 tail-slice ] [ *int 1 - ] bi* >groups ;
PRIVATE>
(user-groups) ;
M: integer user-groups ( id -- seq )
- username (user-groups) ;
+ user-name (user-groups) ;
: all-groups ( -- seq )
- [ getgrent dup ] [ group-struct>group ] [ drop ] produce ;
+ [ getgrent dup ] [ group-struct>group ] produce nip ;
+
+: <group-cache> ( -- assoc )
+ all-groups [ [ id>> ] keep ] H{ } map>assoc ;
: with-group-cache ( quot -- )
- all-groups [ [ id>> ] keep ] H{ } map>assoc
- group-cache rot with-variable ; inline
+ [ <group-cache> group-cache ] dip with-variable ; inline
: real-group-id ( -- id )
getgid ; inline