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

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

db4
Joe Groff 2009-08-31 12:01:04 -05:00
parent 67dd3ff6b6 d22a25a3ec
commit 1a84aa7fc3
9 changed files with 94 additions and 92 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
basis/io/files/info/unix/freebsd/freebsd.factor
View File

@ -40,7 +40,7 @@ M: freebsd statfs>file-system-info ( file-system-info statvfs -- file-system-inf
} cleave ;
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 )
{
@ -50,6 +50,6 @@ M: freebsd statvfs>file-system-info ( file-system-info statvfs -- file-system-in
M: freebsd file-systems ( -- array )
f 0 0 getfsstat dup io-error
\ statfs <struct> dup dup length 0 getfsstat io-error
statfs heap-size group
[ f_mntonname>> alien>native-string file-system-info ] map ;
\ statfs <c-type-array>
[ dup length 0 getfsstat io-error ]
[ [ 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
io.encodings.utf8 alien.strings unix.types io.files.unix
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 ;
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 )
f 0 0 getvfsstat dup io-error
\ statvfs <c-array> dup dup length 0 getvfsstat io-error
\ statvfs heap-size group
[ f_mntonname>> utf8 alien>string file-system-info ] map ;
\ statvfs <struct-array>
[ dup length 0 getvfsstat io-error ]
[ [ 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
sequences system unix unix.getfsstat.openbsd grouping
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
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 )
f 0 0 getfsstat dup io-error
\ statfs <c-array> dup dup length 0 getfsstat io-error
\ statfs heap-size group
[ f_mntonname>> alien>native-string file-system-info ] map ;
\ statfs <c-type-array>
[ dup length 0 getvfsstat io-error ]
[ [ f_mntonname>> utf8 alien>string file-system-info ] map ] bi ;

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

@ -1,6 +1,7 @@
! Copyright (C) 2005, 2006 Slava Pestov.
! 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
CONSTANT: MAXPATHLEN 1024
@ -46,18 +47,18 @@ C-STRUCT: sockaddr-un
{ "uchar" "family" }
{ { "char" 104 } "path" } ;
C-STRUCT: passwd
{ "char*" "pw_name" }
{ "char*" "pw_passwd" }
{ "uid_t" "pw_uid" }
{ "gid_t" "pw_gid" }
{ "time_t" "pw_change" }
{ "char*" "pw_class" }
{ "char*" "pw_gecos" }
{ "char*" "pw_dir" }
{ "char*" "pw_shell" }
{ "time_t" "pw_expire" }
{ "int" "pw_fields" } ;
STRUCT: passwd
{ pw_name char* }
{ pw_passwd char* }
{ pw_uid uid_t }
{ pw_gid gid_t }
{ pw_change time_t }
{ pw_class char* }
{ pw_gecos char* }
{ pw_dir char* }
{ pw_shell char* }
{ pw_expire time_t }
{ pw_fields int } ;
CONSTANT: max-un-path 104

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

@ -1,12 +1,14 @@
! 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 unix strings
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 ;
unix.users unix.utilities classes.struct ;
IN: unix.groups
QUALIFIED: unix
QUALIFIED: grouping
TUPLE: group id name passwd members ;
@ -18,27 +20,27 @@ GENERIC: group-struct ( obj -- group/f )
<PRIVATE
: 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" <c-object> tuck 4096
\ unix:group <struct> tuck 4096
[ <byte-array> ] keep f <void*> ;
: check-group-struct ( group-struct ptr -- group-struct/f )
*void* [ drop f ] unless ;
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 )
(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 new ] dip
{
[ group-gr_name >>name ]
[ group-gr_passwd >>passwd ]
[ group-gr_gid >>id ]
[ gr_name>> >>name ]
[ gr_passwd>> >>passwd ]
[ gr_gid>> >>id ]
[ group-members >>members ]
} cleave ;
@ -48,12 +50,12 @@ PRIVATE>
dup group-cache get [
?at [ name>> ] [ number>string ] if
] [
group-struct [ group-gr_name ] [ f ] if*
group-struct [ gr_name>> ] [ f ] if*
] if*
[ nip ] [ number>string ] if* ;
: group-id ( string -- id/f )
group-struct [ group-gr_gid ] [ f ] if* ;
group-struct [ gr_gid>> ] [ f ] if* ;
<PRIVATE
@ -62,8 +64,8 @@ PRIVATE>
: (user-groups) ( string -- seq )
#! first group is -1337, legacy unix code
-1337 NGROUPS_MAX [ 4 * <byte-array> ] keep
<int> [ getgrouplist io-error ] 2keep
-1337 unix:NGROUPS_MAX [ 4 * <byte-array> ] keep
<int> [ unix:getgrouplist unix:io-error ] 2keep
[ 4 tail-slice ] [ *int 1 - ] bi* >groups ;
PRIVATE>
@ -77,7 +79,7 @@ M: integer user-groups ( id -- seq )
user-name (user-groups) ;
: 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 )
all-groups [ [ id>> ] keep ] H{ } map>assoc ;
@ -85,14 +87,11 @@ M: integer user-groups ( id -- seq )
: with-group-cache ( quot -- )
[ <group-cache> group-cache ] dip with-variable ; inline
: real-group-id ( -- id )
getgid ; inline
: real-group-id ( -- id ) unix:getgid ; inline
: real-group-name ( -- string )
real-group-id group-name ; inline
: real-group-name ( -- string ) real-group-id group-name ; inline
: effective-group-id ( -- string )
getegid ; inline
: effective-group-id ( -- string ) unix:getegid ; inline
: effective-group-name ( -- string )
effective-group-id group-name ; inline
@ -112,10 +111,10 @@ GENERIC: set-effective-group ( obj -- )
<PRIVATE
: (set-real-group) ( id -- )
setgid io-error ; inline
unix:setgid unix:io-error ; inline
: (set-effective-group) ( id -- )
setegid io-error ; inline
unix:setegid unix:io-error ; inline
PRIVATE>

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

@ -84,14 +84,14 @@ CONSTANT: SEEK_SET 0
CONSTANT: SEEK_CUR 1
CONSTANT: SEEK_END 2
C-STRUCT: passwd
{ "char*" "pw_name" }
{ "char*" "pw_passwd" }
{ "uid_t" "pw_uid" }
{ "gid_t" "pw_gid" }
{ "char*" "pw_gecos" }
{ "char*" "pw_dir" }
{ "char*" "pw_shell" } ;
STRUCT: passwd
{ pw_name char* }
{ pw_passwd char* }
{ pw_uid uid_t }
{ pw_gid gid_t }
{ pw_gecos char* }
{ pw_dir char* }
{ pw_shell char* } ;
! dirent64
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
system combinators vocabs.loader accessors
stack-checker macros locals generalizations unix.types
io vocabs ;
io vocabs classes.struct ;
IN: unix
CONSTANT: PROT_NONE 0
@ -35,11 +35,11 @@ CONSTANT: DT_LNK 10
CONSTANT: DT_SOCK 12
CONSTANT: DT_WHT 14
C-STRUCT: group
{ "char*" "gr_name" }
{ "char*" "gr_passwd" }
{ "int" "gr_gid" }
{ "char**" "gr_mem" } ;
STRUCT: group
{ gr_name char* }
{ gr_passwd char* }
{ gr_gid int }
{ gr_mem char** } ;
LIBRARY: libc
@ -147,19 +147,19 @@ M: unix open-file [ open ] unix-system-call ;
FUNCTION: DIR* opendir ( char* path ) ;
C-STRUCT: utimbuf
{ "time_t" "actime" }
{ "time_t" "modtime" } ;
STRUCT: utimbuf
{ actime time_t }
{ 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 ;
: change-file-times ( filename access modification -- )
"utimebuf" <c-object>
[ set-utimbuf-modtime ] keep
[ set-utimbuf-actime ] keep
[ utime ] unix-system-call drop ;
utimbuf <struct>
swap >>modtime
swap >>actime
[ utime ] unix-system-call drop ;
FUNCTION: int pclose ( void* file ) ;
FUNCTION: int pipe ( int* filedes ) ;

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

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

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

@ -1,11 +1,12 @@
! 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 unix strings
io.backend.unix kernel math sequences splitting strings
combinators.short-circuit grouping byte-arrays combinators
accessors math.parser fry assocs namespaces continuations
vocabs.loader system ;
vocabs.loader system classes.struct ;
IN: unix.users
QUALIFIED: unix
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 )
[ new-passwd ] dip
{
[ passwd-pw_name >>user-name ]
[ passwd-pw_passwd >>password ]
[ passwd-pw_uid >>uid ]
[ passwd-pw_gid >>gid ]
[ passwd-pw_gecos >>gecos ]
[ passwd-pw_dir >>dir ]
[ passwd-pw_shell >>shell ]
[ pw_name>> >>user-name ]
[ pw_passwd>> >>password ]
[ pw_uid>> >>uid ]
[ pw_gid>> >>gid ]
[ pw_gecos>> >>gecos ]
[ pw_dir>> >>dir ]
[ pw_shell>> >>shell ]
} cleave ;
: with-pwent ( quot -- )
[ endpwent ] [ ] cleanup ; inline
[ unix:endpwent ] [ ] cleanup ; inline
PRIVATE>
: all-users ( -- seq )
[
[ getpwent dup ] [ passwd>new-passwd ] produce nip
[ unix:getpwent dup ] [ unix:passwd memory>struct passwd>new-passwd ] produce nip
] with-pwent ;
SYMBOL: user-cache
@ -51,10 +52,10 @@ GENERIC: user-passwd ( obj -- passwd/f )
M: integer user-passwd ( id -- passwd/f )
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 )
getpwnam dup [ passwd>new-passwd ] when ;
unix:getpwnam dup [ unix:passwd memory>struct passwd>new-passwd ] when ;
: user-name ( id -- string )
dup user-passwd
@ -64,13 +65,13 @@ M: string user-passwd ( string -- passwd/f )
user-passwd uid>> ;
: real-user-id ( -- id )
getuid ; inline
unix:getuid ; inline
: real-user-name ( -- string )
real-user-id user-name ; inline
: effective-user-id ( -- id )
geteuid ; inline
unix:geteuid ; inline
: effective-user-name ( -- string )
effective-user-id user-name ; inline
@ -92,10 +93,10 @@ GENERIC: set-effective-user ( string/id -- )
<PRIVATE
: (set-real-user) ( id -- )
setuid io-error ; inline
unix:setuid unix:io-error ; inline
: (set-effective-user) ( id -- )
seteuid io-error ; inline
unix:seteuid unix:io-error ; inline
PRIVATE>