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