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