Include CPU flags in read_cpuinfo
[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 qw();
10
11 use Socket qw(PF_INET PF_INET6 SOCK_DGRAM IPPROTO_IP);
12
13 use constant IFF_UP => 1;
14 use constant IFNAMSIZ => 16;
15 use constant SIOCGIFFLAGS => 0x8913;
16
17 my $clock_ticks = POSIX::sysconf(&POSIX::_SC_CLK_TCK);
18
19 my $cpuinfo;
20
21 sub read_cpuinfo {
22     my $fn = '/proc/cpuinfo';
23
24     return $cpuinfo if $cpuinfo;
25
26     my $res = {
27         user_hz => $clock_ticks,
28         model => 'unknown',
29         mhz => 0,
30         cpus => 1,
31         sockets => 1,
32         flags => '',
33     };
34
35     my $fh = IO::File->new ($fn, "r");
36     return $res if !$fh;
37
38     my $idhash = {};
39     my $count = 0;
40     while (defined(my $line = <$fh>)) {
41         if ($line =~ m/^processor\s*:\s*\d+\s*$/i) {
42             $count++;
43         } elsif ($line =~ m/^model\s+name\s*:\s*(.*)\s*$/i) {
44             $res->{model} = $1 if $res->{model} eq 'unknown';
45         } elsif ($line =~ m/^cpu\s+MHz\s*:\s*(\d+\.\d+)\s*$/i) {
46             $res->{mhz} = $1 if !$res->{mhz};
47         } elsif ($line =~ m/^flags\s*:\s*(.*)$/) {
48             $res->{flags} = $1 if !length $res->{flags};
49         } elsif ($line =~ m/^physical id\s*:\s*(\d+)\s*$/i) {
50             $idhash->{$1} = 1;
51         }
52     }
53
54     # Hardware Virtual Machine (Intel VT / AMD-V)
55     $res->{hvm} = $res->{flags} =~ m/\s(vmx|svm)\s/;
56
57     $res->{sockets} = scalar(keys %$idhash) || 1;
58
59     $res->{cpus} = $count;
60
61     $fh->close;
62
63     $cpuinfo = $res;
64
65     return $res;
66 }
67
68 sub read_proc_uptime {
69     my $ticks = shift;
70
71     my $line = PVE::Tools::file_read_firstline("/proc/uptime");
72     if ($line && $line =~ m|^(\d+\.\d+)\s+(\d+\.\d+)\s*$|) {
73         if ($ticks) {
74             return (int($1*$clock_ticks), int($2*$clock_ticks));
75         } else {
76             return (int($1), int($2));
77         }
78     }
79
80     return (0, 0);
81 }
82
83 sub read_loadavg {
84
85     my $line = PVE::Tools::file_read_firstline('/proc/loadavg');
86
87     if ($line =~ m|^(\d+\.\d+)\s+(\d+\.\d+)\s+(\d+\.\d+)\s+\d+/\d+\s+\d+\s*$|) {
88         return wantarray ? ($1, $2, $3) : $1;
89     }
90
91     return wantarray ? (0, 0, 0) : 0;
92 }
93
94 my $last_proc_stat;
95
96 sub read_proc_stat {
97     my $res = { user => 0, nice => 0, system => 0, idle => 0 , sum => 0};
98
99     my $cpucount = 0;
100
101     if (my $fh = IO::File->new ("/proc/stat", "r")) {
102         while (defined (my $line = <$fh>)) {
103             if ($line =~ m|^cpu\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s|) {
104                 $res->{user} = $1;
105                 $res->{nice} = $2;
106                 $res->{system} = $3;
107                 $res->{idle} = $4;
108                 $res->{used} = $1+$2+$3;
109                 $res->{iowait} = $5;
110             } elsif ($line =~ m|^cpu\d+\s|) {
111                 $cpucount++;
112             }
113         }
114         $fh->close;
115     }
116
117     $cpucount = 1 if !$cpucount;
118
119     my $ctime = gettimeofday; # floating point time in seconds
120
121     $res->{ctime} = $ctime;
122     $res->{cpu} = 0;
123     $res->{wait} = 0;
124
125     $last_proc_stat = $res if !$last_proc_stat;
126
127     my $diff = ($ctime - $last_proc_stat->{ctime}) * $clock_ticks * $cpucount;
128
129     if ($diff > 1000) { # don't update too often
130         my $useddiff =  $res->{used} - $last_proc_stat->{used};
131         $useddiff = $diff if $useddiff > $diff;
132         $res->{cpu} = $useddiff/$diff;
133         my $waitdiff =  $res->{iowait} - $last_proc_stat->{iowait};
134         $waitdiff = $diff if $waitdiff > $diff;
135         $res->{wait} = $waitdiff/$diff;
136         $last_proc_stat = $res;
137     } else {
138         $res->{cpu} = $last_proc_stat->{cpu};
139         $res->{wait} = $last_proc_stat->{wait};
140     }
141
142     return $res;
143 }
144
145 sub read_proc_pid_stat {
146     my $pid = shift;
147
148     my $statstr = PVE::Tools::file_read_firstline("/proc/$pid/stat");
149
150     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+/) {
151         return {
152             status => $1,
153             utime => $3,
154             stime => $4,
155             starttime => $7,
156             vsize => $8,
157             rss => $9 * 4096,
158         };
159     }
160
161     return undef;
162 }
163
164 sub check_process_running {
165     my ($pid, $pstart) = @_;
166
167     # note: waitpid only work for child processes, but not
168     # for processes spanned by other processes.
169     # kill(0, pid) return succes for zombies.
170     # So we read the status form /proc/$pid/stat instead
171  
172     my $info = read_proc_pid_stat($pid);
173  
174     return $info && (!$pstart || ($info->{starttime} eq $pstart)) && ($info->{status} ne 'Z') ? $info : undef;
175 }
176
177 sub read_proc_starttime {
178     my $pid = shift;
179
180     my $info = read_proc_pid_stat($pid);
181     return $info ? $info->{starttime} : 0;
182 }
183
184 sub read_meminfo {
185
186     my $res = {
187         memtotal => 0,
188         memfree => 0,
189         memused => 0,
190         memshared => 0,
191         swaptotal => 0,
192         swapfree => 0,
193         swapused => 0,
194     };
195
196     my $fh = IO::File->new ("/proc/meminfo", "r");
197     return $res if !$fh;
198
199     my $d = {};
200     while (my $line = <$fh>) {
201         if ($line =~ m/^(\S+):\s+(\d+)\s*kB/i) {
202             $d->{lc ($1)} = $2 * 1024;
203         } 
204     }
205     close($fh);
206
207     $res->{memtotal} = $d->{memtotal};
208     $res->{memfree} =  $d->{memfree} + $d->{buffers} + $d->{cached};
209     $res->{memused} = $res->{memtotal} - $res->{memfree};
210
211     $res->{swaptotal} = $d->{swaptotal};
212     $res->{swapfree} = $d->{swapfree};
213     $res->{swapused} = $res->{swaptotal} - $res->{swapfree};
214
215     my $spages = PVE::Tools::file_read_firstline("/sys/kernel/mm/ksm/pages_sharing");
216     $res->{memshared} = int($spages) * 4096;
217
218     return $res;
219 }
220
221 # memory usage of current process
222 sub read_memory_usage {
223
224     my $res = { size => 0, resident => 0, shared => 0 };
225
226     my $ps = 4096;
227
228     my $line = PVE::Tools::file_read_firstline("/proc/$$/statm");
229
230     if ($line =~ m/^(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s*/) {
231         $res->{size} = $1*$ps;
232         $res->{resident} = $2*$ps;
233         $res->{shared} = $3*$ps;
234     }
235
236     return $res;
237 }
238
239 sub read_proc_net_dev {
240
241     my $res = {};
242
243     my $fh = IO::File->new ("/proc/net/dev", "r");
244     return $res if !$fh;
245
246     while (defined (my $line = <$fh>)) {
247         if ($line =~ m/^\s*(.*):\s*(\d+)\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+(\d+)\s+/) {
248             $res->{$1} = {
249                 receive => $2,
250                 transmit => $3,
251             };
252         }
253     }
254
255     close($fh);
256
257     return $res;
258 }
259
260 sub write_proc_entry {
261     my ($filename, $data) = @_;#
262
263     my $fh = IO::File->new($filename,  O_WRONLY);
264     die "unable to open file '$filename' - $!\n" if !$fh;
265     die "unable to write '$filename' - $!\n" unless print $fh $data;
266     die "closing file '$filename' failed - $!\n" unless close $fh;
267     $fh->close();
268 }
269
270 sub read_proc_net_route {
271     my $filename = "/proc/net/route";
272
273     my $res = [];
274
275     my $fh = IO::File->new ($filename, "r");
276     return $res if !$fh;
277
278     my $int_to_quad = sub {
279        return join '.' => map { ($_[0] >> 8*(3-$_)) % 256 } (3, 2, 1, 0);
280     };
281
282     while (defined(my $line = <$fh>)) {
283        next if $line =~/^Iface\s+Destination/; # skip head
284        my ($iface, $dest, $gateway, $metric, $mask, $mtu) = (split(/\s+/, $line))[0,1,2,6,7,8];
285        push @$res, {
286            dest => &$int_to_quad(hex($dest)),
287            gateway => &$int_to_quad(hex($gateway)),
288            mask => &$int_to_quad(hex($mask)),
289            metric => $metric,
290            mtu => $mtu,
291            iface => $iface,
292        };
293     }
294
295     return $res;
296 }
297
298 sub read_proc_mounts {
299     return PVE::Tools::file_get_contents("/proc/mounts", 512*1024);
300 }
301
302 # mounts encode spaces (\040), tabs (\011), newlines (\012), backslashes (\\ or \134)
303 sub decode_mount {
304     my ($str) = @_;
305     return $str =~ s/\\(?:040|01[12]|134|\\)/"\"$&\""/geer;
306 }
307
308 sub parse_mounts {
309     my ($mounts) = @_;
310     my $mntent = [];
311     while ($mounts =~ /^\s*([^#].*)$/gm) {
312         # lines from the file are encoded so we can just split at spaces
313         my ($what, $dir, $fstype, $opts) = split(/[ \t]/, $1, 4);
314         my ($freq, $passno) = (0, 0);
315         # in glibc's parser frequency and pass seem to be optional
316         $freq = $1 if $opts =~ s/\s+(\d+)$//;
317         $passno = $1 if $opts =~ s/\s+(\d+)$//;
318         push @$mntent, [decode_mount($what),
319                         decode_mount($dir),
320                         decode_mount($fstype),
321                         decode_mount($opts),
322                         $freq, $passno];
323     }
324     return $mntent;
325 }
326
327 sub parse_proc_mounts {
328     return parse_mounts(read_proc_mounts());
329 }
330
331 sub is_mounted {
332     my ($mountpoint) = @_;
333
334     $mountpoint = Cwd::realpath($mountpoint);
335
336     return 0 if !defined($mountpoint); # path does not exist
337
338     my $mounts = parse_proc_mounts();
339     return (grep { $_->[1] eq $mountpoint } @$mounts) ? 1 : 0;
340 }
341
342 sub read_proc_net_ipv6_route {
343     my $filename = "/proc/net/ipv6_route";
344
345     my $res = [];
346
347     my $fh = IO::File->new ($filename, "r");
348     return $res if !$fh;
349
350     my $read_v6addr = sub { $_[0] =~ s/....(?!$)/$&:/gr };
351
352     # ipv6_route has no header
353     while (defined(my $line = <$fh>)) {
354         my ($dest, $prefix, $nexthop, $metric, $iface) = (split(/\s+/, $line))[0,1,4,5,9];
355         push @$res, {
356             dest => &$read_v6addr($dest),
357             prefix => hex("$prefix"),
358             gateway => &$read_v6addr($nexthop),
359             metric => hex("$metric"),
360             iface => $iface
361         };
362     }
363
364     return $res;
365 }
366
367 sub upid_wait {
368     my ($upid, $waitfunc, $sleep_intervall) = @_;
369
370     my $task = PVE::Tools::upid_decode($upid);
371
372     $sleep_intervall = $sleep_intervall ? $sleep_intervall : 1;
373
374     my $next_time = time + $sleep_intervall;
375
376     while (check_process_running($task->{pid}, $task->{pstart})) {
377
378         if (time >= $next_time && $waitfunc && ref($waitfunc) eq 'CODE'){
379             &$waitfunc($task);
380             $next_time = time + $sleep_intervall;
381         }
382
383         CORE::sleep(1);
384     }
385 }
386
387 # struct ifreq { // FOR SIOCGIFFLAGS:
388 #   char ifrn_name[IFNAMSIZ]
389 #   short ifru_flags
390 # };
391 my $STRUCT_IFREQ_SIOCGIFFLAGS = 'Z' . IFNAMSIZ . 's1';
392 sub get_active_network_interfaces {
393     # Use the interface name list from /proc/net/dev
394     open my $fh, '<', '/proc/net/dev'
395         or die "failed to open /proc/net/dev: $!\n";
396     # And filter by IFF_UP flag fetched via a PF_INET6 socket ioctl:
397     my $sock;
398     socket($sock, PF_INET6, SOCK_DGRAM, &IPPROTO_IP)
399     or socket($sock, PF_INET, SOCK_DGRAM, &IPPROTO_IP)
400     or return [];
401
402     my $ifaces = [];
403     while(defined(my $line = <$fh>)) {
404         next if $line !~ /^\s*([^:\s]+):/;
405         my $ifname = $1;
406         my $ifreq = pack($STRUCT_IFREQ_SIOCGIFFLAGS, $ifname, 0);
407         if (!defined(ioctl($sock, SIOCGIFFLAGS, $ifreq))) {
408             warn "failed to get interface flags for: $ifname\n";
409             next;
410         }
411         my ($name, $flags) = unpack($STRUCT_IFREQ_SIOCGIFFLAGS, $ifreq);
412         push @$ifaces, $ifname if ($flags & IFF_UP);
413     }
414     close $fh;
415     close $sock;
416     return $ifaces;
417 }
418
419 1;