]>
git.proxmox.com Git - pve-common.git/blob - src/PVE/ProcFSTools.pm
1 package PVE
::ProcFSTools
;
6 use Time
::HiRes qw
(gettimeofday
);
11 my $clock_ticks = POSIX
::sysconf
(&POSIX
::_SC_CLK_TCK
);
16 my $fn = '/proc/cpuinfo';
18 return $cpuinfo if $cpuinfo;
21 user_hz
=> $clock_ticks,
28 my $fh = IO
::File-
>new ($fn, "r");
33 while (defined(my $line = <$fh>)) {
34 if ($line =~ m/^processor\s*:\s*\d+\s*$/i) {
36 } elsif ($line =~ m/^model\s+name\s*:\s*(.*)\s*$/i) {
37 $res->{model
} = $1 if $res->{model
} eq 'unknown';
38 } elsif ($line =~ m/^cpu\s+MHz\s*:\s*(\d+\.\d+)\s*$/i) {
39 $res->{mhz
} = $1 if !$res->{mhz
};
40 } elsif ($line =~ m/^flags\s*:.*(vmx|svm)/) {
41 $res->{hvm
} = 1; # Hardware Virtual Machine (Intel VT / AMD-V)
42 } elsif ($line =~ m/^physical id\s*:\s*(\d+)\s*$/i) {
47 $res->{sockets
} = scalar(keys %$idhash) || 1;
49 $res->{cpus
} = $count;
58 sub read_proc_uptime
{
61 my $line = PVE
::Tools
::file_read_firstline
("/proc/uptime");
62 if ($line && $line =~ m
|^(\d
+\
.\d
+)\s
+(\d
+\
.\d
+)\s
*$|) {
64 return (int($1*$clock_ticks), int($2*$clock_ticks));
66 return (int($1), int($2));
75 my $line = PVE
::Tools
::file_read_firstline
('/proc/loadavg');
77 if ($line =~ m
|^(\d
+\
.\d
+)\s
+(\d
+\
.\d
+)\s
+(\d
+\
.\d
+)\s
+\d
+/\d
+\s
+\d
+\s
*$|) {
78 return wantarray ?
($1, $2, $3) : $1;
81 return wantarray ?
(0, 0, 0) : 0;
87 my $res = { user
=> 0, nice
=> 0, system => 0, idle
=> 0 , sum
=> 0};
91 if (my $fh = IO
::File-
>new ("/proc/stat", "r")) {
92 while (defined (my $line = <$fh>)) {
93 if ($line =~ m
|^cpu\s
+(\d
+)\s
+(\d
+)\s
+(\d
+)\s
+(\d
+)\s
+(\d
+)\s
|) {
98 $res->{used
} = $1+$2+$3;
100 } elsif ($line =~ m
|^cpu\d
+\s
|) {
107 $cpucount = 1 if !$cpucount;
109 my $ctime = gettimeofday
; # floating point time in seconds
111 $res->{ctime
} = $ctime;
115 $last_proc_stat = $res if !$last_proc_stat;
117 my $diff = ($ctime - $last_proc_stat->{ctime
}) * $clock_ticks * $cpucount;
119 if ($diff > 1000) { # don't update too often
120 my $useddiff = $res->{used
} - $last_proc_stat->{used
};
121 $useddiff = $diff if $useddiff > $diff;
122 $res->{cpu
} = $useddiff/$diff;
123 my $waitdiff = $res->{iowait
} - $last_proc_stat->{iowait
};
124 $waitdiff = $diff if $waitdiff > $diff;
125 $res->{wait} = $waitdiff/$diff;
126 $last_proc_stat = $res;
128 $res->{cpu
} = $last_proc_stat->{cpu
};
129 $res->{wait} = $last_proc_stat->{wait};
135 sub read_proc_pid_stat
{
138 my $statstr = PVE
::Tools
::file_read_firstline
("/proc/$pid/stat");
140 if ($statstr && $statstr =~ m/^$pid \(.*\) (\S) (-?\d+) -?\d+ -?\d+ -?\d+ -?\d+ \d+ \d+ \d+ \d+ \d+ (\d+) (\d+) (-?\d+) (-?\d+) -?\d+ -?\d+ -?\d+ 0 (\d+) (\d+) (-?\d+) \d+ \d+ \d+ \d+ \d+ \d+ \d+ \d+ \d+ \d+ \d+ \d+ \d+ -?\d+ -?\d+ \d+ \d+ \d+/) {
154 sub check_process_running
{
155 my ($pid, $pstart) = @_;
157 # note: waitpid only work for child processes, but not
158 # for processes spanned by other processes.
159 # kill(0, pid) return succes for zombies.
160 # So we read the status form /proc/$pid/stat instead
162 my $info = read_proc_pid_stat
($pid);
164 return $info && (!$pstart || ($info->{starttime
} eq $pstart)) && ($info->{status
} ne 'Z') ?
$info : undef;
167 sub read_proc_starttime
{
170 my $info = read_proc_pid_stat
($pid);
171 return $info ?
$info->{starttime
} : 0;
186 my $fh = IO
::File-
>new ("/proc/meminfo", "r");
190 while (my $line = <$fh>) {
191 if ($line =~ m/^(\S+):\s+(\d+)\s*kB/i) {
192 $d->{lc ($1)} = $2 * 1024;
197 $res->{memtotal
} = $d->{memtotal
};
198 $res->{memfree
} = $d->{memfree
} + $d->{buffers
} + $d->{cached
};
199 $res->{memused
} = $res->{memtotal
} - $res->{memfree
};
201 $res->{swaptotal
} = $d->{swaptotal
};
202 $res->{swapfree
} = $d->{swapfree
};
203 $res->{swapused
} = $res->{swaptotal
} - $res->{swapfree
};
205 my $spages = PVE
::Tools
::file_read_firstline
("/sys/kernel/mm/ksm/pages_sharing");
206 $res->{memshared
} = int($spages) * 4096;
211 # memory usage of current process
212 sub read_memory_usage
{
214 my $res = { size
=> 0, resident
=> 0, shared
=> 0 };
218 my $line = PVE
::Tools
::file_read_firstline
("/proc/$$/statm");
220 if ($line =~ m/^(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s*/) {
221 $res->{size
} = $1*$ps;
222 $res->{resident
} = $2*$ps;
223 $res->{shared
} = $3*$ps;
229 sub read_proc_net_dev
{
233 my $fh = IO
::File-
>new ("/proc/net/dev", "r");
236 while (defined (my $line = <$fh>)) {
237 if ($line =~ m/^\s*(.*):\s*(\d+)\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+(\d+)\s+/) {
250 sub write_proc_entry
{
251 my ($filename, $data) = @_;#
253 my $fh = IO
::File-
>new($filename, O_WRONLY
);
254 die "unable to open file '$filename' - $!\n" if !$fh;
255 die "unable to write '$filename' - $!\n" unless print $fh $data;
256 die "closing file '$filename' failed - $!\n" unless close $fh;
260 sub read_proc_net_route
{
261 my $filename = "/proc/net/route";
265 my $fh = IO
::File-
>new ($filename, "r");
268 my $int_to_quad = sub {
269 return join '.' => map { ($_[0] >> 8*(3-$_)) % 256 } (3, 2, 1, 0);
272 while (defined(my $line = <$fh>)) {
273 next if $line =~/^Iface\s+Destination/; # skip head
274 my ($iface, $dest, $gateway, $metric, $mask, $mtu) = (split(/\s+/, $line))[0,1,2,6,7,8];
276 dest
=> &$int_to_quad(hex($dest)),
277 gateway
=> &$int_to_quad(hex($gateway)),
278 mask
=> &$int_to_quad(hex($mask)),
288 sub read_proc_mounts
{
289 return PVE
::Tools
::file_get_contents
("/proc/mounts");
292 # mounts encode spaces (\040), tabs (\011), newlines (\012), backslashes (\\ or \134)
295 return $str =~ s/\\(?:040|01[12]|134|\\)/"\"$&\""/geer;
301 while ($mounts =~ /^\s*([^#].*)$/gm) {
302 # lines from the file are encoded so we can just split at spaces
303 my ($what, $dir, $fstype, $opts) = split(/[ \t]/, $1, 4);
304 my ($freq, $passno) = (0, 0);
305 # in glibc's parser frequency and pass seem to be optional
306 $freq = $1 if $opts =~ s/\s+(\d+)$//;
307 $passno = $1 if $opts =~ s/\s+(\d+)$//;
308 push @$mntent, [decode_mount
($what),
310 decode_mount
($fstype),
317 sub parse_proc_mounts
{
318 return parse_mounts
(read_proc_mounts
());
322 my ($mountpoint) = @_;
324 $mountpoint = Cwd
::realpath
($mountpoint);
326 my $mounts = parse_proc_mounts
();
327 return (grep { $_->[1] eq $mountpoint } @$mounts) ?
1 : 0;
330 sub read_proc_net_ipv6_route
{
331 my $filename = "/proc/net/ipv6_route";
335 my $fh = IO
::File-
>new ($filename, "r");
338 my $read_v6addr = sub { $_[0] =~ s/....(?!$)/$&:/gr };
340 # ipv6_route has no header
341 while (defined(my $line = <$fh>)) {
342 my ($dest, $prefix, $nexthop, $metric, $iface) = (split(/\s+/, $line))[0,1,4,5,9];
344 dest
=> &$read_v6addr($dest),
345 prefix
=> hex("$prefix"),
346 gateway
=> &$read_v6addr($nexthop),
347 metric
=> hex("$metric"),