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

update users/groups for new structs

Doug Coleman 2009-08-30 23:07:46 -05:00
parent 09e05c4cb3
commit 88d6826213
6 changed files with 82 additions and 80 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
basis/unix/bsd/bsd.factor
View File

@ -1,6 +1,7 @@
! Copyright (C) 2005, 2006 Slava Pestov. ! Copyright (C) 2005, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien.syntax combinators system vocabs.loader ; USING: alien.syntax classes.struct combinators system
vocabs.loader ;
IN: unix IN: unix
CONSTANT: MAXPATHLEN 1024 CONSTANT: MAXPATHLEN 1024
@ -46,18 +47,18 @@ C-STRUCT: sockaddr-un
{ "uchar" "family" } { "uchar" "family" }
{ { "char" 104 } "path" } ; { { "char" 104 } "path" } ;
C-STRUCT: passwd STRUCT: passwd
{ "char*" "pw_name" } { pw_name char* }
{ "char*" "pw_passwd" } { pw_passwd char* }
{ "uid_t" "pw_uid" } { pw_uid uid_t }
{ "gid_t" "pw_gid" } { pw_gid gid_t }
{ "time_t" "pw_change" } { pw_change time_t }
{ "char*" "pw_class" } { pw_class char* }
{ "char*" "pw_gecos" } { pw_gecos char* }
{ "char*" "pw_dir" } { pw_dir char* }
{ "char*" "pw_shell" } { pw_shell char* }
{ "time_t" "pw_expire" } { pw_expire time_t }
{ "int" "pw_fields" } ; { pw_fields int } ;
CONSTANT: max-un-path 104 CONSTANT: max-un-path 104

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

