1 ! Copyright (C) 2008 Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: alien alien.c-types alien.strings io.encodings.utf8
4 io.backend.unix kernel math sequences splitting strings
5 combinators.short-circuit grouping byte-arrays combinators
6 accessors math.parser fry assocs namespaces continuations
7 vocabs.loader system classes.struct ;
11 TUPLE: passwd user-name password uid gid gecos dir shell ;
13 HOOK: new-passwd os ( -- passwd )
14 HOOK: passwd>new-passwd os ( passwd -- new-passwd )
18 M: unix new-passwd ( -- passwd )
21 M: unix passwd>new-passwd ( passwd -- seq )
24 [ pw_name>> >>user-name ]
25 [ pw_passwd>> >>password ]
28 [ pw_gecos>> >>gecos ]
30 [ pw_shell>> >>shell ]
33 : with-pwent ( quot -- )
34 [ unix:endpwent ] [ ] cleanup ; inline
38 : all-users ( -- seq )
40 [ unix:getpwent dup ] [ unix:passwd memory>struct passwd>new-passwd ] produce nip
45 : <user-cache> ( -- assoc )
46 all-users [ [ uid>> ] keep ] H{ } map>assoc ;
48 : with-user-cache ( quot -- )
49 [ <user-cache> user-cache ] dip with-variable ; inline
51 GENERIC: user-passwd ( obj -- passwd/f )
53 M: integer user-passwd ( id -- passwd/f )
55 [ at ] [ unix:getpwuid [ unix:passwd memory>struct passwd>new-passwd ] [ f ] if* ] if* ;
57 M: string user-passwd ( string -- passwd/f )
58 unix:getpwnam dup [ unix:passwd memory>struct passwd>new-passwd ] when ;
60 : user-name ( id -- string )
62 [ nip user-name>> ] [ number>string ] if* ;
64 : user-id ( string -- id )
67 : real-user-id ( -- id )
70 : real-user-name ( -- string )
71 real-user-id user-name ; inline
73 : effective-user-id ( -- id )
76 : effective-user-name ( -- string )
77 effective-user-id user-name ; inline
79 GENERIC: set-real-user ( string/id -- )
81 GENERIC: set-effective-user ( string/id -- )
83 : with-real-user ( string/id quot -- )
84 '[ _ set-real-user @ ]
85 real-user-id '[ _ set-real-user ]
88 : with-effective-user ( string/id quot -- )
89 '[ _ set-effective-user @ ]
90 effective-user-id '[ _ set-effective-user ]
95 : (set-real-user) ( id -- )
96 unix:setuid unix:io-error ; inline
98 : (set-effective-user) ( id -- )
99 unix:seteuid unix:io-error ; inline
103 M: string set-real-user ( string -- )
104 user-id (set-real-user) ;
106 M: integer set-real-user ( id -- )
109 M: integer set-effective-user ( id -- )
110 (set-effective-user) ;
112 M: string set-effective-user ( string -- )
113 user-id (set-effective-user) ;
116 { [ dup bsd? ] [ drop "unix.users.bsd" require ] }
117 { [ dup linux? ] [ drop ] }