Merge branch 'master' of git://factorcode.org/git/factor into struct-updates

db4
Joe Groff 2009-08-31 12:01:04 -05:00
commit 1a84aa7fc3
9 changed files with 94 additions and 92 deletions

View File

@ -40,7 +40,7 @@ M: freebsd statfs>file-system-info ( file-system-info statvfs -- file-system-inf
} cleave ; } cleave ;
M: freebsd file-system-statvfs ( path -- byte-array ) M: freebsd file-system-statvfs ( path -- byte-array )
\ statvfs <struct> [ \ statvfs io-error ] keep ; \ statvfs <struct> [ statvfs io-error ] keep ;
M: freebsd statvfs>file-system-info ( file-system-info statvfs -- file-system-info ) M: freebsd statvfs>file-system-info ( file-system-info statvfs -- file-system-info )
{ {
@ -50,6 +50,6 @@ M: freebsd statvfs>file-system-info ( file-system-info statvfs -- file-system-in
M: freebsd file-systems ( -- array ) M: freebsd file-systems ( -- array )
f 0 0 getfsstat dup io-error f 0 0 getfsstat dup io-error
\ statfs <struct> dup dup length 0 getfsstat io-error \ statfs <c-type-array>
statfs heap-size group [ dup length 0 getfsstat io-error ]
[ f_mntonname>> alien>native-string file-system-info ] map ; [ [ f_mntonname>> utf8 alien>string file-system-info ] map ] bi ;

8
basis/io/files/info/unix/netbsd/netbsd.factor Normal file → Executable file
View File

@ -4,7 +4,7 @@ USING: alien.syntax kernel unix.stat math unix
combinators system io.backend accessors alien.c-types combinators system io.backend accessors alien.c-types
io.encodings.utf8 alien.strings unix.types io.files.unix io.encodings.utf8 alien.strings unix.types io.files.unix
io.files io.files.info unix.statvfs.netbsd unix.getfsstat.netbsd arrays io.files io.files.info unix.statvfs.netbsd unix.getfsstat.netbsd arrays
grouping sequences io.encodings.utf8 classes.struct grouping sequences io.encodings.utf8 classes.struct struct-arrays
io.files.info.unix ; io.files.info.unix ;
IN: io.files.info.unix.netbsd IN: io.files.info.unix.netbsd
@ -47,6 +47,6 @@ M: netbsd statvfs>file-system-info ( file-system-info statvfs -- file-system-inf
M: netbsd file-systems ( -- array ) M: netbsd file-systems ( -- array )
f 0 0 getvfsstat dup io-error f 0 0 getvfsstat dup io-error
\ statvfs <c-array> dup dup length 0 getvfsstat io-error \ statvfs <struct-array>
\ statvfs heap-size group [ dup length 0 getvfsstat io-error ]
[ f_mntonname>> utf8 alien>string file-system-info ] map ; [ [ f_mntonname>> utf8 alien>string file-system-info ] map ] bi ;

8
basis/io/files/info/unix/openbsd/openbsd.factor Normal file → Executable file
View File

@ -4,7 +4,7 @@ USING: accessors alien.c-types alien.strings alien.syntax
combinators io.backend io.files io.files.info io.files.unix kernel math combinators io.backend io.files io.files.info io.files.unix kernel math
sequences system unix unix.getfsstat.openbsd grouping sequences system unix unix.getfsstat.openbsd grouping
unix.statfs.openbsd unix.statvfs.openbsd unix.types unix.statfs.openbsd unix.statvfs.openbsd unix.types
arrays io.files.info.unix classes.struct ; arrays io.files.info.unix classes.struct struct-arrays ;
IN: io.files.unix.openbsd IN: io.files.unix.openbsd
TUPLE: freebsd-file-system-info < unix-file-system-info TUPLE: freebsd-file-system-info < unix-file-system-info
@ -47,6 +47,6 @@ M: openbsd statvfs>file-system-info ( file-system-info statvfs -- file-system-in
M: openbsd file-systems ( -- seq ) M: openbsd file-systems ( -- seq )
f 0 0 getfsstat dup io-error f 0 0 getfsstat dup io-error
\ statfs <c-array> dup dup length 0 getfsstat io-error \ statfs <c-type-array>
\ statfs heap-size group [ dup length 0 getvfsstat io-error ]
[ f_mntonname>> alien>native-string file-system-info ] map ; [ [ f_mntonname>> utf8 alien>string file-system-info ] map ] bi ;

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

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>

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

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,18 +147,18 @@ 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 ) ;

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 ;

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>