1# linux-lib.pl 2# Functions for parsing linux ps output 3 4use Time::Local; 5 6sub get_ps_version 7{ 8if (!$get_ps_version_cache) { 9 local $out = &backquote_command("ps V 2>&1"); 10 if ($out =~ /version\s+([0-9\.]+)\./ || 11 $out =~ /\S+\s+([3-9][0-9\.]+)\./) { 12 $get_ps_version_cache = $1; 13 } 14 } 15return $get_ps_version_cache; 16} 17 18sub list_processes 19{ 20local($pcmd, $line, $i, %pidmap, @plist, $dummy, @w, $_); 21local $ver = &get_ps_version(); 22if ($ver && $ver < 2) { 23 # Old version of ps 24 $pcmd = join(' ' , @_); 25 open(PS, "ps aulxhwwww $pcmd 2>/dev/nul |"); 26 for($i=0; $line=<PS>; $i++) { 27 chop($line); 28 if ($line =~ /ps aulxhwwww/) { $i--; next; } 29 if ($line !~ /^\s*(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+([\-\d]+)\s+([\-\d]+)\s+(\d+)\s+(\d+)\s+(\S*)\s+(\S+)[\s<>N]+(\S+)\s+([0-9:]+)\s+(.*)$/) { 30 $i--; 31 next; 32 } 33 $pidmap{$3} = $i; 34 $plist[$i]->{"pid"} = $3; 35 $plist[$i]->{"ppid"} = $4; 36 $plist[$i]->{"user"} = getpwuid($2); 37 $plist[$i]->{"size"} = "$7 kB"; 38 $plist[$i]->{"cpu"} = "Unknown"; 39 $plist[$i]->{"time"} = $12; 40 $plist[$i]->{"nice"} = $6; 41 $plist[$i]->{"args"} = $13; 42 $plist[$i]->{"_pri"} = $5; 43 $plist[$i]->{"_tty"} = $11 eq "?" ? $text{'edit_none'} : "/dev/tty$11"; 44 $plist[$i]->{"_status"} = $stat_map{substr($10, 0, 1)}; 45 ($plist[$i]->{"_wchan"} = $9) =~ s/\s+$//g; 46 if (!$plist[$i]->{"_wchan"}) { delete($plist[$i]->{"_wchan"}); } 47 if ($plist[$i]->{"args"} =~ /^\((.*)\)/) 48 { $plist[$i]->{"args"} = $1; } 49 } 50 close(PS); 51 open(PS, "ps auxh $pcmd |"); 52 while($line=<PS>) { 53 if ($line =~ /^\s*(\S+)\s+(\d+)\s+(\S+)\s+(\S+)\s+/ && 54 defined($pidmap{$2})) { 55 $plist[$pidmap{$2}]->{"cpu"} = $3; 56 $plist[$pidmap{$2}]->{"_mem"} = "$4 %"; 57 } 58 } 59 close(PS); 60} 61else { 62 # New version of ps, as found in redhat 6 63 local $width; 64 if (!$ver || $ver >= 3.2) { 65 # Use width format character if allowed 66 $width = ":80"; 67 } 68 open(PS, "ps --cols 2048 -eo user$width,ruser$width,group$width,rgroup$width,pid,ppid,pgid,pcpu,vsz,nice,etime,time,stime,tty,args 2>/dev/null |"); 69 $dummy = <PS>; 70 my @now = localtime(time()); 71 for($i=0; $line=<PS>; $i++) { 72 chop($line); 73 $line =~ s/^\s+//g; 74 eval { @w = split(/\s+/, $line, -1); }; 75 if ($@) { 76 # Hit a split loop 77 $i--; next; 78 } 79 if ($line =~ /ps --cols 500 -eo user/) { 80 # Skip process ID 0 or ps command 81 $i--; next; 82 } 83 if (@_ && &indexof($w[4], @_) < 0) { 84 # Not interested in this PID 85 $i--; next; 86 } 87 $plist[$i]->{"pid"} = $w[4]; 88 $plist[$i]->{"ppid"} = $w[5]; 89 $plist[$i]->{"user"} = $w[0]; 90 $plist[$i]->{"cpu"} = "$w[7] %"; 91 $plist[$i]->{"size"} = "$w[8] kB"; 92 $plist[$i]->{"bytes"} = $w[8]*1024; 93 $plist[$i]->{"time"} = $w[11]; 94 $plist[$i]->{"_stime"} = $w[12]; 95 eval { 96 if (($w[12] =~ /^(\d+):(\d+)$/ || 97 $w[12] =~ /^(\d+):(\d+):(\d+)$/) && 98 $3 < 60 && $2 < 60 && $1 < 24) { 99 # Started today 100 $plist[$i]->{"_stime_unix"} = 101 timelocal($3 || 0, $2, $1, 102 $now[3], $now[4], $now[5]); 103 } 104 elsif ($w[12] =~ /^(\S\S\S)\s*(\d+)$/ && $2 < 32) { 105 # Started on some other day 106 $plist[$i]->{"_stime_unix"} = 107 timelocal(0, 0, 0, $2, 108 &month_to_number($1), $now[5]); 109 } 110 }; 111 $plist[$i]->{"nice"} = $w[9]; 112 $plist[$i]->{"args"} = @w<15 ? "defunct" : join(' ', @w[14..$#w]); 113 $plist[$i]->{"_group"} = $w[2]; 114 $plist[$i]->{"_ruser"} = $w[1]; 115 $plist[$i]->{"_rgroup"} = $w[3]; 116 $plist[$i]->{"_pgid"} = $w[6]; 117 $plist[$i]->{"_tty"} = $w[13] =~ /\?/ ? $text{'edit_none'} : "/dev/$w[13]"; 118 } 119 close(PS); 120 } 121return @plist; 122} 123 124# renice_proc(pid, nice) 125sub renice_proc 126{ 127return undef if (&is_readonly_mode()); 128local $out = &backquote_logged("renice $_[1] -p $_[0] 2>&1"); 129if ($?) { return $out; } 130return undef; 131} 132 133# find_mount_processes(mountpoint) 134# Find all processes under some mount point 135sub find_mount_processes 136{ 137local($out); 138&has_command("fuser") || &error("fuser command is not installed"); 139$out = &backquote_command("fuser -m ".quotemeta($_[0])." 2>/dev/null"); 140$out =~ s/[^0-9 ]//g; 141$out =~ s/^\s+//g; $out =~ s/\s+$//g; 142return split(/\s+/, $out); 143} 144 145# find_file_processes([file]+) 146# Find all processes with some file open 147sub find_file_processes 148{ 149local($out, $files); 150&has_command("fuser") || &error("fuser command is not installed"); 151$files = join(' ', map { quotemeta($_) } map { glob($_) } @_); 152$out = &backquote_command("fuser $files 2>/dev/null"); 153$out =~ s/[^0-9 ]//g; 154$out =~ s/^\s+//g; $out =~ s/\s+$//g; 155return split(/\s+/, $out); 156} 157 158# get_new_pty() 159# Returns the filehandles and names for a pty and tty 160sub get_new_pty 161{ 162if (-r "/dev/ptmx" && -d "/dev/pts" && open(PTMX, "+>/dev/ptmx")) { 163 # Can use new-style PTY number allocation device 164 local $unl; 165 local $ptn; 166 167 # ioctl to unlock the PTY (TIOCSPTLCK) 168 $unl = pack("i", 0); 169 ioctl(PTMX, 0x40045431, $unl) || &error("Unlock ioctl failed : $!"); 170 $unl = unpack("i", $unl); 171 172 # ioctl to request a TTY (TIOCGPTN) 173 ioctl(PTMX, 0x80045430, $ptn) || &error("PTY ioctl failed : $!"); 174 $ptn = unpack("i", $ptn); 175 176 local $tty = "/dev/pts/$ptn"; 177 return (*PTMX, undef, $tty, $tty); 178 } 179else { 180 # Have to search manually through pty files! 181 local @ptys; 182 local $devstyle; 183 if (-d "/dev/pty") { 184 opendir(DEV, "/dev/pty"); 185 @ptys = map { "/dev/pty/$_" } readdir(DEV); 186 closedir(DEV); 187 $devstyle = 1; 188 } 189 else { 190 opendir(DEV, "/dev"); 191 @ptys = map { "/dev/$_" } (grep { /^pty/ } readdir(DEV)); 192 closedir(DEV); 193 $devstyle = 0; 194 } 195 local ($pty, $tty); 196 foreach $pty (@ptys) { 197 open(PTY, "+>$pty") || next; 198 local $tty = $pty; 199 if ($devstyle == 0) { 200 $tty =~ s/pty/tty/; 201 } 202 else { 203 $tty =~ s/m(\d+)$/s$1/; 204 } 205 local $old = select(PTY); $| = 1; select($old); 206 if ($< == 0) { 207 # Don't need to open the TTY file here for root, 208 # as it will be opened later after the controlling 209 # TTY has been released. 210 return (*PTY, undef, $pty, $tty); 211 } 212 else { 213 # Must open now .. 214 open(TTY, "+>$tty"); 215 select(TTY); $| = 1; select($old); 216 return (*PTY, *TTY, $pty, $tty); 217 } 218 } 219 return (); 220 } 221} 222 223# close_controlling_pty() 224# Disconnects this process from it's controlling PTY, if connected 225sub close_controlling_pty 226{ 227if (open(DEVTTY, "</dev/tty")) { 228 # Special ioctl to disconnect (TIOCNOTTY) 229 ioctl(DEVTTY, 0x5422, 0); 230 close(DEVTTY); 231 } 232} 233 234# open_controlling_pty(ptyfh, ttyfh, ptyfile, ttyfile) 235# Makes a PTY returned from get_new_pty the controlling TTY (/dev/tty) for 236# this process. 237sub open_controlling_pty 238{ 239local ($ptyfh, $ttyfh, $pty, $tty) = @_; 240 241# Call special ioctl to attach /dev/tty to this new tty (TIOCSCTTY) 242ioctl($ttyfh, 0x540e, 0); 243} 244 245# get_memory_info() 246# Returns a list containing the real mem, free real mem, swap and free swap, 247# and possibly cached memory and the burstable limit. All of these are in Kb. 248sub get_memory_info 249{ 250local %m; 251local $memburst; 252if (&running_in_openvz() && open(BEAN, "</proc/user_beancounters")) { 253 # If we are running under Virtuozzo, there may be a limit on memory 254 # use in force that is less than the real system's memory. Or it may be 255 # a higher 'burstable' limit. Use this, unless it is unreasonably 256 # high (like 1TB) 257 local $pagesize = 1024; 258 eval { 259 use POSIX; 260 $pagesize = POSIX::sysconf(POSIX::_SC_PAGESIZE); 261 }; 262 while(<BEAN>) { 263 if (/privvmpages\s+(\d+)\s+(\d+)\s+(\d+)/ && 264 $3 < 1024*1024*1024*1024) { 265 $memburst = $3 * $pagesize / 1024; 266 last; 267 } 268 } 269 close(BEAN); 270 } 271open(MEMINFO, "</proc/meminfo") || return (); 272while(<MEMINFO>) { 273 if (/^(\S+):\s+(\d+)/) { 274 $m{lc($1)} = $2; 275 } 276 } 277close(MEMINFO); 278local $memtotal; 279if ($memburst && $memburst > $m{'memtotal'}) { 280 # Burstable limit is higher than actual RAM 281 $memtotal = $m{'memtotal'}; 282 } 283elsif ($memburst && $memburst < $m{'memtotal'}) { 284 # Limit is less than actual RAM 285 $memtotal = $memburst; 286 $memburst = undef; 287 } 288elsif ($memburst && $memburst == $m{'memtotal'}) { 289 # Same as actual RAM 290 $memtotal = $memburst; 291 $memburst = undef; 292 } 293elsif (!$memburst) { 294 # No burstable limit set, like on a real system 295 $memtotal = $m{'memtotal'}; 296 } 297return ( $memtotal, 298 $m{'cached'} > $memtotal ? $m{'memfree'} : 299 $m{'memfree'}+$m{'buffers'}+$m{'cached'}, 300 $m{'swaptotal'}, $m{'swapfree'}, 301 $m{'buffers'} + $m{'cached'}, 302 $memburst, ); 303} 304 305# os_get_cpu_info() 306# Returns a list containing the 5, 10 and 15 minute load averages, and the 307# CPU mhz, model, vendor, cache and count 308sub os_get_cpu_info 309{ 310open(LOAD, "</proc/loadavg") || return (); 311local @load = split(/\s+/, <LOAD>); 312close(LOAD); 313local %c; 314open(CPUINFO, "</proc/cpuinfo"); 315while(<CPUINFO>) { 316 if (/^(\S[^:]*\S)\s*:\s*(.*)/) { 317 $c{lc($1)} = $2; 318 } 319 } 320close(CPUINFO); 321$c{'model name'} =~ s/\d+\s*mhz//i; 322if ($c{'cache size'} =~ /^(\d+)\s+KB/i) { 323 $c{'cache size'} = $1*1024; 324 } 325elsif ($c{'cache size'} =~ /^(\d+)\s+MB/i) { 326 $c{'cache size'} = $1*1024*1024; 327 } 328if (!$c{'cpu mhz'} && $c{'model name'}) { 329 $c{'bogomips'} =~ s/\..*$//; 330 $c{'model name'} .= " @ ".$c{'bogomips'}." bMips"; 331 } 332 333# Merge in info from /proc/device-tree 334if (!$c{'model name'}) { 335 $c{'model name'} = &read_file_contents("/proc/device-tree/model"); 336 } 337 338if ($c{'model name'}) { 339 return ( $load[0], $load[1], $load[2], 340 int($c{'cpu mhz'}), $c{'model name'}, $c{'vendor_id'}, 341 $c{'cache size'}, $c{'processor'}+1 ); 342 } 343else { 344 return ( $load[0], $load[1], $load[2] ); 345 } 346} 347 348$has_trace_command = &has_command("strace"); 349 350# open_process_trace(pid, [&syscalls]) 351# Starts tracing on some process, and returns a trace object 352sub open_process_trace 353{ 354local $fh = time().$$; 355local $sc; 356if (@{$_[1]}) { 357 $sc = "-e trace=".join(",", @{$_[1]}); 358 } 359local $tpid = open($fh, "strace -t -p $_[0] $sc 2>&1 |"); 360$line = <$fh>; 361return { 'pid' => $_[0], 362 'tpid' => $tpid, 363 'fh' => $fh }; 364} 365 366# close_process_trace(&trace) 367# Halts tracing on some trace object 368sub close_process_trace 369{ 370kill('TERM', $_[0]->{'tpid'}) if ($_[0]->{'tpid'}); 371close($_[0]->{'fh'}); 372} 373 374# read_process_trace(&trace) 375# Returns an action structure representing one action by traced process, or 376# undef if an error occurred 377sub read_process_trace 378{ 379local $fh = $_[0]->{'fh'}; 380local @tm = localtime(time()); 381while(1) { 382 local $line = <$fh>; 383 return undef if (!$line); 384 if ($line =~ /^(\d+):(\d+):(\d+)\s+([^\(]+)\((.*)\)\s*=\s*(\-?\d+|\?)/) { 385 local $tm = timelocal($3, $2, $1, $tm[3], $tm[4], $tm[5]); 386 local $action = { 'time' => $tm, 387 'call' => $4, 388 'rv' => $6 eq "?" ? undef : $6 }; 389 local $args = $5; 390 local @args; 391 while(1) { 392 if ($args =~ /^[ ,]*(\{[^}]*\})(.*)$/) { 393 # A structure in { } 394 push(@args, $1); 395 $args = $2; 396 } 397 elsif ($args =~ /^[ ,]*"([^"]*)"\.*(.*)$/) { 398 # A quoted string 399 push(@args, $1); 400 $args = $2; 401 } 402 elsif ($args =~ /^[ ,]*\[([^\]]*)\](.*)$/) { 403 # A square-bracket number 404 push(@args, $1); 405 $args = $2; 406 } 407 elsif ($args =~ /^[ ,]*\<([^\>]*)\>(.*)$/) { 408 # An angle-bracketed string 409 push(@args, $1); 410 $args = $2; 411 } 412 elsif ($args =~ /[ ,]*([^, ]+)(.*)$/) { 413 # Just a number 414 push(@args, $1); 415 $args = $2; 416 } 417 else { 418 last; 419 } 420 } 421 if ($args[$#args] eq $action->{'rv'}) { 422 pop(@args); # last arg is same as return value? 423 } 424 $action->{'args'} = \@args; 425 return $action; 426 } 427 } 428} 429 430foreach $ia (keys %text) { 431 if ($ia =~ /^linux(_\S+)/) { 432 $info_arg_map{$1} = $text{$ia}; 433 } 434 elsif ($ia =~ /^linuxstat_(\S+)/) { 435 $stat_map{$1} = $text{$ia}; 436 } 437 } 438 439@nice_range = (-20 .. 20); 440 441$has_fuser_command = 1; 442 443# os_list_scheduling_classes() 444# Returns a list of Linux scheduling classes, if supported. Each element is a 445# 2-element array ref containing a code and description. 446sub os_list_scheduling_classes 447{ 448if (&has_command("ionice")) { 449 return ( [ 1, $text{'linux_real'} ], 450 [ 2, $text{'linux_be'} ], 451 [ 3, $text{'linux_idle'} ] ); 452 } 453return ( ); 454} 455 456# os_list_scheduling_priorities() 457# Returns a list of IO priorities, each of which is an array ref containing 458# a number and description 459sub os_list_scheduling_priorities 460{ 461return ( [ 0, "0 ($text{'edit_prihigh'})" ], 462 [ 1 ], [ 2 ], [ 3 ], [ 4 ], [ 5 ], [ 6 ], 463 [ 7, "7 ($text{'edit_prilow'})" ] ); 464} 465 466# os_get_scheduling_class(pid) 467# Returns the IO scheduling class and priority for a running program 468sub os_get_scheduling_class 469{ 470local ($pid) = @_; 471local $out = &backquote_command("ionice -p ".quotemeta($pid)); 472if ($out =~ /^(realtime|best-effort|idle|none):\s+prio\s+(\d+)/) { 473 return ($1 eq "realtime" ? 1 : $1 eq "best-effort" ? 2 : 474 $1 eq "idle" ? 3 : 0, $2); 475 } 476return ( ); 477} 478 479# os_set_scheduling_class(pid, class, priority) 480# Sets the ID scheduling class and priority for some process. Returns an error 481# message on failure, undef on success. 482sub os_set_scheduling_class 483{ 484local ($pid, $class, $prio) = @_; 485local $cmd = "ionice -c ".quotemeta($class); 486$cmd .= " -n ".quotemeta($prio) if (defined($prio)); 487$cmd .= " -p ".quotemeta($pid); 488local $out = &backquote_logged("$cmd 2>&1 </dev/null"); 489return $? ? $out : undef; 490} 491 492# get_current_cpu_temps() 493# Returns a list of hash refs containing CPU temperatures 494sub get_current_cpu_temps 495{ 496my @rv; 497if (&has_command("sensors")) { 498 my @rvx; 499 my $rxx; 500 my $aa; 501 my $ab; 502 my $ac; 503 my $ad; 504 my $fh = "SENSORS"; 505 &open_execute_command($fh, "sensors </dev/null 2>/dev/null", 1); 506 while(<$fh>) { 507 if (/Core\s+(\d+):\s+([\+\-][0-9\.]+)/) { 508 $rxx++; 509 push(@rv, { 'core' => $1, 510 'temp' => $2 }); 511 } 512 elsif (/CPU:\s+([\+\-][0-9\.]+)/) { 513 $rxx++; 514 push(@rv, { 'core' => 0, 515 'temp' => $1 }); 516 } 517 else { 518 # New line - new device (disallow, if no either fan or 519 # voltage data) 520 $aa = 0 if (/^\s*$/); 521 522 # Device has either fan or voltage data (sign of CPU) 523 $aa = 1 if (/fan[\d+]:\s+[0-9]+\s+RPM/i || 524 /in[\d+]:\s+[\+\-0-9\.]+\s+V/i); 525 526 # Get odd output like in #1253 527 if ($aa && /temp(\d+):\s+([\+\-][0-9\.]+)\s+.*?[=+].*?\)/) { 528 # Adjust to start from `0` as all other outputs 529 push(@rvx, { 'core' => (int($1) - 1), 530 'temp' => $2 }); 531 } 532 533 # New line - new device 534 $ab = 0 if (/^\s*$/); 535 536 # Check for CPU 537 $ab = 1 if (/cpu_thermal-virtual-[\d]+/i); 538 539 # Get odd output like in #1280 540 if ($ab && /temp(\d+):\s+([\+\-][0-9\.]+)/) { 541 push(@rvx, { 'core' => $1, 542 'temp' => $2 }); 543 } 544 545 # AMD Ryzen type #1 546 $ac = 0 if (/^\s*$/); 547 $ac = 1 if (/[\d]+temp-pci/i); 548 if ($ac && /Tdie:\s+([\+\-][0-9\.]+)/) { 549 push(@rvx, { 'core' => 0, 550 'temp' => $1 }); 551 } 552 553 # AMD Ryzen type #2 (Threadripper) #1484 554 $ad = 0 if (/^\s*$/); 555 $ad = 1 if (/^k[\d]{2}temp-pci-[\d]{2}c[\d]+/i); 556 if ($ad && /temp(\d+):\s+([\+\-][0-9\.]+).*?[Cc]\s+.*?[=+].*?\)/) { 557 push(@rvx, { 'core' => (int($1) - 1), 558 'temp' => $2 }); 559 } 560 } 561 } 562 close($fh); 563 564 # Add non standard output only if we haven't 565 # already grabbed standard output for CPU 566 if (!$rxx) { 567 @rv = (@rv, @rvx); 568 } 569 } 570 571return @rv; 572} 573 574# get_cpu_io_usage() 575# Returns a list containing CPU user, kernel, idle, io and VM time, and IO 576# blocks in and out 577sub get_cpu_io_usage 578{ 579my $out,@lines,@w; 580if (&has_command("vmstat")) { 581 $out = &backquote_command("vmstat 1 2 2>/dev/null"); 582 @lines = split(/\r?\n/, $out); 583 @w = split(/\s+/, $lines[$#lines]); 584 shift(@w) if ($w[0] eq ''); 585 if ($w[8] =~ /^\d+$/ && $w[9] =~ /^\d+$/) { 586 return ( @w[12..16], $w[8], $w[9] ); 587 } 588 } elsif (&has_command("dstat")) { 589 $out = &backquote_command("dstat 1 1 2>/dev/null"); 590 @lines = split(/\r?\n/, $out); 591 @w = split(/[\s|]+/, $lines[$#lines]); 592 shift(@w) if ($w[0] eq ''); 593 return( @w[0..4], @w[6..7]); 594 } 595 return undef; 596} 597 5981; 599 600