is_mounted: use realpath on the mountpoint
[pve-common.git] / src / PVE / ProcFSTools.pm
1 package PVE::ProcFSTools;
2
3 use strict;
4 use warnings;
5 use POSIX;
6 use Time::HiRes qw (gettimeofday);
7 use IO::File;
8 use PVE::Tools;
9 use Cwd;
10
11 my $clock_ticks = POSIX::sysconf(&POSIX::_SC_CLK_TCK);
12
13 my $cpuinfo;
14
15 sub read_cpuinfo {
16     my $fn = '/proc/cpuinfo';
17
18     return $cpuinfo if $cpuinfo;
19
20     my $res = {
21         user_hz => $clock_ticks,
22         model => 'unknown',
23         mhz => 0,
24         cpus => 1,
25         sockets => 1,
26     };
27
28     my $fh = IO::File->new ($fn, "r");
29     return $res if !$fh;
30
31     my $idhash = {};
32     my $count = 0;
33     while (defined(my $line = <$fh>)) {
34         if ($line =~ m/^processor\s*:\s*\d+\s*$/i) {
35             $count++;
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) {
43             $idhash->{$1} = 1;
44         }
45     }
46
47     $res->{sockets} = scalar(keys %$idhash) || 1;
48
49     $res->{cpus} = $count;
50
51     $fh->close;
52     
53     $cpuinfo = $res;
54
55     return $res;
56 }
57
58 sub read_proc_uptime {
59     my $ticks = shift;
60
61     my $line = PVE::Tools::file_read_firstline("/proc/uptime");
62     if ($line && $line =~ m|^(\d+\.\d+)\s+(\d+\.\d+)\s*$|) {
63         if ($ticks) {
64             return (int($1*$clock_ticks), int($2*$clock_ticks));
65         } else {
66             return (int($1), int($2));
67         }
68     }
69
70     return (0, 0);
71 }
72
73 sub read_loadavg {
74
75     my $line = PVE::Tools::file_read_firstline('/proc/loadavg');
76
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;
79     }
80
81     return wantarray ? (0, 0, 0) : 0;
82 }
83
84 my $last_proc_stat;
85
86 sub read_proc_stat {
87     my $res = { user => 0, nice => 0, system => 0, idle => 0 , sum => 0};
88
89     my $cpucount = 0;
90
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|) {
94                 $res->{user} = $1;
95                 $res->{nice} = $2;
96                 $res->{system} = $3;
97                 $res->{idle} = $4;
98                 $res->{used} = $1+$2+$3;
99                 $res->{iowait} = $5;
100             } elsif ($line =~ m|^cpu\d+\s|) {
101                 $cpucount++;
102             }
103         }
104         $fh->close;
105     }
106
107     $cpucount = 1 if !$cpucount;
108
109     my $ctime = gettimeofday; # floating point time in seconds
110
111     $res->{ctime} = $ctime;
112     $res->{cpu} = 0;
113     $res->{wait} = 0;
114
115     $last_proc_stat = $res if !$last_proc_stat;
116
117     my $diff = ($ctime - $last_proc_stat->{ctime}) * $clock_ticks * $cpucount;
118
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;
127     } else {
128         $res->{cpu} = $last_proc_stat->{cpu};
129         $res->{wait} = $last_proc_stat->{wait};
130     }
131
132     return $res;
133 }
134
135 sub read_proc_pid_stat {
136     my $pid = shift;
137
138     my $statstr = PVE::Tools::file_read_firstline("/proc/$pid/stat");
139
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+/) {
141         return {
142             status => $1,
143             utime => $3,
144             stime => $4,
145             starttime => $7,
146             vsize => $8,
147             rss => $9 * 4096,
148         };
149     }
150
151     return undef;
152 }
153
154 sub check_process_running {
155     my ($pid, $pstart) = @_;
156
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
161  
162     my $info = read_proc_pid_stat($pid);
163  
164     return $info && (!$pstart || ($info->{starttime} eq $pstart)) && ($info->{status} ne 'Z') ? $info : undef;
165 }
166
167 sub read_proc_starttime {
168     my $pid = shift;
169
170     my $info = read_proc_pid_stat($pid);
171     return $info ? $info->{starttime} : 0;
172 }
173
174 sub read_meminfo {
175
176     my $res = {
177         memtotal => 0,
178         memfree => 0,
179         memused => 0,
180         memshared => 0,
181         swaptotal => 0,
182         swapfree => 0,
183         swapused => 0,
184     };
185
186     my $fh = IO::File->new ("/proc/meminfo", "r");
187     return $res if !$fh;
188
189     my $d = {};
190     while (my $line = <$fh>) {
191         if ($line =~ m/^(\S+):\s+(\d+)\s*kB/i) {
192             $d->{lc ($1)} = $2 * 1024;
193         } 
194     }
195     close($fh);
196
197     $res->{memtotal} = $d->{memtotal};
198     $res->{memfree} =  $d->{memfree} + $d->{buffers} + $d->{cached};
199     $res->{memused} = $res->{memtotal} - $res->{memfree};
200
201     $res->{swaptotal} = $d->{swaptotal};
202     $res->{swapfree} = $d->{swapfree};
203     $res->{swapused} = $res->{swaptotal} - $res->{swapfree};
204
205     my $spages = PVE::Tools::file_read_firstline("/sys/kernel/mm/ksm/pages_sharing");
206     $res->{memshared} = int($spages) * 4096;
207
208     return $res;
209 }
210
211 # memory usage of current process
212 sub read_memory_usage {
213
214     my $res = { size => 0, resident => 0, shared => 0 };
215
216     my $ps = 4096;
217
218     my $line = PVE::Tools::file_read_firstline("/proc/$$/statm");
219
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;
224     }
225
226     return $res;
227 }
228
229 sub read_proc_net_dev {
230
231     my $res = {};
232
233     my $fh = IO::File->new ("/proc/net/dev", "r");
234     return $res if !$fh;
235
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+/) {
238             $res->{$1} = {
239                 receive => $2,
240                 transmit => $3,
241             };
242         }
243     }
244
245     close($fh);
246
247     return $res;
248 }
249
250 sub write_proc_entry {
251     my ($filename, $data) = @_;#
252
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;
257     $fh->close();
258 }
259
260 sub read_proc_net_route {
261     my $filename = "/proc/net/route";
262
263     my $res = [];
264
265     my $fh = IO::File->new ($filename, "r");
266     return $res if !$fh;
267
268     my $int_to_quad = sub {
269        return join '.' => map { ($_[0] >> 8*(3-$_)) % 256 } (3, 2, 1, 0);
270     };
271
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];
275        push @$res, {
276            dest => &$int_to_quad(hex($dest)),
277            gateway => &$int_to_quad(hex($gateway)),
278            mask => &$int_to_quad(hex($mask)),
279            metric => $metric,
280            mtu => $mtu,
281            iface => $iface,
282        };
283     }
284
285     return $res;
286 }
287
288 sub read_proc_mounts {
289     return PVE::Tools::file_get_contents("/proc/mounts");
290 }
291
292 sub is_mounted {
293     my ($mountpoint) = @_;
294
295     $mountpoint = Cwd::realpath($mountpoint);
296
297     my $mountdata = read_proc_mounts();
298
299     if ($mountdata =~ m/\s$mountpoint\s/) {
300         return 1;
301     } else {
302         return 0;
303     }
304 }
305
306 sub read_proc_net_ipv6_route {
307     my $filename = "/proc/net/ipv6_route";
308
309     my $res = [];
310
311     my $fh = IO::File->new ($filename, "r");
312     return $res if !$fh;
313
314     my $read_v6addr = sub { s/....(?!$)/$&:/g };
315
316     # ipv6_route has no header
317     while (defined(my $line = <$fh>)) {
318         my ($dest, $prefix, $nexthop, $metric, $iface) = (split(/\s+/, $line))[0,1,4,5,9];
319         push @$res, {
320             dest => &$read_v6addr($dest),
321             prefix => $prefix,
322             gateway => &$read_v6addr($nexthop),
323             metric => $metric,
324             iface => $iface
325         };
326     }
327
328     return $res;
329 }
330
331 1;