| 
									
										
										
										
											2010-09-19 15:02:32 -04:00
										 |  |  | ! Copyright (C) 2010 Doug Coleman. | 
					
						
							|  |  |  | ! See http://factorcode.org/license.txt for BSD license. | 
					
						
							|  |  |  | USING: accessors alien alien.data alien.syntax classes.struct | 
					
						
							|  |  |  | continuations fry kernel libc literals locals sequences | 
					
						
							| 
									
										
										
										
											2011-09-08 16:06:19 -04:00
										 |  |  | windows.advapi32 windows.errors windows.kernel32 windows.types | 
					
						
							|  |  |  | alien.c-types ;
 | 
					
						
							| 
									
										
										
										
											2010-09-19 15:02:32 -04:00
										 |  |  | IN: windows.privileges | 
					
						
							| 
									
										
										
										
											2009-09-19 03:44:40 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | ! Security tokens | 
					
						
							|  |  |  | !  http://msdn.microsoft.com/msdnmag/issues/05/03/TokenPrivileges/ | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : (open-process-token) ( handle -- handle )
 | 
					
						
							| 
									
										
										
										
											2010-05-23 03:07:47 -04:00
										 |  |  |     flags{ TOKEN_ADJUST_PRIVILEGES TOKEN_QUERY } | 
					
						
							|  |  |  |     { PHANDLE } | 
					
						
							| 
									
										
										
										
											2010-07-16 17:32:05 -04:00
										 |  |  |     [ OpenProcessToken win32-error=0/f ] | 
					
						
							| 
									
										
										
										
											2010-05-23 03:07:47 -04:00
										 |  |  |     with-out-parameters ;
 | 
					
						
							| 
									
										
										
										
											2009-09-19 03:44:40 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : open-process-token ( -- handle )
 | 
					
						
							| 
									
										
										
										
											2015-09-08 19:15:10 -04:00
										 |  |  |     ! remember to CloseHandle | 
					
						
							| 
									
										
										
										
											2009-09-19 03:44:40 -04:00
										 |  |  |     GetCurrentProcess (open-process-token) ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : with-process-token ( quot -- )
 | 
					
						
							| 
									
										
										
										
											2015-09-08 19:15:10 -04:00
										 |  |  |     ! quot: ( token-handle -- token-handle ) | 
					
						
							| 
									
										
										
										
											2009-09-19 03:44:40 -04:00
										 |  |  |     [ open-process-token ] dip
 | 
					
						
							|  |  |  |     [ keep ] curry
 | 
					
						
							|  |  |  |     [ CloseHandle drop ] [ ] cleanup ; inline
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : lookup-privilege ( string -- luid )
 | 
					
						
							|  |  |  |     [ f ] dip LUID <struct> | 
					
						
							|  |  |  |     [ LookupPrivilegeValue win32-error=0/f ] keep ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-09-19 11:01:12 -04:00
										 |  |  | :: make-token-privileges ( name enabled? -- obj )
 | 
					
						
							| 
									
										
										
										
											2009-09-19 03:44:40 -04:00
										 |  |  |     TOKEN_PRIVILEGES <struct> | 
					
						
							|  |  |  |         1 >>PrivilegeCount | 
					
						
							|  |  |  |         LUID_AND_ATTRIBUTES malloc-struct &free | 
					
						
							| 
									
										
										
										
											2009-09-19 11:01:12 -04:00
										 |  |  |             enabled? [ SE_PRIVILEGE_ENABLED >>Attributes ] when
 | 
					
						
							|  |  |  |             name lookup-privilege >>Luid | 
					
						
							|  |  |  |         >>Privileges ;
 | 
					
						
							| 
									
										
										
										
											2009-09-19 03:44:40 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-09-19 15:02:32 -04:00
										 |  |  | : set-privilege ( name ? -- )
 | 
					
						
							| 
									
										
										
										
											2010-05-03 18:31:01 -04:00
										 |  |  |     '[ | 
					
						
							|  |  |  |         0
 | 
					
						
							|  |  |  |         _ _ make-token-privileges | 
					
						
							|  |  |  |         dup byte-length | 
					
						
							|  |  |  |         f
 | 
					
						
							|  |  |  |         f
 | 
					
						
							|  |  |  |         AdjustTokenPrivileges win32-error=0/f | 
					
						
							| 
									
										
										
										
											2009-09-19 03:44:40 -04:00
										 |  |  |     ] with-process-token ;
 | 
					
						
							| 
									
										
										
										
											2010-09-19 15:02:32 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : with-privileges ( seq quot -- )
 | 
					
						
							|  |  |  |     [ '[ _ [ t set-privilege ] each @ ] ] | 
					
						
							|  |  |  |     [ drop '[ _ [ f set-privilege ] each ] ] | 
					
						
							|  |  |  |     2bi [ ] cleanup ; inline
 |