@ -1,12 +1,14 @@
! Copyright (C) 2008 Doug Coleman. ! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.strings io.encodings.utf8 USING: alien alien.c-types alien.strings io.encodings.utf8
io.backend.unix kernel math sequences splitting unix strings io.backend.unix kernel math sequences splitting strings
combinators.short-circuit byte-arrays combinators combinators.short-circuit byte-arrays combinators
accessors math.parser fry assocs namespaces continuations accessors math.parser fry assocs namespaces continuations
unix.users unix.utilities ; unix.users unix.utilities classes.struct ;
IN: unix.groups IN: unix.groups
QUALIFIED: unix
QUALIFIED: grouping QUALIFIED: grouping
TUPLE: group id name passwd members ; TUPLE: group id name passwd members ;
@ -18,27 +20,27 @@ GENERIC: group-struct ( obj -- group/f )
<PRIVATE <PRIVATE
: group-members ( group-struct -- seq ) : group-members ( group-struct -- seq )
group-gr_mem utf8 alien>strings ; gr_mem>> utf8 alien>strings ;
: (group-struct) ( id -- group-struct id group-struct byte-array length void* ) : (group-struct) ( id -- group-struct id group-struct byte-array length void* )
"group" <c-object> tuck 4096 \ unix:group <struct> tuck 4096
[ <byte-array> ] keep f <void*> ; [ <byte-array> ] keep f <void*> ;
: check-group-struct ( group-struct ptr -- group-struct/f ) : check-group-struct ( group-struct ptr -- group-struct/f )
*void* [ drop f ] unless ; *void* [ drop f ] unless ;
M: integer group-struct ( id -- group/f ) M: integer group-struct ( id -- group/f )
(group-struct) [ getgrgid_r io-error ] keep check-group-struct ; (group-struct) [ unix:getgrgid_r unix:io-error ] keep check-group-struct ;
M: string group-struct ( string -- group/f ) M: string group-struct ( string -- group/f )
(group-struct) [ getgrnam_r io-error ] keep check-group-struct ; (group-struct) [ unix:getgrnam_r unix:io-error ] keep check-group-struct ;
: group-struct>group ( group-struct -- group ) : group-struct>group ( group-struct -- group )
[ \ group new ] dip [ \ group new ] dip
{ {
[ group-gr_name >>name ] [ gr_name>> >>name ]
[ group-gr_passwd >>passwd ] [ gr_passwd>> >>passwd ]
[ group-gr_gid >>id ] [ gr_gid>> >>id ]
[ group-members >>members ] [ group-members >>members ]
} cleave ; } cleave ;
@ -48,12 +50,12 @@ PRIVATE>
dup group-cache get [ dup group-cache get [
?at [ name>> ] [ number>string ] if ?at [ name>> ] [ number>string ] if
] [ ] [
group-struct [ group-gr_name ] [ f ] if* group-struct [ gr_name>> ] [ f ] if*
] if* ] if*
[ nip ] [ number>string ] if* ; [ nip ] [ number>string ] if* ;
: group-id ( string -- id/f ) : group-id ( string -- id/f )
group-struct [ group-gr_gid ] [ f ] if* ; group-struct [ gr_gid>> ] [ f ] if* ;
<PRIVATE <PRIVATE
@ -62,8 +64,8 @@ PRIVATE>
: (user-groups) ( string -- seq ) : (user-groups) ( string -- seq )
#! first group is -1337, legacy unix code #! first group is -1337, legacy unix code
-1337 NGROUPS_MAX [ 4 * <byte-array> ] keep -1337 unix:NGROUPS_MAX [ 4 * <byte-array> ] keep
<int> [ getgrouplist io-error ] 2keep <int> [ unix:getgrouplist unix:io-error ] 2keep
[ 4 tail-slice ] [ *int 1 - ] bi* >groups ; [ 4 tail-slice ] [ *int 1 - ] bi* >groups ;
PRIVATE> PRIVATE>
@ -77,7 +79,7 @@ M: integer user-groups ( id -- seq )
user-name (user-groups) ; user-name (user-groups) ;
: all-groups ( -- seq ) : all-groups ( -- seq )
[ getgrent dup ] [ group-struct>group ] produce nip ; [ unix:getgrent dup ] [ \ unix:group memory>struct group-struct>group ] produce nip ;
: <group-cache> ( -- assoc ) : <group-cache> ( -- assoc )
all-groups [ [ id>> ] keep ] H{ } map>assoc ; all-groups [ [ id>> ] keep ] H{ } map>assoc ;
@ -85,14 +87,11 @@ M: integer user-groups ( id -- seq )
: with-group-cache ( quot -- ) : with-group-cache ( quot -- )
[ <group-cache> group-cache ] dip with-variable ; inline [ <group-cache> group-cache ] dip with-variable ; inline
: real-group-id ( -- id ) : real-group-id ( -- id ) unix:getgid ; inline
getgid ; inline
: real-group-name ( -- string ) : real-group-name ( -- string ) real-group-id group-name ; inline
real-group-id group-name ; inline
: effective-group-id ( -- string ) : effective-group-id ( -- string ) unix:getegid ; inline
getegid ; inline
: effective-group-name ( -- string ) : effective-group-name ( -- string )
effective-group-id group-name ; inline effective-group-id group-name ; inline
@ -112,10 +111,10 @@ GENERIC: set-effective-group ( obj -- )
<PRIVATE <PRIVATE
: (set-real-group) ( id -- ) : (set-real-group) ( id -- )
setgid io-error ; inline unix:setgid unix:io-error ; inline
: (set-effective-group) ( id -- ) : (set-effective-group) ( id -- )
setegid io-error ; inline unix:setegid unix:io-error ; inline
PRIVATE> PRIVATE>

16
basis/unix/linux/linux.factor
View File

@ -84,14 +84,14 @@ CONSTANT: SEEK_SET 0
CONSTANT: SEEK_CUR 1 CONSTANT: SEEK_CUR 1
CONSTANT: SEEK_END 2 CONSTANT: SEEK_END 2
C-STRUCT: passwd STRUCT: passwd
{ "char*" "pw_name" } { pw_name char* }
{ "char*" "pw_passwd" } { pw_passwd char* }
{ "uid_t" "pw_uid" } { pw_uid uid_t }
{ "gid_t" "pw_gid" } { pw_gid gid_t }
{ "char*" "pw_gecos" } { pw_gecos char* }
{ "char*" "pw_dir" } { pw_dir char* }
{ "char*" "pw_shell" } ; { pw_shell char* } ;
! dirent64 ! dirent64
STRUCT: dirent STRUCT: dirent

