Throw an error on certain combinators if a user/group does not exist
							parent
							
								
									e18bde069e
								
							
						
					
					
						commit
						27af7ffe50
					
				| 
						 | 
				
			
			@ -27,3 +27,4 @@ IN: unix.groups.tests
 | 
			
		|||
[ "888888888888888" ] [ 888888888888888 group-name ] unit-test
 | 
			
		||||
[ f ]
 | 
			
		||||
[ "please-oh-please-don't-have-a-group-named-this123lalala" group-struct ] unit-test
 | 
			
		||||
[ "please-oh-please-don't-have-a-group-named-this123lalala" ?group-id ] must-fail
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -61,6 +61,11 @@ PRIVATE>
 | 
			
		|||
: group-id ( string -- id/f )
 | 
			
		||||
    group-struct dup [ gr_gid>> ] when ;
 | 
			
		||||
 | 
			
		||||
ERROR: no-group string ;
 | 
			
		||||
 | 
			
		||||
: ?group-id ( string -- id )
 | 
			
		||||
    dup group-struct [ nip gr_gid>> ] [ no-group ] if* ;
 | 
			
		||||
 | 
			
		||||
<PRIVATE
 | 
			
		||||
 | 
			
		||||
: >groups ( byte-array n -- groups )
 | 
			
		||||
| 
						 | 
				
			
			@ -122,14 +127,14 @@ GENERIC: set-effective-group ( obj -- )
 | 
			
		|||
 | 
			
		||||
PRIVATE>
 | 
			
		||||
    
 | 
			
		||||
M: string set-real-group ( string -- )
 | 
			
		||||
    group-id (set-real-group) ;
 | 
			
		||||
 | 
			
		||||
M: integer set-real-group ( id -- )
 | 
			
		||||
    (set-real-group) ;
 | 
			
		||||
 | 
			
		||||
M: string set-real-group ( string -- )
 | 
			
		||||
    ?group-id (set-real-group) ;
 | 
			
		||||
 | 
			
		||||
M: integer set-effective-group ( id -- )    
 | 
			
		||||
    (set-effective-group) ;
 | 
			
		||||
 | 
			
		||||
M: string set-effective-group ( string -- )
 | 
			
		||||
    group-id (set-effective-group) ;
 | 
			
		||||
    ?group-id (set-effective-group) ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -27,3 +27,4 @@ IN: unix.users.tests
 | 
			
		|||
[ f ] [ 89898989898989898989898989898 user-passwd ] unit-test
 | 
			
		||||
 | 
			
		||||
[ f ] [ "thisusershouldnotexistabcdefg12345asdfasdfasdfasdfasdfasdfasdf" user-id ] unit-test
 | 
			
		||||
[ "thisusershouldnotexistabcdefg12345asdfasdfasdfasdfasdfasdfasdf" ?user-id ] must-fail
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -64,6 +64,11 @@ M: string user-passwd ( string -- passwd/f )
 | 
			
		|||
: user-id ( string -- id/f )
 | 
			
		||||
    user-passwd dup [ uid>> ] when ;
 | 
			
		||||
 | 
			
		||||
ERROR: no-user string ;
 | 
			
		||||
 | 
			
		||||
: ?user-id ( string -- id/f )
 | 
			
		||||
    dup user-passwd [ nip uid>> ] [ no-user ] if* ;
 | 
			
		||||
 | 
			
		||||
: real-user-id ( -- id )
 | 
			
		||||
    unix.ffi:getuid ; inline
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -100,17 +105,17 @@ GENERIC: set-effective-user ( string/id -- )
 | 
			
		|||
 | 
			
		||||
PRIVATE>
 | 
			
		||||
 | 
			
		||||
M: string set-real-user ( string -- )
 | 
			
		||||
    user-id (set-real-user) ;
 | 
			
		||||
 | 
			
		||||
M: integer set-real-user ( id -- )
 | 
			
		||||
    (set-real-user) ;
 | 
			
		||||
 | 
			
		||||
M: string set-real-user ( string -- )
 | 
			
		||||
    ?user-id (set-real-user) ;
 | 
			
		||||
 | 
			
		||||
M: integer set-effective-user ( id -- )
 | 
			
		||||
    (set-effective-user) ; 
 | 
			
		||||
 | 
			
		||||
M: string set-effective-user ( string -- )
 | 
			
		||||
    user-id (set-effective-user) ;
 | 
			
		||||
    ?user-id (set-effective-user) ;
 | 
			
		||||
 | 
			
		||||
os {
 | 
			
		||||
    { [ dup bsd? ] [ drop "unix.users.bsd" require ] }
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue