1 ! Copyright (C) 2009 Doug Coleman.
2 ! See https://factorcode.org/license.txt for BSD license.
3 USING: alien.c-types alien.data alien.destructors combinators
4 destructors io io.backend io.files io.files.acls.macosx.ffi
5 kernel libc sequences unix.groups unix.types unix.users ;
7 IN: io.files.acls.macosx
11 : unix-id>string ( byte-array id-type -- string )
13 { ID_TYPE_UID [ user-name "user:" prepend ] }
14 { ID_TYPE_GID [ group-name "group:" prepend ] }
15 ! [ uuid_string_t new [ mbr_uuid_to_string io-error ] keep ]
18 : acl-error ( n -- ) -1 = [ throw-errno ] when ; inline
20 :: file-acl ( path -- acl_t/f )
24 ACL_TYPE_EXTENDED acl_get_file dup [
26 [ path file-exists? ] preserve-errno
27 [ drop f ] [ throw-errno ] if
33 : free-acl ( acl -- ) acl_free acl-error ;
37 : get-acl-entry ( acl_t n -- acl_entry_t )
38 f acl_entry_t <ref> [ acl_get_entry ] keep swap -1 = [ drop f ] when ;
40 : first-acl-entry ( acl_t -- acl_entry_t ) ACL_FIRST_ENTRY get-acl-entry ;
41 : next-acl-entry ( acl_t -- acl_entry_t ) ACL_NEXT_ENTRY get-acl-entry ;
42 : last-acl-entry ( acl_t -- acl_entry_t ) ACL_LAST_ENTRY get-acl-entry ;
46 : acl>text ( acl_t -- string ) f acl_to_text ;
48 :: acl-entry-each ( path quot -- )
50 path file-acl &free-acl :> acl
53 acl first-acl-entry void* deref quot call
54 [ acl next-acl-entry dup acl-entry! ]
55 [ acl-entry void* deref quot call ] while
57 ] with-destructors ; inline
59 :: acl-each ( path quot -- )
61 path file-acl &free-acl :> acl
63 acl first-acl-entry drop
65 [ acl next-acl-entry ] [ acl quot call ] while
67 ] with-destructors ; inline
69 : acl-entry-map ( path quot -- seq )
70 collector [ acl-entry-each ] dip ; inline
72 : acl-map ( path quot -- seq )
73 collector [ acl-each ] dip ; inline
75 ERROR: acl-init-failed n ;
77 :: n>new-acl ( n -- acl )
78 n acl_init dup [ n acl-init-failed ] unless ;
80 : new-acl ( -- acl ) 1 n>new-acl ; inline
82 : acl-valid? ( acl -- ? ) acl_valid [ acl-error ] keep 0 = ;
84 ERROR: add-permission-failed permission-set permission ;
86 : add-permission ( acl_permset permission -- )
87 acl_add_perm acl-error ;
89 : acl-entry>permset ( acl_entry_t -- acl_permset )
90 f acl_permset_t <ref> [ acl_get_permset acl-error ] keep ;
92 : filter-strings ( obj strings -- string )
93 [ [ 1 = ] dip f ? ] 2map sift "," join ;
95 : permset>strings ( acl_permset -- strings )
96 acl-perms [ acl_get_perm_np dup acl-error ] with map
97 acl-perm-names filter-strings ;
99 : acl-entry>perm-strings ( acl_entry_t -- strings )
100 acl-entry>permset permset>strings ;
102 : with-new-acl ( quot -- )
103 [ [ new-acl &free-acl ] dip call ] with-destructors ; inline
106 [ acl>text io:write ] acl-each ;
108 : acl-entry>owner-name ( acl-entry -- string )
110 acl_get_qualifier dup acl-error &free-acl
111 0 uid_t <ref> -1 int <ref> [ mbr_uuid_to_id io-error ] 2keep
112 [ uint deref ] bi@ unix-id>string
115 : acl-entry>tag-name ( acl-entry -- string )
116 f acl_tag_t <ref> [ acl_get_tag_type acl-error ] keep
117 uint deref acl_tag_t>string ;
119 : flagset>strings ( flagset -- strings )
120 acl-flags [ acl_get_flag_np dup acl-error ] with map
121 acl-flag-names filter-strings ;
123 : acl-entry>flagset ( acl-entry -- flagset )
124 f acl_flagset_t <ref> [ acl_get_flagset_np acl-error ] keep ;
126 : acl-entry>flag-names ( acl-entry -- strings )
127 acl-entry>flagset flagset>strings ;
130 ! Acl, acl entry, principal, group,
131 ! acl_get_qualifier, acl_get_tag_type, acl_get_flagset_np,
134 ! https://www.google.com/codesearch/p?hl=en#pFm0LxzAWvs/darwinsource/tarballs/apsl/file_cmds-116.10.tar.gz%7CFam4LGNxuqg/file_cmds-116.10/ls/print.c&q=acl_get_permset&d=6