28
basis/unix/unix.factor
View File

@ -5,7 +5,7 @@ USING: alien alien.c-types alien.syntax kernel libc
sequences continuations byte-arrays strings math namespaces sequences continuations byte-arrays strings math namespaces
system combinators vocabs.loader accessors system combinators vocabs.loader accessors
stack-checker macros locals generalizations unix.types stack-checker macros locals generalizations unix.types
io vocabs ; io vocabs classes.struct ;
IN: unix IN: unix
CONSTANT: PROT_NONE 0 CONSTANT: PROT_NONE 0
@ -35,11 +35,11 @@ CONSTANT: DT_LNK 10
CONSTANT: DT_SOCK 12 CONSTANT: DT_SOCK 12
CONSTANT: DT_WHT 14 CONSTANT: DT_WHT 14
C-STRUCT: group STRUCT: group
{ "char*" "gr_name" } { gr_name char* }
{ "char*" "gr_passwd" } { gr_passwd char* }
{ "int" "gr_gid" } { gr_gid int }
{ "char**" "gr_mem" } ; { gr_mem char** } ;
LIBRARY: libc LIBRARY: libc
@ -147,19 +147,19 @@ M: unix open-file [ open ] unix-system-call ;
FUNCTION: DIR* opendir ( char* path ) ; FUNCTION: DIR* opendir ( char* path ) ;
C-STRUCT: utimbuf STRUCT: utimbuf
{ "time_t" "actime" } { actime time_t }
{ "time_t" "modtime" } ; { modtime time_t } ;
FUNCTION: int utime ( char* path, utimebuf* buf ) ; FUNCTION: int utime ( char* path, utimbuf* buf ) ;
: touch ( filename -- ) f [ utime ] unix-system-call drop ; : touch ( filename -- ) f [ utime ] unix-system-call drop ;
: change-file-times ( filename access modification -- ) : change-file-times ( filename access modification -- )
"utimebuf" <c-object> utimbuf <struct>
[ set-utimbuf-modtime ] keep swap >>modtime
[ set-utimbuf-actime ] keep swap >>actime
[ utime ] unix-system-call drop ; [ utime ] unix-system-call drop ;
FUNCTION: int pclose ( void* file ) ; FUNCTION: int pclose ( void* file ) ;
FUNCTION: int pipe ( int* filedes ) ; FUNCTION: int pipe ( int* filedes ) ;

13
basis/unix/users/bsd/bsd.factor
View File

@ -1,8 +1,9 @@
! Copyright (C) 2008 Doug Coleman. ! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: combinators accessors kernel unix unix.users USING: combinators accessors kernel unix.users
system ; system ;
IN: unix.users.bsd IN: unix.users.bsd
QUALIFIED: unix
TUPLE: bsd-passwd < passwd change class expire fields ; TUPLE: bsd-passwd < passwd change class expire fields ;
@ -11,9 +12,9 @@ M: bsd new-passwd ( -- bsd-passwd ) bsd-passwd new ;
M: bsd passwd>new-passwd ( passwd -- bsd-passwd ) M: bsd passwd>new-passwd ( passwd -- bsd-passwd )
[ call-next-method ] keep [ call-next-method ] keep
{ {
[ passwd-pw_change >>change ] [ pw_change>> >>change ]
[ passwd-pw_class >>class ] [ pw_class>> >>class ]
[ passwd-pw_shell >>shell ] [ pw_shell>> >>shell ]
[ passwd-pw_expire >>expire ] [ pw_expire>> >>expire ]
[ passwd-pw_fields >>fields ] [ pw_fields>> >>fields ]
} cleave ; } cleave ;

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

