} 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 )
{
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 ;
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
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 ;
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
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 ;
! 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
{ "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
! 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 ;
<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 ;
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
: (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>
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 ;
: 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
<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>
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
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
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
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 ) ;
! 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 ;
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 ;
! 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 ;
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
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
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
<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>