runtests: pass single backslashes with Windows Perl

handle/handle64 requires a literal match with the filenames it's
listing.

Also:
- make handle64 log messages more unique to help text searches.
- update a comment with Windows Perl info.

Cherry-picked from #14949
Closes #15436
This commit is contained in:
Viktor Szakats 2024-10-04 22:38:14 +02:00
parent cd2b45201a
commit ef7399b8b5
No known key found for this signature in database
GPG Key ID: B5ABD165E2AEF201
2 changed files with 11 additions and 6 deletions

View File

@ -192,7 +192,7 @@ sub runner_init {
$SIG{INT} = 'IGNORE';
$SIG{TERM} = 'IGNORE';
eval {
# some msys2 perl versions don't define SIGUSR1
# some msys2 perl versions don't define SIGUSR1, also missing from Win32 Perl
$SIG{USR1} = 'IGNORE';
};

View File

@ -272,7 +272,12 @@ sub clearlocks {
if(os_is_win()) {
$dir = sys_native_abs_path($dir);
if ($^O eq 'MSWin32') {
$dir =~ s/\//\\/g;
}
else {
$dir =~ s/\//\\\\/g;
}
my $handle = "handle";
if($ENV{"PROCESSOR_ARCHITECTURE"} =~ /64$/) {
$handle = "handle64";
@ -280,18 +285,18 @@ sub clearlocks {
if(checkcmd($handle)) {
# https://learn.microsoft.com/sysinternals/downloads/handle#usage
my $cmd = "$handle $dir -accepteula -nobanner";
logmsg "Executing: '$cmd'\n";
logmsg "clearlocks: Executing query: '$cmd'\n";
my @handles = `$cmd`;
for my $tryhandle (@handles) {
# Skip the "No matching handles found." warning when returned
if($tryhandle =~ /^(\S+)\s+pid:\s+(\d+)\s+type:\s+(\w+)\s+([0-9A-F]+):\s+(.+)\r\r/) {
logmsg "Found $3 lock of '$5' ($4) by $1 ($2)\n";
logmsg "clearlocks: Found $3 lock of '$5' ($4) by $1 ($2)\n";
# Ignore stunnel since we cannot do anything about its locks
if("$3" eq "File" && "$1" ne "tstunnel.exe") {
logmsg "Killing IMAGENAME eq $1 and PID eq $2\n";
logmsg "clearlocks: Killing IMAGENAME eq $1 and PID eq $2\n";
# https://ss64.com/nt/taskkill.html
my $cmd = "taskkill.exe -f -t -fi \"IMAGENAME eq $1\" -fi \"PID eq $2\" >nul 2>&1";
logmsg "Executing: '$cmd'\n";
logmsg "clearlocks: Executing kill: '$cmd'\n";
system($cmd);
$done = 1;
}