@ -1,11 +1,12 @@
! Copyright (C) 2008 Doug Coleman. ! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.strings io.encodings.utf8 USING: alien alien.c-types alien.strings io.encodings.utf8
io.backend.unix kernel math sequences splitting unix strings io.backend.unix kernel math sequences splitting strings
combinators.short-circuit grouping byte-arrays combinators combinators.short-circuit grouping byte-arrays combinators
accessors math.parser fry assocs namespaces continuations accessors math.parser fry assocs namespaces continuations
vocabs.loader system ; vocabs.loader system classes.struct ;
IN: unix.users IN: unix.users
QUALIFIED: unix
TUPLE: passwd user-name password uid gid gecos dir shell ; TUPLE: passwd user-name password uid gid gecos dir shell ;
@ -20,23 +21,23 @@ M: unix new-passwd ( -- passwd )
M: unix passwd>new-passwd ( passwd -- seq ) M: unix passwd>new-passwd ( passwd -- seq )
[ new-passwd ] dip [ new-passwd ] dip
{ {
[ passwd-pw_name >>user-name ] [ pw_name>> >>user-name ]
[ passwd-pw_passwd >>password ] [ pw_passwd>> >>password ]
[ passwd-pw_uid >>uid ] [ pw_uid>> >>uid ]
[ passwd-pw_gid >>gid ] [ pw_gid>> >>gid ]
[ passwd-pw_gecos >>gecos ] [ pw_gecos>> >>gecos ]
[ passwd-pw_dir >>dir ] [ pw_dir>> >>dir ]
[ passwd-pw_shell >>shell ] [ pw_shell>> >>shell ]
} cleave ; } cleave ;
: with-pwent ( quot -- ) : with-pwent ( quot -- )
[ endpwent ] [ ] cleanup ; inline [ unix:endpwent ] [ ] cleanup ; inline
PRIVATE> PRIVATE>
: all-users ( -- seq ) : all-users ( -- seq )
[ [
[ getpwent dup ] [ passwd>new-passwd ] produce nip [ unix:getpwent dup ] [ unix:passwd memory>struct passwd>new-passwd ] produce nip
] with-pwent ; ] with-pwent ;
SYMBOL: user-cache SYMBOL: user-cache
@ -51,10 +52,10 @@ GENERIC: user-passwd ( obj -- passwd/f )
M: integer user-passwd ( id -- passwd/f ) M: integer user-passwd ( id -- passwd/f )
user-cache get user-cache get
[ at ] [ getpwuid [ passwd>new-passwd ] [ f ] if* ] if* ; [ at ] [ unix:getpwuid [ unix:passwd memory>struct passwd>new-passwd ] [ f ] if* ] if* ;
M: string user-passwd ( string -- passwd/f ) M: string user-passwd ( string -- passwd/f )
getpwnam dup [ passwd>new-passwd ] when ; unix:getpwnam dup [ unix:passwd memory>struct passwd>new-passwd ] when ;
: user-name ( id -- string ) : user-name ( id -- string )
dup user-passwd dup user-passwd
@ -64,13 +65,13 @@ M: string user-passwd ( string -- passwd/f )
user-passwd uid>> ; user-passwd uid>> ;
: real-user-id ( -- id ) : real-user-id ( -- id )
getuid ; inline unix:getuid ; inline
: real-user-name ( -- string ) : real-user-name ( -- string )
real-user-id user-name ; inline real-user-id user-name ; inline
: effective-user-id ( -- id ) : effective-user-id ( -- id )
geteuid ; inline unix:geteuid ; inline
: effective-user-name ( -- string ) : effective-user-name ( -- string )
effective-user-id user-name ; inline effective-user-id user-name ; inline
@ -92,10 +93,10 @@ GENERIC: set-effective-user ( string/id -- )
<PRIVATE <PRIVATE
: (set-real-user) ( id -- ) : (set-real-user) ( id -- )
setuid io-error ; inline unix:setuid unix:io-error ; inline
: (set-effective-user) ( id -- ) : (set-effective-user) ( id -- )
seteuid io-error ; inline unix:seteuid unix:io-error ; inline
PRIVATE> PRIVATE>