1# 2# Copyright (c) 2003-2015, Ashok P. Nadkarni 3# All rights reserved. 4# 5# See the file LICENSE for license 6 7# TBD - allow access rights to be specified symbolically using procs 8# from security.tcl 9# TBD - add -user option to get_process_info and get_thread_info 10# TBD - add wrapper for GetProcessExitCode 11 12namespace eval twapi {} 13 14 15# Create a process 16proc twapi::create_process {path args} { 17 array set opts [parseargs args { 18 {debugchildtree.bool 0 0x1} 19 {debugchild.bool 0 0x2} 20 {createsuspended.bool 0 0x4} 21 {detached.bool 0 0x8} 22 {newconsole.bool 0 0x10} 23 {newprocessgroup.bool 0 0x200} 24 {separatevdm.bool 0 0x800} 25 {sharedvdm.bool 0 0x1000} 26 {inheriterrormode.bool 1 0x04000000} 27 {noconsole.bool 0 0x08000000} 28 {priority.arg normal {normal abovenormal belownormal high realtime idle}} 29 30 {feedbackcursoron.bool 0 0x40} 31 {feedbackcursoroff.bool 0 0x80} 32 {fullscreen.bool 0 0x20} 33 34 {cmdline.arg ""} 35 {inheritablechildprocess.bool 0} 36 {inheritablechildthread.bool 0} 37 {childprocesssecd.arg ""} 38 {childthreadsecd.arg ""} 39 {inherithandles.bool 0} 40 {env.arg ""} 41 {startdir.arg ""} 42 {desktop.arg __null__} 43 {title.arg ""} 44 windowpos.arg 45 windowsize.arg 46 screenbuffersize.arg 47 background.arg 48 foreground.arg 49 {showwindow.arg ""} 50 {stdhandles.arg ""} 51 {stdchannels.arg ""} 52 {returnhandles.bool 0} 53 54 token.arg 55 } -maxleftover 0] 56 57 set process_sec_attr [_make_secattr $opts(childprocesssecd) $opts(inheritablechildprocess)] 58 set thread_sec_attr [_make_secattr $opts(childthreadsecd) $opts(inheritablechildthread)] 59 60 # Check incompatible options 61 if {$opts(newconsole) && $opts(detached)} { 62 error "Options -newconsole and -detached cannot be specified together" 63 } 64 if {$opts(sharedvdm) && $opts(separatevdm)} { 65 error "Options -sharedvdm and -separatevdm cannot be specified together" 66 } 67 68 # Create the start up info structure 69 set si_flags 0 70 if {[info exists opts(windowpos)]} { 71 lassign [_parse_integer_pair $opts(windowpos)] xpos ypos 72 setbits si_flags 0x4 73 } else { 74 set xpos 0 75 set ypos 0 76 } 77 if {[info exists opts(windowsize)]} { 78 lassign [_parse_integer_pair $opts(windowsize)] xsize ysize 79 setbits si_flags 0x2 80 } else { 81 set xsize 0 82 set ysize 0 83 } 84 if {[info exists opts(screenbuffersize)]} { 85 lassign [_parse_integer_pair $opts(screenbuffersize)] xscreen yscreen 86 setbits si_flags 0x8 87 } else { 88 set xscreen 0 89 set yscreen 0 90 } 91 92 set fg 7; # Default to white 93 set bg 0; # Default to black 94 if {[info exists opts(foreground)]} { 95 set fg [_map_console_color $opts(foreground) 0] 96 setbits si_flags 0x10 97 } 98 if {[info exists opts(background)]} { 99 set bg [_map_console_color $opts(background) 1] 100 setbits si_flags 0x10 101 } 102 103 set si_flags [expr {$si_flags | 104 $opts(feedbackcursoron) | $opts(feedbackcursoroff) | 105 $opts(fullscreen)}] 106 107 switch -exact -- $opts(showwindow) { 108 "" {set opts(showwindow) 1 } 109 hidden {set opts(showwindow) 0} 110 normal {set opts(showwindow) 1} 111 minimized {set opts(showwindow) 2} 112 maximized {set opts(showwindow) 3} 113 default {error "Invalid value '$opts(showwindow)' for -showwindow option"} 114 } 115 if {[string length $opts(showwindow)]} { 116 setbits si_flags 0x1 117 } 118 119 if {[llength $opts(stdhandles)] && [llength $opts(stdchannels)]} { 120 error "Options -stdhandles and -stdchannels cannot be used together" 121 } 122 123 if {[llength $opts(stdhandles)]} { 124 if {! $opts(inherithandles)} { 125 error "Cannot specify -stdhandles option if option -inherithandles is specified as 0" 126 } 127 128 setbits si_flags 0x100 129 } 130 131 # Figure out process creation flags 132 # 0x400 -> CREATE_UNICODE_ENVIRONMENT 133 set flags [expr {0x00000400 | 134 $opts(createsuspended) | $opts(debugchildtree) | 135 $opts(debugchild) | $opts(detached) | $opts(newconsole) | 136 $opts(newprocessgroup) | $opts(separatevdm) | 137 $opts(sharedvdm) | $opts(inheriterrormode) | 138 $opts(noconsole) }] 139 140 switch -exact -- $opts(priority) { 141 normal {set priority 0x00000020} 142 abovenormal {set priority 0x00008000} 143 belownormal {set priority 0x00004000} 144 "" {set priority 0} 145 high {set priority 0x00000080} 146 realtime {set priority 0x00000100} 147 idle {set priority 0x00000040} 148 default {error "Unknown priority '$priority'"} 149 } 150 set flags [expr {$flags | $priority}] 151 152 # Create the environment strings 153 if {[llength $opts(env)]} { 154 set child_env [list ] 155 foreach {envvar envval} $opts(env) { 156 lappend child_env "$envvar=$envval" 157 } 158 } else { 159 set child_env "__null__" 160 } 161 162 trap { 163 # This is inside the trap because duplicated handles have 164 # to be closed. 165 if {[llength $opts(stdchannels)]} { 166 if {! $opts(inherithandles)} { 167 error "Cannot specify -stdhandles option if option -inherithandles is specified as 0" 168 } 169 if {[llength $opts(stdchannels)] != 3} { 170 error "Must specify 3 channels for -stdchannels option corresponding stdin, stdout and stderr" 171 } 172 173 setbits si_flags 0x100 174 175 # Convert the channels to handles 176 lappend opts(stdhandles) [duplicate_handle [get_tcl_channel_handle [lindex $opts(stdchannels) 0] read] -inherit] 177 lappend opts(stdhandles) [duplicate_handle [get_tcl_channel_handle [lindex $opts(stdchannels) 1] write] -inherit] 178 lappend opts(stdhandles) [duplicate_handle [get_tcl_channel_handle [lindex $opts(stdchannels) 2] write] -inherit] 179 } 180 181 set startup [list $opts(desktop) $opts(title) $xpos $ypos \ 182 $xsize $ysize $xscreen $yscreen \ 183 [expr {$fg|$bg}] $si_flags $opts(showwindow) \ 184 $opts(stdhandles)] 185 186 if {[info exists opts(token)]} { 187 lassign [CreateProcessAsUser $opts(token) [file nativename $path] \ 188 $opts(cmdline) \ 189 $process_sec_attr $thread_sec_attr \ 190 $opts(inherithandles) $flags $child_env \ 191 [file normalize $opts(startdir)] $startup \ 192 ] ph th pid tid 193 194 } else { 195 lassign [CreateProcess [file nativename $path] \ 196 $opts(cmdline) \ 197 $process_sec_attr $thread_sec_attr \ 198 $opts(inherithandles) $flags $child_env \ 199 [file normalize $opts(startdir)] $startup \ 200 ] ph th pid tid 201 } 202 } finally { 203 # If opts(stdchannels) is not an empty list, we duplicated the handles 204 # into opts(stdhandles) ourselves so free them 205 if {[llength $opts(stdchannels)]} { 206 # Free corresponding handles in opts(stdhandles) 207 close_handles $opts(stdhandles) 208 } 209 } 210 211 # From the Tcl source code - (tclWinPipe.c) 212 # /* 213 # * "When an application spawns a process repeatedly, a new thread 214 # * instance will be created for each process but the previous 215 # * instances may not be cleaned up. This results in a significant 216 # * virtual memory loss each time the process is spawned. If there 217 # * is a WaitForInputIdle() call between CreateProcess() and 218 # * CloseHandle(), the problem does not occur." PSS ID Number: Q124121 219 # */ 220 # WaitForInputIdle $ph 5000 -- Apparently this is only needed for NT 3.5 221 222 223 if {$opts(returnhandles)} { 224 return [list $pid $tid $ph $th] 225 } else { 226 CloseHandle $th 227 CloseHandle $ph 228 return [list $pid $tid] 229 } 230} 231 232# Wait until the process is ready 233proc twapi::process_waiting_for_input {pid args} { 234 array set opts [parseargs args { 235 {wait.int 0} 236 } -maxleftover 0] 237 238 if {$pid == [pid]} { 239 variable my_process_handle 240 return [WaitForInputIdle $my_process_handle $opts(wait)] 241 } 242 243 set hpid [get_process_handle $pid] 244 trap { 245 return [WaitForInputIdle $hpid $opts(wait)] 246 } finally { 247 CloseHandle $hpid 248 } 249} 250 251 252 253# Get a handle to a process 254proc twapi::get_process_handle {pid args} { 255 # OpenProcess masks off the bottom two bits thereby converting 256 # an invalid pid to a real one. 257 if {(![string is integer -strict $pid]) || ($pid & 3)} { 258 win32_error 87 "Invalid PID '$pid'."; # "The parameter is incorrect" 259 } 260 array set opts [parseargs args { 261 {access.arg process_query_information} 262 {inherit.bool 0} 263 } -maxleftover 0] 264 return [OpenProcess [_access_rights_to_mask $opts(access)] $opts(inherit) $pid] 265} 266 267# Return true if passed pid is system 268proc twapi::is_system_pid {pid} { 269 # Note Windows 2000 System PID was 8 but we no longer support it. 270 return [expr {$pid == 4}] 271} 272 273# Return true if passed pid is of idle process 274proc twapi::is_idle_pid {pid} { 275 return [expr {$pid == 0}] 276} 277 278# Get my process id 279proc twapi::get_current_process_id {} { 280 return [::pid] 281} 282 283# Get my thread id 284proc twapi::get_current_thread_id {} { 285 return [GetCurrentThreadId] 286} 287 288# Get the exit code for a process. Returns "" if still running. 289proc twapi::get_process_exit_code {hpid} { 290 set code [GetExitCodeProcess $hpid] 291 return [expr {$code == 259 ? "" : $code}] 292} 293 294# Return list of process ids 295# Note if -path or -name is specified, then processes for which this 296# information cannot be obtained are skipped 297proc twapi::get_process_ids {args} { 298 299 set save_args $args; # Need to pass to process_exists 300 array set opts [parseargs args { 301 user.arg 302 path.arg 303 name.arg 304 logonsession.arg 305 glob} -maxleftover 0] 306 307 if {[info exists opts(path)] && [info exists opts(name)]} { 308 error "Options -path and -name are mutually exclusive" 309 } 310 311 if {$opts(glob)} { 312 set match_op ~ 313 } else { 314 set match_op eq 315 } 316 317 # If we do not care about user or path, Twapi_GetProcessList 318 # is faster than EnumProcesses or the WTS functions 319 if {[info exists opts(user)] == 0 && 320 [info exists opts(logonsession)] == 0 && 321 [info exists opts(path)] == 0} { 322 if {[info exists opts(name)] == 0} { 323 return [Twapi_GetProcessList -1 0] 324 } 325 # We need to match against the name 326 return [recordarray column [Twapi_GetProcessList -1 2] -pid \ 327 -filter [list [list "-name" $match_op $opts(name) -nocase]]] 328 } 329 330 # Only want pids with a specific user or path or logon session 331 332 # If is the name we are looking for, try using the faster WTS 333 # API's first. If they are not available, we try a slower method 334 # If we need to match paths or logon sessions, we don't try this 335 # at all as the wts api's don't provide that info 336 if {[info exists opts(path)] == 0 && 337 [info exists opts(logonsession)] == 0} { 338 if {![info exists opts(user)]} { 339 # How did we get here? 340 error "Internal error - option -user not specified where expected" 341 } 342 if {[catch {map_account_to_sid $opts(user)} sid]} { 343 # No such user. Return empty list (no processes) 344 return [list ] 345 } 346 347 if {[info exists opts(name)]} { 348 set filter_expr [list [list pUserSid eq $sid -nocase] [list pProcessName $match_op $opts(name) -nocase]] 349 } else { 350 set filter_expr [list [list pUserSid eq $sid -nocase]] 351 } 352 353 # Catch failures so we can try other means 354 if {! [catch {recordarray column [WTSEnumerateProcesses NULL] \ 355 ProcessId -filter $filter_expr} wtslist]} { 356 return $wtslist 357 } 358 } 359 360 set process_pids [list ] 361 362 363 # Either we are matching on path/logonsession, or the WTS call failed 364 # Try yet another way. 365 366 # Note that in the code below, we use "file join" with a single arg 367 # to convert \ to /. Do not use file normalize as that will also 368 # land up converting relative paths to full paths 369 if {[info exists opts(path)]} { 370 set opts(path) [file join $opts(path)] 371 } 372 373 set process_pids [list ] 374 if {[info exists opts(name)]} { 375 # Note we may reach here if the WTS call above failed 376 set all_pids [recordarray column [Twapi_GetProcessList -1 2] ProcessId -filter [list [list ProcessName $match_op $opts(name) -nocase]]] 377 } else { 378 set all_pids [Twapi_GetProcessList -1 0] 379 } 380 381 set filter_expr {} 382 set popts [list ] 383 if {[info exists opts(path)]} { 384 lappend popts -path 385 lappend filter_expr [list -path $match_op $opts(path) -nocase] 386 } 387 388 if {[info exists opts(user)]} { 389 lappend popts -user 390 lappend filter_expr [list -user eq $opts(user) -nocase] 391 } 392 if {[info exists opts(logonsession)]} { 393 lappend popts -logonsession 394 lappend filter_expr [list -logonsession eq $opts(logonsession) -nocase] 395 } 396 397 398 set matches [recordarray get [get_multiple_process_info -matchpids $all_pids {*}$popts] -filter $filter_expr] 399 return [recordarray column $matches -pid] 400} 401 402 403# Return list of modules handles for a process 404proc twapi::get_process_modules {pid args} { 405 variable my_process_handle 406 407 array set opts [parseargs args {handle name path base size entry all}] 408 409 if {$opts(all)} { 410 foreach opt {handle name path base size entry} { 411 set opts($opt) 1 412 } 413 } 414 set noopts [expr {($opts(name) || $opts(path) || $opts(base) || $opts(size) || $opts(entry) || $opts(handle)) == 0}] 415 416 if {! $noopts} { 417 # Returning a record array 418 set fields {} 419 # ORDER MUST be same a value order below 420 foreach opt {handle name path base size entry} { 421 if {$opts($opt)} { 422 lappend fields -$opt 423 } 424 } 425 426 } 427 428 if {$pid == [pid]} { 429 set hpid $my_process_handle 430 } else { 431 set hpid [get_process_handle $pid -access {process_query_information process_vm_read}] 432 } 433 434 set results [list ] 435 trap { 436 foreach module [EnumProcessModules $hpid] { 437 if {$noopts} { 438 lappend results $module 439 continue 440 } 441 set rec {} 442 if {$opts(handle)} { 443 lappend rec $module 444 } 445 if {$opts(name)} { 446 if {[catch {GetModuleBaseName $hpid $module} name]} { 447 set name "" 448 } 449 lappend rec $name 450 } 451 if {$opts(path)} { 452 if {[catch {GetModuleFileNameEx $hpid $module} path]} { 453 set path "" 454 } 455 lappend rec [_normalize_path $path] 456 } 457 if {$opts(base) || $opts(size) || $opts(entry)} { 458 if {[catch {GetModuleInformation $hpid $module} imagedata]} { 459 set base "" 460 set size "" 461 set entry "" 462 } else { 463 lassign $imagedata base size entry 464 } 465 foreach opt {base size entry} { 466 if {$opts($opt)} { 467 lappend rec [set $opt] 468 } 469 } 470 } 471 lappend results $rec 472 } 473 } finally { 474 if {$hpid != $my_process_handle} { 475 CloseHandle $hpid 476 } 477 } 478 479 if {$noopts} { 480 return $results 481 } else { 482 return [list $fields $results] 483 } 484} 485 486 487# Kill a process 488# Returns 1 if process was ended, 0 if not ended within timeout 489proc twapi::end_process {pid args} { 490 491 if {$pid == [pid]} { 492 error "The passed PID is the PID of the current process. end_process cannot be used to commit suicide." 493 } 494 495 array set opts [parseargs args { 496 {exitcode.int 1} 497 force 498 {wait.int 0} 499 }] 500 501 # In order to verify the process is really gone, we open the process 502 # if possible and then wait on its handle. If access restrictions prevent 503 # us from doing so, we ignore the issue and will simply check for the 504 # the PID later (which is not a sure check since PID's can be reused 505 # immediately) 506 catch {set hproc [get_process_handle $pid -access synchronize]} 507 508 # First try to close nicely. We need to send messages to toplevels 509 # as well as message-only windows. We could make use of get_toplevel_windows 510 # and find_windows but those would require pulling in the whole 511 # twapi_ui package so do it ourselves. 512 set toplevels {} 513 foreach toplevel [EnumWindows] { 514 # Check if it belongs to pid. Errors are ignored, we simply 515 # will not send a message to that window 516 catch { 517 if {[lindex [GetWindowThreadProcessId $toplevel] 1] == $pid} { 518 lappend toplevels $toplevel 519 } 520 } 521 } 522 # Repeat for message only windows as EnumWindows skips them 523 set prev 0 524 while {1} { 525 # Again, errors are ignored 526 # -3 -> HWND_MESSAGE windows 527 if {[catch { 528 set toplevel [FindWindowEx [list -3 HWND] $prev "" ""] 529 }]} { 530 break 531 } 532 if {[pointer_null? $toplevel]} break 533 catch { 534 if {[lindex [GetWindowThreadProcessId $toplevel] 1] == $pid} { 535 lappend toplevels $toplevel 536 } 537 } 538 set prev $toplevel 539 } 540 541 if {[llength $toplevels]} { 542 # Try and close by sending them a message. WM_CLOSE is 0x10 543 foreach toplevel $toplevels { 544 # Send a message but come back right away 545 # See Bug #139 as to why PostMessage instead of SendNotifyMessage 546 catch {PostMessage $toplevel 0x10 0 0} 547 } 548 549 # Wait for the specified time to verify process has gone away 550 if {[info exists hproc]} { 551 set status [WaitForSingleObject $hproc $opts(wait)] 552 CloseHandle $hproc 553 set gone [expr {! $status}] 554 } else { 555 # We could not get a process handle to wait on, just check if 556 # PID still exists. This COULD be a false positive... 557 set gone [twapi::wait {process_exists $pid} 0 $opts(wait)] 558 } 559 if {$gone || ! $opts(force)} { 560 # Succeeded or do not want to force a kill 561 return $gone 562 } 563 564 # Only wait 10 ms since we have already waited above 565 if {$opts(wait)} { 566 set opts(wait) 10 567 } 568 } 569 570 # Open the process for terminate access. IF access denied (5), retry after 571 # getting the required privilege 572 trap { 573 set hproc [get_process_handle $pid -access {synchronize process_terminate}] 574 } onerror {TWAPI_WIN32 5} { 575 # Retry - if still fail, then just throw the error 576 eval_with_privileges { 577 set hproc [get_process_handle $pid -access {synchronize process_terminate}] 578 } SeDebugPrivilege 579 } onerror {TWAPI_WIN32 87} { 580 # Process does not exist, we must have succeeded above but just 581 # took a bit longer for it to exit 582 return 1 583 } 584 585 trap { 586 TerminateProcess $hproc $opts(exitcode) 587 set status [WaitForSingleObject $hproc $opts(wait)] 588 if {$status == 0} { 589 return 1 590 } 591 } finally { 592 CloseHandle $hproc 593 } 594 595 return 0 596} 597 598# Get the path of a process 599proc twapi::get_process_path {pid args} { 600 return [twapi::_get_process_name_path_helper $pid path {*}$args] 601} 602 603# Get the path of a process 604proc twapi::get_process_name {pid args} { 605 return [twapi::_get_process_name_path_helper $pid name {*}$args] 606} 607 608 609# Return list of device drivers 610proc twapi::get_device_drivers {args} { 611 array set opts [parseargs args {name path base all}] 612 613 set fields {} 614 # Order MUST be same as order of values below 615 foreach opt {base name path} { 616 if {$opts($opt) || $opts(all)} { 617 lappend fields -$opt 618 } 619 } 620 621 set results [list ] 622 foreach module [EnumDeviceDrivers] { 623 unset -nocomplain rec 624 if {$opts(base) || $opts(all)} { 625 lappend rec $module 626 } 627 if {$opts(name) || $opts(all)} { 628 if {[catch {GetDeviceDriverBaseName $module} name]} { 629 set name "" 630 } 631 lappend rec $name 632 } 633 if {$opts(path) || $opts(all)} { 634 if {[catch {GetDeviceDriverFileName $module} path]} { 635 set path "" 636 } 637 lappend rec [_normalize_path $path] 638 } 639 if {[info exists rec]} { 640 lappend results $rec 641 } 642 } 643 644 return [list $fields $results] 645} 646 647# Check if the given process exists 648# 0 - does not exist or exists but paths/names do not match, 649# 1 - exists and matches path (or no -path or -name specified) 650# -1 - exists but do not know path and cannot compare 651proc twapi::process_exists {pid args} { 652 array set opts [parseargs args { path.arg name.arg glob}] 653 654 # Simplest case - don't care about name or path 655 if {! ([info exists opts(path)] || [info exists opts(name)])} { 656 if {$pid == [pid]} { 657 return 1 658 } 659 # TBD - would it be faster to do OpenProcess ? If success or 660 # access denied, process exists. 661 662 if {[llength [Twapi_GetProcessList $pid 0]] == 0} { 663 return 0 664 } else { 665 return 1 666 } 667 } 668 669 # Can't specify both name and path 670 if {[info exists opts(path)] && [info exists opts(name)]} { 671 error "Options -path and -name are mutually exclusive" 672 } 673 674 if {$opts(glob)} { 675 set string_cmd match 676 } else { 677 set string_cmd equal 678 } 679 680 if {[info exists opts(name)]} { 681 # Name is specified 682 set pidlist [Twapi_GetProcessList $pid 2] 683 if {[llength $pidlist] == 0} { 684 return 0 685 } 686 return [string $string_cmd -nocase $opts(name) [lindex $pidlist 1 0 1]] 687 } 688 689 # Need to match on the path 690 set process_path [get_process_path $pid -noexist "" -noaccess "(unknown)"] 691 if {[string length $process_path] == 0} { 692 # No such process 693 return 0 694 } 695 696 # Process with this pid exists 697 # Path still has to match 698 if {[string equal $process_path "(unknown)"]} { 699 # Exists but cannot check path/name 700 return -1 701 } 702 703 # Note we do not use file normalize here since that will tack on 704 # absolute paths which we do not want for glob matching 705 706 # We use [file join ] to convert \ to / to avoid special 707 # interpretation of \ in string match command 708 return [string $string_cmd -nocase [file join $opts(path)] [file join $process_path]] 709} 710 711# Get the parent process of a thread. Return "" if no such thread 712proc twapi::get_thread_parent_process_id {tid} { 713 set status [catch { 714 set th [get_thread_handle $tid] 715 trap { 716 set pid [lindex [lindex [Twapi_NtQueryInformationThreadBasicInformation $th] 2] 0] 717 } finally { 718 CloseHandle $th 719 } 720 }] 721 722 if {$status == 0} { 723 return $pid 724 } 725 726 727 # Could not use undocumented function. Try slooooow perf counter method 728 set pid_paths [get_perf_thread_counter_paths $tid -pid] 729 if {[llength $pid_paths] == 0} { 730 return "" 731 } 732 733 if {[pdh_counter_path_value [lindex [lindex $pid_paths 0] 3] -var pid]} { 734 return $pid 735 } else { 736 return "" 737 } 738} 739 740# Get the thread ids belonging to a process 741proc twapi::get_process_thread_ids {pid} { 742 return [recordarray cell [get_multiple_process_info -matchpids [list $pid] -tids] 0 -tids] 743} 744 745 746# Get process information 747proc twapi::get_process_info {pid args} { 748 # To avert a common mistake where pid is unspecified, use current pid 749 # so [get_process_info -name] becomes [get_process_info [pid] -name] 750 # TBD - should this be documented ? 751 752 if {![string is integer -strict $pid]} { 753 set args [linsert $args 0 $pid] 754 set pid [pid] 755 } 756 757 set rec [recordarray index [get_multiple_process_info {*}$args -matchpids [list $pid]] 0 -format dict] 758 if {"-pid" ni $args && "-all" ni $args} { 759 dict unset rec -pid 760 } 761 return $rec 762} 763 764 765# Get multiple process information 766# TBD - document and write tests 767proc twapi::get_multiple_process_info {args} { 768 769 # Options that are directly available from Twapi_GetProcessList 770 # Dict value is the flags to pass to Twapi_GetProcessList 771 set base_opts { 772 basepriority 1 773 parent 1 tssession 1 774 name 2 775 createtime 4 usertime 4 776 privilegedtime 4 handlecount 4 777 threadcount 4 778 pagefaults 8 pagefilebytes 8 779 pagefilebytespeak 8 poolnonpagedbytes 8 780 poolnonpagedbytespeak 8 poolpagedbytes 8 781 poolpagedbytespeak 8 virtualbytes 8 782 virtualbytespeak 8 workingset 8 783 workingsetpeak 8 784 ioreadops 16 iowriteops 16 785 iootherops 16 ioreadbytes 16 786 iowritebytes 16 iootherbytes 16 787 } 788 # Options that also dependent on Twapi_GetProcessList but not 789 # directly available 790 set base_calc_opts { elapsedtime 4 tids 32 } 791 792 # Note -user is also a potential token opt but not listed below 793 # because it can be gotten by other means 794 set token_opts { 795 disabledprivileges elevation enabledprivileges groupattrs groups 796 integrity integritylabel logonsession primarygroup primarygroupsid 797 privileges restrictedgroupattrs restrictedgroups virtualized 798 } 799 800 set optdefs [lconcat {all pid user path commandline priorityclass {noexist.arg {(no such process)}} {noaccess.arg {(unknown)}} matchpids.arg} \ 801 [dict keys $base_opts] \ 802 [dict keys $base_calc_opts] \ 803 $token_opts] 804 array set opts [parseargs args $optdefs -maxleftover 0] 805 set opts(pid) 1; # Always return pid, -pid option is for backward compat 806 807 if {[info exists opts(matchpids)]} { 808 set pids $opts(matchpids) 809 } else { 810 set pids [Twapi_GetProcessList -1 0] 811 } 812 813 set now [get_system_time] 814 815 # We will return a record array. $records tracks a dict of record 816 # values keyed by pid, $fields tracks the names in the list elements 817 # [llength $fields] == [llength [lindex $records *]] 818 set records {} 819 set fields {} 820 821 # If user is requested, try getting it through terminal services 822 # if possible since the token method fails on some newer platforms 823 if {$opts(all) || $opts(user)} { 824 _get_wts_pids wtssids wtsnames 825 } 826 827 # See if any Twapi_GetProcessList options are requested and if 828 # so, calculate the appropriate flags 829 set baseflags 0 830 set basenoexistvals {} 831 dict for {opt flag} $base_opts { 832 if {$opts($opt) || $opts(all)} { 833 set baseflags [expr {$baseflags | $flag}] 834 lappend basefields -$opt 835 lappend basenoexistvals $opts(noexist) 836 } 837 } 838 dict for {opt flag} $base_calc_opts { 839 if {$opts($opt) || $opts(all)} { 840 set baseflags [expr {$baseflags | $flag}] 841 } 842 } 843 844 # See if we need to retrieve any base options 845 if {$baseflags} { 846 set pidarg [expr {[llength $pids] == 1 ? [lindex $pids 0] : -1}] 847 set data [twapi::Twapi_GetProcessList $pidarg [expr {$baseflags|1}]] 848 if {$opts(all) || $opts(elapsedtime) || $opts(tids)} { 849 array set baserawdata [recordarray getdict $data -key "-pid" -format dict] 850 } 851 if {[info exists basefields]} { 852 set fields $basefields 853 set records [recordarray getdict $data -slice $basefields -key "-pid"] 854 } 855 } 856 if {$opts(pid)} { 857 lappend fields -pid 858 } 859 foreach pid $pids { 860 # If base values were requested, but this pid does not exist 861 # use the "noexist" values 862 if {![dict exists $records $pid]} { 863 dict set records $pid $basenoexistvals 864 } 865 if {$opts(pid)} { 866 dict lappend records $pid $pid 867 } 868 } 869 870 # If all we need are baseline options, and no massaging is required 871 # (as for elapsedtime, for example), we can return what we have 872 # without looping through below. Saves significant time. 873 set done 1 874 foreach opt [list all user elapsedtime tids path commandline priorityclass \ 875 {*}$token_opts] { 876 if {$opts($opt)} { 877 set done 0 878 break 879 } 880 } 881 882 if {$done} { 883 set return_data {} 884 foreach pid $pids { 885 lappend return_data [dict get $records $pid] 886 } 887 return [list $fields $return_data] 888 } 889 890 set requested_token_opts {} 891 foreach opt $token_opts { 892 if {$opts(all) || $opts($opt)} { 893 lappend requested_token_opts -$opt 894 } 895 } 896 897 if {$opts(elapsedtime) || $opts(all)} { 898 lappend fields -elapsedtime 899 foreach pid $pids { 900 if {[info exists baserawdata($pid)]} { 901 set elapsed [twapi::kl_get $baserawdata($pid) -createtime] 902 if {$elapsed} { 903 # 100ns -> seconds 904 dict lappend records $pid [expr {($now-$elapsed)/10000000}] 905 } else { 906 # For some processes like, System and Idle, kernel 907 # returns start time of 0. Just use system uptime 908 if {![info exists system_uptime]} { 909 # Store locally so no refetch on each iteration 910 set system_uptime [get_system_uptime] 911 } 912 dict lappend records $pid $system_uptime 913 } 914 } else { 915 dict lappend records $pid $opts(noexist) 916 } 917 } 918 } 919 920 if {$opts(tids) || $opts(all)} { 921 lappend fields -tids 922 foreach pid $pids { 923 if {[info exists baserawdata($pid)]} { 924 dict lappend records $pid [recordarray column [kl_get $baserawdata($pid) Threads] -tid] 925 } else { 926 dict lappend records $pid $opts(noexist) 927 } 928 } 929 } 930 931 if {$opts(all) || $opts(path)} { 932 lappend fields -path 933 foreach pid $pids { 934 dict lappend records $pid [get_process_path $pid -noexist $opts(noexist) -noaccess $opts(noaccess)] 935 } 936 } 937 938 if {$opts(all) || $opts(priorityclass)} { 939 lappend fields -priorityclass 940 foreach pid $pids { 941 trap { 942 set prioclass [get_priority_class $pid] 943 } onerror {TWAPI_WIN32 5} { 944 set prioclass $opts(noaccess) 945 } onerror {TWAPI_WIN32 87} { 946 set prioclass $opts(noexist) 947 } 948 dict lappend records $pid $prioclass 949 } 950 } 951 952 if {$opts(all) || $opts(commandline)} { 953 lappend fields -commandline 954 foreach pid $pids { 955 dict lappend records $pid [get_process_commandline $pid -noexist $opts(noexist) -noaccess $opts(noaccess)] 956 } 957 } 958 959 960 if {$opts(all) || $opts(user) || [llength $requested_token_opts]} { 961 foreach pid $pids { 962 # Now get token related info, if any requested 963 # For returning as a record array, we have to be careful that 964 # each field is added in a specific order for every pid 965 # keeping in mind a different method might be used for different 966 # pids. So we collect the data in dictionary token_records and add 967 # at the end in a fixed order 968 set token_records {} 969 set requested_opts $requested_token_opts 970 unset -nocomplain user 971 if {$opts(all) || $opts(user)} { 972 # See if we already have the user. Note sid of system idle 973 # will be empty string 974 if {[info exists wtssids($pid)]} { 975 if {$wtssids($pid) == ""} { 976 # Put user as System 977 set user SYSTEM 978 } else { 979 # We speed up account lookup by caching sids 980 if {[info exists sidcache($wtssids($pid))]} { 981 set user $sidcache($wtssids($pid)) 982 } else { 983 set user [lookup_account_sid $wtssids($pid)] 984 set sidcache($wtssids($pid)) $user 985 } 986 } 987 } else { 988 lappend requested_opts -user 989 } 990 } 991 992 if {[llength $requested_opts]} { 993 trap { 994 dict set token_records $pid [_token_info_helper -pid $pid {*}$requested_opts] 995 } onerror {TWAPI_WIN32 5} { 996 foreach opt $requested_opts { 997 dict set token_records $pid $opt $opts(noaccess) 998 } 999 # The NETWORK SERVICE and LOCAL SERVICE processes cannot 1000 # be accessed. If we are looking for the logon session for 1001 # these, try getting it from the witssid if we have it 1002 # since the logon session is hardcoded for these accounts 1003 if {"-logonsession" in $requested_opts} { 1004 if {![info exists wtssids]} { 1005 _get_wts_pids wtssids wtsnames 1006 } 1007 if {[info exists wtssids($pid)]} { 1008 # Map user SID to logon session 1009 switch -exact -- $wtssids($pid) { 1010 S-1-5-18 { 1011 # SYSTEM 1012 dict set token_records $pid -logonsession 00000000-000003e7 1013 } 1014 S-1-5-19 { 1015 # LOCAL SERVICE 1016 dict set token_records $pid -logonsession 00000000-000003e5 1017 } 1018 S-1-5-20 { 1019 # LOCAL SERVICE 1020 dict set token_records $pid -logonsession 00000000-000003e4 1021 } 1022 } 1023 } 1024 } 1025 1026 # Similarly, if we are looking for user account, special case 1027 # system and system idle processes 1028 if {"-user" in $requested_opts} { 1029 if {[is_idle_pid $pid] || [is_system_pid $pid]} { 1030 set user SYSTEM 1031 } 1032 } 1033 1034 } onerror {TWAPI_WIN32 87} { 1035 foreach opt $requested_opts { 1036 if {$opt eq "-user"} { 1037 if {[is_idle_pid $pid] || [is_system_pid $pid]} { 1038 set user SYSTEM 1039 } else { 1040 set user $opts(noexist) 1041 } 1042 } else { 1043 dict set token_records $pid $opt $opts(noexist) 1044 } 1045 } 1046 } 1047 } 1048 # Now add token values in a specific order - MUST MATCH fields BELOW 1049 if {$opts(all) || $opts(user)} { 1050 dict lappend records $pid $user 1051 } 1052 foreach opt $requested_token_opts { 1053 if {[dict exists $token_records $pid $opt]} { 1054 dict lappend records $pid [dict get $token_records $pid $opt] 1055 } 1056 } 1057 } 1058 # Now add token field names in a specific order - MUST MATCH ABOVE 1059 if {$opts(all) || $opts(user)} { 1060 lappend fields -user 1061 } 1062 foreach opt $requested_token_opts { 1063 if {[dict exists $token_records $pid $opt]} { 1064 lappend fields $opt 1065 } 1066 } 1067 } 1068 1069 set return_data {} 1070 foreach pid $pids { 1071 lappend return_data [dict get $records $pid] 1072 } 1073 return [list $fields $return_data] 1074} 1075 1076 1077 1078# Get thread information 1079# TBD - add info from GetGUIThreadInfo 1080proc twapi::get_thread_info {tid args} { 1081 # TBD - modify so tid is optional like for get_process_info 1082 1083 # Options that are directly available from Twapi_GetProcessList 1084 if {![info exists ::twapi::get_thread_info_base_opts]} { 1085 # Array value is the flags to pass to Twapi_GetProcessList 1086 array set ::twapi::get_thread_info_base_opts { 1087 pid 32 1088 elapsedtime 96 1089 waittime 96 1090 usertime 96 1091 createtime 96 1092 privilegedtime 96 1093 contextswitches 96 1094 basepriority 160 1095 priority 160 1096 startaddress 160 1097 state 160 1098 waitreason 160 1099 } 1100 } 1101 1102 set token_opts { 1103 user 1104 primarygroup 1105 primarygroupsid 1106 groups 1107 restrictedgroups 1108 groupattrs 1109 restrictedgroupattrs 1110 privileges 1111 enabledprivileges 1112 disabledprivileges 1113 } 1114 1115 array set opts [parseargs args \ 1116 [concat [list all \ 1117 relativepriority \ 1118 tid \ 1119 [list noexist.arg "(no such thread)"] \ 1120 [list noaccess.arg "(unknown)"]] \ 1121 [array names ::twapi::get_thread_info_base_opts] \ 1122 $token_opts ]] 1123 1124 set requested_opts [_array_non_zero_switches opts $token_opts $opts(all)] 1125 # Now get token info, if any 1126 if {[llength $requested_opts]} { 1127 trap { 1128 trap { 1129 set results [_token_info_helper -tid $tid {*}$requested_opts] 1130 } onerror {TWAPI_WIN32 1008} { 1131 # Thread does not have its own token. Use it's parent process 1132 set results [_token_info_helper -pid [get_thread_parent_process_id $tid] {*}$requested_opts] 1133 } 1134 } onerror {TWAPI_WIN32 5} { 1135 # No access 1136 foreach opt $requested_opts { 1137 lappend results $opt $opts(noaccess) 1138 } 1139 } onerror {TWAPI_WIN32 87} { 1140 # Thread does not exist 1141 foreach opt $requested_opts { 1142 lappend results $opt $opts(noexist) 1143 } 1144 } 1145 1146 } else { 1147 set results [list ] 1148 } 1149 1150 # Now get the base options 1151 set flags 0 1152 foreach opt [array names ::twapi::get_thread_info_base_opts] { 1153 if {$opts($opt) || $opts(all)} { 1154 set flags [expr {$flags | $::twapi::get_thread_info_base_opts($opt)}] 1155 } 1156 } 1157 1158 if {$flags} { 1159 # We need at least one of the base options 1160 foreach tdata [recordarray column [twapi::Twapi_GetProcessList -1 $flags] Threads] { 1161 set tdict [recordarray getdict $tdata -key "-tid" -format dict] 1162 if {[dict exists $tdict $tid]} { 1163 array set threadinfo [dict get $tdict $tid] 1164 break 1165 } 1166 } 1167 # It is possible that we looped through all the processes without 1168 # a thread match. Hence we check again that we have threadinfo for 1169 # each option value 1170 foreach opt { 1171 pid 1172 waittime 1173 usertime 1174 createtime 1175 privilegedtime 1176 basepriority 1177 priority 1178 startaddress 1179 state 1180 waitreason 1181 contextswitches 1182 } { 1183 if {$opts($opt) || $opts(all)} { 1184 if {[info exists threadinfo]} { 1185 lappend results -$opt $threadinfo(-$opt) 1186 } else { 1187 lappend results -$opt $opts(noexist) 1188 } 1189 } 1190 } 1191 1192 if {$opts(elapsedtime) || $opts(all)} { 1193 if {[info exists threadinfo(-createtime)]} { 1194 lappend results -elapsedtime [expr {[clock seconds]-[large_system_time_to_secs $threadinfo(-createtime)]}] 1195 } else { 1196 lappend results -elapsedtime $opts(noexist) 1197 } 1198 } 1199 } 1200 1201 1202 if {$opts(all) || $opts(relativepriority)} { 1203 trap { 1204 lappend results -relativepriority [get_thread_relative_priority $tid] 1205 } onerror {TWAPI_WIN32 5} { 1206 lappend results -relativepriority $opts(noaccess) 1207 } onerror {TWAPI_WIN32 87} { 1208 lappend results -relativepriority $opts(noexist) 1209 } 1210 } 1211 1212 if {$opts(all) || $opts(tid)} { 1213 lappend results -tid $tid 1214 } 1215 1216 return $results 1217} 1218 1219# Get a handle to a thread 1220proc twapi::get_thread_handle {tid args} { 1221 # OpenThread masks off the bottom two bits thereby converting 1222 # an invalid tid to a real one. We do not want this. 1223 if {$tid & 3} { 1224 win32_error 87; # "The parameter is incorrect" 1225 } 1226 1227 array set opts [parseargs args { 1228 {access.arg thread_query_information} 1229 {inherit.bool 0} 1230 }] 1231 return [OpenThread [_access_rights_to_mask $opts(access)] $opts(inherit) $tid] 1232} 1233 1234# Suspend a thread 1235proc twapi::suspend_thread {tid} { 1236 set htid [get_thread_handle $tid -access thread_suspend_resume] 1237 trap { 1238 set status [SuspendThread $htid] 1239 } finally { 1240 CloseHandle $htid 1241 } 1242 return $status 1243} 1244 1245# Resume a thread 1246proc twapi::resume_thread {tid} { 1247 set htid [get_thread_handle $tid -access thread_suspend_resume] 1248 trap { 1249 set status [ResumeThread $htid] 1250 } finally { 1251 CloseHandle $htid 1252 } 1253 return $status 1254} 1255 1256# Get the command line for a process 1257proc twapi::get_process_commandline {pid args} { 1258 1259 if {[is_system_pid $pid] || [is_idle_pid $pid]} { 1260 return "" 1261 } 1262 1263 array set opts [parseargs args { 1264 {noexist.arg "(no such process)"} 1265 {noaccess.arg "(unknown)"} 1266 }] 1267 1268 trap { 1269 # Assume max command line len is 1024 chars (2048 bytes) 1270 trap { 1271 set hpid [get_process_handle $pid -access {process_query_information process_vm_read}] 1272 } onerror {TWAPI_WIN32 87} { 1273 # Process does not exist 1274 return $opts(noexist) 1275 } 1276 1277 # Get the address where the PEB is stored - see Nebbett 1278 set peb_addr [lindex [Twapi_NtQueryInformationProcessBasicInformation $hpid] 1] 1279 1280 # Read the PEB as binary 1281 # The pointer to the process parameter block is the 5th pointer field. 1282 # The struct looks like: 1283 # 32 bit - 1284 # typedef struct _PEB { 1285 # BYTE Reserved1[2]; 1286 # BYTE BeingDebugged; 1287 # BYTE Reserved2[1]; 1288 # PVOID Reserved3[2]; 1289 # PPEB_LDR_DATA Ldr; 1290 # PRTL_USER_PROCESS_PARAMETERS ProcessParameters; 1291 # BYTE Reserved4[104]; 1292 # PVOID Reserved5[52]; 1293 # PPS_POST_PROCESS_INIT_ROUTINE PostProcessInitRoutine; 1294 # BYTE Reserved6[128]; 1295 # PVOID Reserved7[1]; 1296 # ULONG SessionId; 1297 # } PEB, *PPEB; 1298 # 64 bit - 1299 # typedef struct _PEB { 1300 # BYTE Reserved1[2]; 1301 # BYTE BeingDebugged; 1302 # BYTE Reserved2[21]; 1303 # PPEB_LDR_DATA LoaderData; 1304 # PRTL_USER_PROCESS_PARAMETERS ProcessParameters; 1305 # BYTE Reserved3[520]; 1306 # PPS_POST_PROCESS_INIT_ROUTINE PostProcessInitRoutine; 1307 # BYTE Reserved4[136]; 1308 # ULONG SessionId; 1309 # } PEB; 1310 # So in both cases the pointer is 4 pointers from the start 1311 1312 if {[info exists ::tcl_platform(pointerSize)]} { 1313 set pointer_size $::tcl_platform(pointerSize) 1314 } else { 1315 set pointer_size 4 1316 } 1317 if {$pointer_size == 4} { 1318 set pointer_scanner n 1319 } else { 1320 set pointer_scanner m 1321 } 1322 set mem [ReadProcessMemory $hpid [expr {$peb_addr+(4*$pointer_size)}] $pointer_size] 1323 if {![binary scan $mem $pointer_scanner proc_param_addr]} { 1324 error "Could not read PEB of process $pid" 1325 } 1326 1327 # Now proc_param_addr contains the address of the Process parameter 1328 # structure which looks like: 1329 # typedef struct _RTL_USER_PROCESS_PARAMETERS { 1330 # Offsets: x86 x64 1331 # BYTE Reserved1[16]; 0 0 1332 # PVOID Reserved2[10]; 16 16 1333 # UNICODE_STRING ImagePathName; 56 96 1334 # UNICODE_STRING CommandLine; 64 112 1335 # } RTL_USER_PROCESS_PARAMETERS, *PRTL_USER_PROCESS_PARAMETERS; 1336 # UNICODE_STRING is defined as 1337 # typedef struct _UNICODE_STRING { 1338 # USHORT Length; 1339 # USHORT MaximumLength; 1340 # PWSTR Buffer; 1341 # } UNICODE_STRING; 1342 1343 # Note - among twapi supported builds, tcl_platform(pointerSize) 1344 # not existing implies 32-bits 1345 if {[info exists ::tcl_platform(pointerSize)] && 1346 $::tcl_platform(pointerSize) == 8} { 1347 # Read the CommandLine field 1348 set mem [ReadProcessMemory $hpid [expr {$proc_param_addr + 112}] 16] 1349 if {![binary scan $mem tutunum cmdline_bytelen cmdline_bufsize unused cmdline_addr]} { 1350 error "Could not get address of command line" 1351 } 1352 } else { 1353 # Read the CommandLine field 1354 set mem [ReadProcessMemory $hpid [expr {$proc_param_addr + 64}] 8] 1355 if {![binary scan $mem tutunu cmdline_bytelen cmdline_bufsize cmdline_addr]} { 1356 error "Could not get address of command line" 1357 } 1358 } 1359 1360 if {1} { 1361 if {$cmdline_bytelen == 0} { 1362 set cmdline "" 1363 } else { 1364 trap { 1365 set mem [ReadProcessMemory $hpid $cmdline_addr $cmdline_bytelen] 1366 } onerror {TWAPI_WIN32 299} { 1367 # ERROR_PARTIAL_COPY 1368 # Rumour has it this can be a transient error if the 1369 # process is initializing, so try once more 1370 Sleep 0; # Relinquish control to OS to run other process 1371 # Retry 1372 set mem [ReadProcessMemory $hpid $cmdline_addr $cmdline_bytelen] 1373 } 1374 } 1375 } else { 1376 THIS CODE NEEDS TO BE MODIFIED IF REINSTATED. THE ReadProcessMemory 1377 parameters have changed 1378 # Old pre-2.3 code 1379 # Now read the command line itself. We do not know the length 1380 # so assume MAX_PATH (1024) chars (2048 bytes). However, this may 1381 # fail if the memory beyond the command line is not allocated in the 1382 # target process. So we have to check for this error and retry with 1383 # smaller read sizes 1384 set max_len 2048 1385 while {$max_len > 128} { 1386 trap { 1387 ReadProcessMemory $hpid $cmdline_addr $pgbl $max_len 1388 break 1389 } onerror {TWAPI_WIN32 299} { 1390 # Reduce read size 1391 set max_len [expr {$max_len / 2}] 1392 } 1393 } 1394 # OK, got something. It's in Unicode format, may not be null terminated 1395 # or may have multiple null terminated strings. THe command line 1396 # is the first string. 1397 } 1398 set cmdline [encoding convertfrom unicode $mem] 1399 set null_offset [string first "\0" $cmdline] 1400 if {$null_offset >= 0} { 1401 set cmdline [string range $cmdline 0 [expr {$null_offset-1}]] 1402 } 1403 1404 } onerror {TWAPI_WIN32 5} { 1405 # Access denied 1406 set cmdline $opts(noaccess) 1407 } onerror {TWAPI_WIN32 299} { 1408 # Only part of the Read* could be completed 1409 # Access denied 1410 set cmdline $opts(noaccess) 1411 } onerror {TWAPI_WIN32 87} { 1412 # The parameter is incorrect 1413 # Access denied (or should it be noexist?) 1414 set cmdline $opts(noaccess) 1415 } finally { 1416 if {[info exists hpid]} { 1417 CloseHandle $hpid 1418 } 1419 } 1420 1421 return $cmdline 1422} 1423 1424 1425# Get process parent - can return "" 1426proc twapi::get_process_parent {pid args} { 1427 array set opts [parseargs args { 1428 {noexist.arg "(no such process)"} 1429 {noaccess.arg "(unknown)"} 1430 }] 1431 1432 if {[is_system_pid $pid] || [is_idle_pid $pid]} { 1433 return "" 1434 } 1435 1436 trap { 1437 set parent [recordarray cell [twapi::Twapi_GetProcessList $pid 1] 0 InheritedFromProcessId] 1438 if {$parent ne ""} { 1439 return $parent 1440 } 1441 } onerror {} { 1442 # Just try the other methods below 1443 } 1444 1445 trap { 1446 set hpid [get_process_handle $pid] 1447 return [lindex [Twapi_NtQueryInformationProcessBasicInformation $hpid] 5] 1448 1449 } onerror {TWAPI_WIN32 5} { 1450 set error noaccess 1451 } onerror {TWAPI_WIN32 87} { 1452 set error noexist 1453 } finally { 1454 if {[info exists hpid]} { 1455 CloseHandle $hpid 1456 } 1457 } 1458 1459 return $opts($error) 1460} 1461 1462# Get the base priority class of a process 1463proc twapi::get_priority_class {pid} { 1464 set ph [get_process_handle $pid] 1465 trap { 1466 return [GetPriorityClass $ph] 1467 } finally { 1468 CloseHandle $ph 1469 } 1470} 1471 1472# Get the base priority class of a process 1473proc twapi::set_priority_class {pid priority} { 1474 if {$pid == [pid]} { 1475 variable my_process_handle 1476 SetPriorityClass $my_process_handle $priority 1477 return 1478 } 1479 1480 set ph [get_process_handle $pid -access process_set_information] 1481 trap { 1482 SetPriorityClass $ph $priority 1483 } finally { 1484 CloseHandle $ph 1485 } 1486} 1487 1488# Get the priority of a thread 1489proc twapi::get_thread_relative_priority {tid} { 1490 set h [get_thread_handle $tid] 1491 trap { 1492 return [GetThreadPriority $h] 1493 } finally { 1494 CloseHandle $h 1495 } 1496} 1497 1498# Set the priority of a thread 1499proc twapi::set_thread_relative_priority {tid priority} { 1500 switch -exact -- $priority { 1501 abovenormal { set priority 1 } 1502 belownormal { set priority -1 } 1503 highest { set priority 2 } 1504 idle { set priority -15 } 1505 lowest { set priority -2 } 1506 normal { set priority 0 } 1507 timecritical { set priority 15 } 1508 default { 1509 if {![string is integer -strict $priority]} { 1510 error "Invalid priority value '$priority'." 1511 } 1512 } 1513 } 1514 1515 set h [get_thread_handle $tid -access thread_set_information] 1516 trap { 1517 SetThreadPriority $h $priority 1518 } finally { 1519 CloseHandle $h 1520 } 1521} 1522 1523# Return type of process elevation 1524proc twapi::get_process_elevation {args} { 1525 lappend args -elevation 1526 return [lindex [_token_info_helper $args] 1] 1527} 1528 1529# Return integrity level of process 1530proc twapi::get_process_integrity {args} { 1531 lappend args -integrity 1532 return [lindex [_token_info_helper $args] 1] 1533} 1534 1535# Return whether a process is running under WoW64 1536proc twapi::wow64_process {args} { 1537 array set opts [parseargs args { 1538 pid.arg 1539 hprocess.arg 1540 } -maxleftover 0] 1541 1542 if {[info exists opts(hprocess)]} { 1543 if {[info exists opts(pid)]} { 1544 error "Options -pid and -hprocess cannot be used together." 1545 } 1546 return [IsWow64Process $opts(hprocess)] 1547 } 1548 1549 if {[info exists opts(pid)] && $opts(pid) != [pid]} { 1550 trap { 1551 set hprocess [get_process_handle $opts(pid)] 1552 return [IsWow64Process $hprocess] 1553 } finally { 1554 if {[info exists hprocess]} { 1555 CloseHandle $hprocess 1556 } 1557 } 1558 } 1559 1560 # Common case - checking about ourselves 1561 variable my_process_handle 1562 return [IsWow64Process $my_process_handle] 1563} 1564 1565# Check whether a process is virtualized 1566proc twapi::virtualized_process {args} { 1567 lappend args -virtualized 1568 return [lindex [_token_info_helper $args] 1] 1569} 1570 1571proc twapi::set_process_integrity {level args} { 1572 lappend args -integrity $level 1573 _token_set_helper $args 1574} 1575 1576proc twapi::set_process_virtualization {enable args} { 1577 lappend args -virtualized $enable 1578 _token_set_helper $args 1579} 1580 1581# Map a process handle to its pid 1582proc twapi::get_pid_from_handle {hprocess} { 1583 return [lindex [Twapi_NtQueryInformationProcessBasicInformation $hprocess] 4] 1584} 1585 1586# Check if current process is an administrative process or not 1587proc twapi::process_in_administrators {} { 1588 1589 # Administrators group SID - S-1-5-32-544 1590 1591 if {[get_process_elevation] ne "limited"} { 1592 return [CheckTokenMembership NULL S-1-5-32-544] 1593 } 1594 1595 # When running as with a limited token under UAC, we cannot check 1596 # if the process is in administrators group or not since the group 1597 # will be disabled in the token. Rather, we need to get the linked 1598 # token (which is unfiltered) and check that. 1599 set tok [lindex [_token_info_helper -linkedtoken] 1] 1600 trap { 1601 return [CheckTokenMembership $tok S-1-5-32-544] 1602 } finally { 1603 close_token $tok 1604 } 1605} 1606 1607# Get a module handle 1608# TBD - document 1609proc twapi::get_module_handle {args} { 1610 array set opts [parseargs args { 1611 path.arg 1612 pin.bool 1613 } -nulldefault -maxleftover 0] 1614 1615 return [GetModuleHandleEx $opts(pin) [file nativename $opts(path)]] 1616} 1617 1618# Get a module handle from an address 1619# TBD - document 1620proc twapi::get_module_handle_from_address {addr args} { 1621 array set opts [parseargs args { 1622 pin.bool 1623 } -nulldefault -maxleftover 0] 1624 1625 return [GetModuleHandleEx [expr {$opts(pin) ? 5 : 4}] $addr] 1626} 1627 1628 1629proc twapi::load_user_profile {token args} { 1630 # PI_NOUI -> 0x1 1631 parseargs args { 1632 username.arg 1633 {noui.bool 0 0x1} 1634 defaultuserpath.arg 1635 servername.arg 1636 roamingprofilepath.arg 1637 } -maxleftover 0 -setvars -nulldefault 1638 1639 if {$username eq ""} { 1640 set username [get_token_user $token -name] 1641 } 1642 1643 return [eval_with_privileges { 1644 LoadUserProfile [list $token $noui $username $roamingprofilepath $defaultuserpath $servername] 1645 } {SeRestorePrivilege SeBackupPrivilege}] 1646} 1647 1648# TBD - document 1649proc twapi::get_profile_type {} { 1650 return [dict* {0 local 1 temporary 2 roaming 4 mandatory} [GetProfileType]] 1651} 1652 1653 1654proc twapi::_env_block_to_dict {block normalize} { 1655 set env_dict {} 1656 foreach env_str $block { 1657 set pos [string first = $env_str] 1658 set key [string range $env_str 0 $pos-1] 1659 if {$normalize} { 1660 set key [string toupper $key] 1661 } 1662 lappend env_dict $key [string range $env_str $pos+1 end] 1663 } 1664 return $env_dict 1665} 1666 1667proc twapi::get_system_environment_vars {args} { 1668 parseargs args {normalize.bool} -nulldefault -setvars -maxleftover 0 1669 return [_env_block_to_dict [CreateEnvironmentBlock 0 0] $normalize] 1670} 1671 1672proc twapi::get_user_environment_vars {token args} { 1673 parseargs args {inherit.bool normalize.bool} -nulldefault -setvars -maxleftover 0 1674 return [_env_block_to_dict [CreateEnvironmentBlock $token $inherit] $normalize] 1675} 1676 1677proc twapi::expand_system_environment_vars {s} { 1678 return [ExpandEnvironmentStringsForUser 0 $s] 1679} 1680 1681proc twapi::expand_user_environment_vars {tok s} { 1682 return [ExpandEnvironmentStringsForUser $tok $s] 1683} 1684 1685# 1686# Utility procedures 1687 1688# Get the path of a process 1689proc twapi::_get_process_name_path_helper {pid {type name} args} { 1690 1691 if {$pid == [pid]} { 1692 # It is our process! 1693 set exe [info nameofexecutable] 1694 if {$type eq "name"} { 1695 return [file tail $exe] 1696 } else { 1697 return $exe 1698 } 1699 } 1700 1701 array set opts [parseargs args { 1702 {noexist.arg "(no such process)"} 1703 {noaccess.arg "(unknown)"} 1704 } -maxleftover 0] 1705 1706 if {![string is integer $pid]} { 1707 error "Invalid non-numeric pid $pid" 1708 } 1709 if {[is_system_pid $pid]} { 1710 return "System" 1711 } 1712 if {[is_idle_pid $pid]} { 1713 return "System Idle Process" 1714 } 1715 1716 # Try the quicker way if looking for a name 1717 if {$type eq "name" && 1718 ![catch { 1719 Twapi_GetProcessList $pid 2 1720 } plist]} { 1721 set name [lindex $plist 1 0 1] 1722 if {$name ne ""} { 1723 return $name 1724 } 1725 } 1726 1727 # We first try using GetProcessImageFileName as that does not require 1728 # the PROCESS_VM_READ privilege 1729 if {[min_os_version 6 0]} { 1730 set privs [list process_query_limited_information] 1731 } else { 1732 set privs [list process_query_information] 1733 } 1734 1735 trap { 1736 set hprocess [get_process_handle $pid -access $privs] 1737 set path [GetProcessImageFileName $hprocess] 1738 if {$type eq "name"} { 1739 return [file tail $path] 1740 } 1741 # Returned path is in native format, convert to win32 1742 return [normalize_device_rooted_path $path] 1743 } onerror {TWAPI_WIN32 87} { 1744 return $opts(noexist) 1745 } onerror {} { 1746 # Other errors, continue on to other methods 1747 } finally { 1748 if {[info exists hprocess]} { 1749 twapi::close_handle $hprocess 1750 } 1751 } 1752 1753 trap { 1754 set hprocess [get_process_handle $pid -access {process_query_information process_vm_read}] 1755 } onerror {TWAPI_WIN32 87} { 1756 return $opts(noexist) 1757 } onerror {TWAPI_WIN32 5} { 1758 # Access denied 1759 # If it is the name we want, first try WTS and if that 1760 # fails try getting it from PDH (slowest) 1761 1762 if {[string equal $type "name"]} { 1763 if {! [catch {WTSEnumerateProcesses NULL} precords]} { 1764 1765 return [lindex [recordarray column $precords pProcessName -filter [list [list ProcessId == $pid]]] 0] 1766 } 1767 1768 # That failed as well, try PDH. TBD - get rid of PDH 1769 set pdh_path [lindex [lindex [twapi::get_perf_process_counter_paths [list $pid] -pid] 0] 3] 1770 array set pdhinfo [pdh_parse_counter_path $pdh_path] 1771 return $pdhinfo(instance) 1772 } 1773 return $opts(noaccess) 1774 } 1775 1776 trap { 1777 set module [lindex [EnumProcessModules $hprocess] 0] 1778 if {[string equal $type "name"]} { 1779 set path [GetModuleBaseName $hprocess $module] 1780 } else { 1781 set path [_normalize_path [GetModuleFileNameEx $hprocess $module]] 1782 } 1783 } onerror {TWAPI_WIN32 5} { 1784 # Access denied 1785 # On win2k (and may be Win2k3), if the process has exited but some 1786 # app still has a handle to the process, the OpenProcess succeeds 1787 # but the EnumProcessModules call returns access denied. So 1788 # check for this case 1789 if {[min_os_version 5 0]} { 1790 # Try getting exit code. 259 means still running. 1791 # Anything else means process has terminated 1792 if {[GetExitCodeProcess $hprocess] == 259} { 1793 return $opts(noaccess) 1794 } else { 1795 return $opts(noexist) 1796 } 1797 } else { 1798 rethrow 1799 } 1800 } onerror {TWAPI_WIN32 299} { 1801 # Partial read - usually means either we are WOW64 and target 1802 # is 64bit, or process is exiting / starting and not all mem is 1803 # reachable yet 1804 return $opts(noaccess) 1805 } finally { 1806 CloseHandle $hprocess 1807 } 1808 return $path 1809} 1810 1811# Fill in arrays with result from WTSEnumerateProcesses if available 1812proc twapi::_get_wts_pids {v_sids v_names} { 1813 # Note this call is expected to fail on NT 4.0 without terminal server 1814 if {! [catch {WTSEnumerateProcesses NULL} precords]} { 1815 upvar $v_sids wtssids 1816 upvar $v_names wtsnames 1817 array set wtssids [recordarray getlist $precords -slice {ProcessId pUserSid} -format flat] 1818 array set wtsnames [recordarray getlist $precords -slice {ProcessId pUserSid} -format flat] 1819 } 1820} 1821 1822# Return various information from a process token 1823proc twapi::_token_info_helper {args} { 1824 package require twapi_security 1825 proc _token_info_helper {args} { 1826 if {[llength $args] == 1} { 1827 # All options specified as one argument 1828 set args [lindex $args 0] 1829 } 1830 1831 if {0} { 1832 Following options are passed on to get_token_info: 1833 elevation 1834 virtualized 1835 groups 1836 restrictedgroups 1837 primarygroup 1838 primarygroupsid 1839 privileges 1840 enabledprivileges 1841 disabledprivileges 1842 logonsession 1843 linkedtoken 1844 Option -integrity is not passed on because it has to deal with 1845 -raw and -label options 1846 } 1847 1848 array set opts [parseargs args { 1849 pid.arg 1850 hprocess.arg 1851 tid.arg 1852 hthread.arg 1853 integrity 1854 raw 1855 label 1856 user 1857 } -ignoreunknown] 1858 1859 if {[expr {[info exists opts(pid)] + [info exists opts(hprocess)] + 1860 [info exists opts(tid)] + [info exists opts(hthread)]}] > 1} { 1861 error "At most one option from -pid, -tid, -hprocess, -hthread can be specified." 1862 } 1863 1864 if {$opts(user)} { 1865 lappend args -usersid 1866 } 1867 1868 if {[info exists opts(hprocess)]} { 1869 set tok [open_process_token -hprocess $opts(hprocess)] 1870 } elseif {[info exists opts(pid)]} { 1871 set tok [open_process_token -pid $opts(pid)] 1872 } elseif {[info exists opts(hthread)]} { 1873 set tok [open_thread_token -hthread $opts(hthread)] 1874 } elseif {[info exists opts(tid)]} { 1875 set tok [open_thread_token -tid $opts(tid)] 1876 } else { 1877 # Default is current process 1878 set tok [open_process_token] 1879 } 1880 1881 trap { 1882 array set result [get_token_info $tok {*}$args] 1883 if {[info exists result(-usersid)]} { 1884 set result(-user) [lookup_account_sid $result(-usersid)] 1885 unset result(-usersid) 1886 } 1887 if {$opts(integrity)} { 1888 if {$opts(raw)} { 1889 set integrity [get_token_integrity $tok -raw] 1890 } elseif {$opts(label)} { 1891 set integrity [get_token_integrity $tok -label] 1892 } else { 1893 set integrity [get_token_integrity $tok] 1894 } 1895 set result(-integrity) $integrity 1896 } 1897 } finally { 1898 close_token $tok 1899 } 1900 1901 return [array get result] 1902 } 1903 1904 return [_token_info_helper {*}$args] 1905} 1906 1907# Set various information for a process token 1908# Caller assumed to have enabled appropriate privileges 1909proc twapi::_token_set_helper {args} { 1910 package require twapi_security 1911 1912 proc _token_set_helper {args} { 1913 if {[llength $args] == 1} { 1914 # All options specified as one argument 1915 set args [lindex $args 0] 1916 } 1917 1918 array set opts [parseargs args { 1919 virtualized.bool 1920 integrity.arg 1921 {noexist.arg "(no such process)"} 1922 {noaccess.arg "(unknown)"} 1923 pid.arg 1924 hprocess.arg 1925 } -maxleftover 0] 1926 1927 if {[info exists opts(pid)] && [info exists opts(hprocess)]} { 1928 error "Options -pid and -hprocess cannot be specified together." 1929 } 1930 1931 # Open token with appropriate access rights depending on request. 1932 set access [list token_adjust_default] 1933 1934 if {[info exists opts(hprocess)]} { 1935 set tok [open_process_token -hprocess $opts(hprocess) -access $access] 1936 } elseif {[info exists opts(pid)]} { 1937 set tok [open_process_token -pid $opts(pid) -access $access] 1938 } else { 1939 # Default is current process 1940 set tok [open_process_token -access $access] 1941 } 1942 1943 set result [list ] 1944 trap { 1945 if {[info exists opts(integrity)]} { 1946 set_token_integrity $tok $opts(integrity) 1947 } 1948 if {[info exists opts(virtualized)]} { 1949 set_token_virtualization $tok $opts(virtualized) 1950 } 1951 } finally { 1952 close_token $tok 1953 } 1954 1955 return $result 1956 } 1957 return [_token_set_helper {*}$args] 1958} 1959 1960# Map console color name to integer attribute 1961proc twapi::_map_console_color {colors background} { 1962 set attr 0 1963 foreach color $colors { 1964 switch -exact -- $color { 1965 blue {setbits attr 1} 1966 green {setbits attr 2} 1967 red {setbits attr 4} 1968 white {setbits attr 7} 1969 bright {setbits attr 8} 1970 black { } 1971 default {error "Unknown color name $color"} 1972 } 1973 } 1974 if {$background} { 1975 set attr [expr {$attr << 4}] 1976 } 1977 return $attr 1978} 1979 1980