1
|
#!/usr/bin/perl
|
2
|
|
3
|
# All rights reserved and Copyright (c) 2020 Origo Systems ApS.
|
4
|
# This file is provided with no warranty, and is subject to the terms and conditions defined in the license file LICENSE.md.
|
5
|
# The license file is part of this source code package and its content is also available at:
|
6
|
# https://www.origo.io/info/stabiledocs/licensing/stabile-open-source-license
|
7
|
|
8
|
#
|
9
|
# Network and disk activity example:
|
10
|
# https://valve001.irigo.com//stabile/cgi/stats.cgi?uuid=31fe606f-0b5b-46d2-95a3-c38c4678ab0b&cpuload=true&diskactivity=true&networkactivity=true&mem=true&diskspace=true&from=1276425540&to=1277477100
|
11
|
#
|
12
|
# Disk activity example:
|
13
|
# https://valve001.irigo.com//stabile/cgi/stats.cgi?uuid=5eff51c7-f398-4eb9-8495-567cbb2bad77&cpuload=true&diskactivity=true&networkactivity=true&mem=true&diskspace=true&from=1276425540&to=1277477100
|
14
|
#
|
15
|
|
16
|
#
|
17
|
# apt-get install librrdtool-oo-perl
|
18
|
#
|
19
|
|
20
|
use CGI::Carp qw(fatalsToBrowser);
|
21
|
use CGI ':standard';
|
22
|
use JSON;
|
23
|
use URI::Escape;
|
24
|
use RRDTool::OO;
|
25
|
use Tie::DBI;
|
26
|
use ConfigReader::Simple;
|
27
|
|
28
|
|
29
|
my $q = new CGI;
|
30
|
my $params = $q->Vars;
|
31
|
|
32
|
my $suuid = $params->{"uuid"};
|
33
|
die("\nPlease pass a uuid...") unless $suuid;
|
34
|
|
35
|
if ($params->{"format"} eq "text") {
|
36
|
print("\n");
|
37
|
} else {
|
38
|
print(header(
|
39
|
-type=>"application/json",
|
40
|
"Cache-Control"=>"private, max-age=31536000"));
|
41
|
}
|
42
|
|
43
|
my $config = ConfigReader::Simple->new("/etc/stabile/config.cfg", [qw(DBI_USER DBI_PASSWD CPU_OVERCOMMISION)]);
|
44
|
$dbiuser = $config->get('DBI_USER') || "irigo";
|
45
|
$dbipasswd = $config->get('DBI_PASSWD') || "";
|
46
|
|
47
|
my @uuids;
|
48
|
|
49
|
unless (tie %domreg,'Tie::DBI', {
|
50
|
db=>'mysql:steamregister',
|
51
|
table=>'domains',
|
52
|
key=>'uuid',
|
53
|
autocommit=>0,
|
54
|
CLOBBER=>1,
|
55
|
user=>$dbiuser,
|
56
|
password=>$dbipasswd}) {print("Stroke=Error Register could not be accessed\n"); exit;};
|
57
|
|
58
|
if ($domreg{$suuid}) { # We are dealing with a server
|
59
|
push @uuids, $suuid;
|
60
|
} else { # We are dealing with a system
|
61
|
foreach my $valref (values %domreg) {
|
62
|
my $sysuuid = $valref->{'system'};
|
63
|
push @uuids, $valref->{'uuid'} if ($sysuuid eq $suuid)
|
64
|
}
|
65
|
}
|
66
|
untie %domreg;
|
67
|
|
68
|
unless (@uuids) {
|
69
|
print "Stroke=Error Invalid uuid\n";
|
70
|
exit;
|
71
|
}
|
72
|
|
73
|
my $from = $params->{"from"};
|
74
|
my $to = $params->{"to"};
|
75
|
my $dif = $to - $from;
|
76
|
my $now = time();
|
77
|
|
78
|
|
79
|
if (0 && !$params->{'sum'}) {
|
80
|
my @items;
|
81
|
foreach my $uuid (@uuids) {
|
82
|
my $timestamps = ();
|
83
|
my $cpuLoad = ();
|
84
|
my $mem = ();
|
85
|
my $diskActivity = ();
|
86
|
my $networkActivityRX = ();
|
87
|
my $networkActivityTX = ();
|
88
|
my $diskReads = ();
|
89
|
my $diskWrites = ();
|
90
|
|
91
|
#print qq|{"uuid": "$uuid"}| unless (hasRRD($uuid));
|
92
|
next unless hasRRD($uuid);
|
93
|
#
|
94
|
# Fetch data from RRD buckets...
|
95
|
#
|
96
|
my $rrd = RRDTool::OO->new(file =>"/var/cache/rrdtool/".$uuid."_highres.rrd");
|
97
|
#$rrd->fetch_start(start => $params->{"from"}, end => $params->{"to"});
|
98
|
|
99
|
my $last = $rrd->last();
|
100
|
|
101
|
#$rrd->fetch_start(start => $last-$dif, end => $last);
|
102
|
$rrd->fetch_start(start => $now-$dif, end=> $now);
|
103
|
# $rrd->fetch_skip_undef();
|
104
|
|
105
|
while(my($timestamp, @value) = $rrd->fetch_next()) {
|
106
|
last if ($timestamp >= $last && $now-$last<20);
|
107
|
my $domain_cpuTime = shift(@value);
|
108
|
my $blk_hda_rdBytes = shift(@value);
|
109
|
my $blk_hda_wrBytes = shift(@value);
|
110
|
my $if_vnet0_rxBytes = shift(@value);
|
111
|
my $if_vnet0_txBytes = shift(@value);
|
112
|
my $domain_nrVirtCpu = shift(@value);
|
113
|
my $domain_memory = shift(@value);
|
114
|
my $domain_maxMem = shift(@value);
|
115
|
|
116
|
push(@$timestamps, $timestamp);
|
117
|
|
118
|
# domain_cpuTime is avg. nanosecs spent pr. 1s
|
119
|
# convert to value [0;1]
|
120
|
$domain_cpuTime = $domain_cpuTime / 10**9 if ($domain_cpuTime);
|
121
|
push(@$cpuLoad, int(100*$domain_cpuTime)/100);
|
122
|
#push(@$mem, $domain_memory);
|
123
|
# push(@$diskActivity, $blk_hda_rdBytes + $blk_hda_wrBytes);
|
124
|
$blk_hda_rdBytes = $blk_hda_rdBytes if ($blk_hda_rdBytes);
|
125
|
push(@$diskReads, int(100*$blk_hda_rdBytes)/100);
|
126
|
$blk_hda_wrBytes = $blk_hda_wrBytes if ($blk_hda_wrBytes);
|
127
|
push(@$diskWrites, int(100*$blk_hda_wrBytes)/100);
|
128
|
push(@$networkActivityRX, int(100*$if_vnet0_rxBytes)/100);
|
129
|
push(@$networkActivityTX, int(100*$if_vnet0_txBytes)/100);
|
130
|
#
|
131
|
# Build JSON result...
|
132
|
#
|
133
|
}
|
134
|
my @t = ( $now-$dif, $now);
|
135
|
my @a = (undef, undef);
|
136
|
|
137
|
my $item = ();
|
138
|
$item->{"uuid"} = $uuid;
|
139
|
$item->{"timestamps"} = $timestamps || \@t;
|
140
|
|
141
|
if (lc($params->{"cpuload"}) eq "true") {
|
142
|
$item->{"cpuload"} = $cpuLoad || \@a;
|
143
|
}
|
144
|
if (lc($params->{"mem"}) eq "true") {
|
145
|
$item->{"mem"} = $mem || \@a;
|
146
|
}
|
147
|
# if (lc($params->{"diskactivity"}) eq "true") {
|
148
|
# $item->{"diskactivity"} = $diskActivity;
|
149
|
# }
|
150
|
if (lc($params->{"diskReads"}) eq "true") {
|
151
|
$item->{"diskReads"} = $diskReads || \@a;
|
152
|
}
|
153
|
if (lc($params->{"diskWrites"}) eq "true") {
|
154
|
# $item->{"diskWrites"} = $diskWrites || \@a;
|
155
|
}
|
156
|
if (lc($params->{"networkactivityrx"}) eq "true") {
|
157
|
$item->{"networkactivityrx"} = $networkActivityRX || \@a;
|
158
|
}
|
159
|
if (lc($params->{"networkactivitytx"}) eq "true") {
|
160
|
$item->{"networkactivitytx"} = $networkActivityTX || \@a;
|
161
|
}
|
162
|
push @items, $item;
|
163
|
}
|
164
|
print(to_json(\@items, {pretty=>1}));
|
165
|
|
166
|
} else {
|
167
|
my @items;
|
168
|
my %cpuLoad = ();
|
169
|
my %networkActivityRX = ();
|
170
|
my %networkActivityTX = ();
|
171
|
my %diskReads = ();
|
172
|
my %diskWrites = ();
|
173
|
my $i = 0;
|
174
|
foreach my $uuid (@uuids) {
|
175
|
next unless hasRRD($uuid);
|
176
|
$i++;
|
177
|
#
|
178
|
# Fetch data from RRD buckets...
|
179
|
#
|
180
|
my $rrd = RRDTool::OO->new(file =>"/var/cache/rrdtool/".$uuid."_highres.rrd");
|
181
|
my $last = $rrd->last();
|
182
|
$rrd->fetch_start(start => $now-$dif, end=> $now);
|
183
|
|
184
|
while(my($timestamp, @value) = $rrd->fetch_next()) {
|
185
|
last if ($timestamp >= $last && $now-$last<20);
|
186
|
my $domain_cpuTime = shift(@value);
|
187
|
my $blk_hda_rdBytes = shift(@value);
|
188
|
my $blk_hda_wrBytes = shift(@value);
|
189
|
my $if_vnet0_rxBytes = shift(@value);
|
190
|
my $if_vnet0_txBytes = shift(@value);
|
191
|
|
192
|
# domain_cpuTime is avg. nanosecs spent pr. 1s
|
193
|
# convert to value [0;1]
|
194
|
$domain_cpuTime = $domain_cpuTime / 10**9 if ($domain_cpuTime);
|
195
|
$cpuLoad{$timestamp} += $domain_cpuTime;
|
196
|
|
197
|
$blk_hda_rdBytes = $blk_hda_rdBytes if ($blk_hda_rdBytes);
|
198
|
$diskReads{$timestamp} += $blk_hda_rdBytes;
|
199
|
|
200
|
$blk_hda_wrBytes = $blk_hda_wrBytes if ($blk_hda_wrBytes);
|
201
|
$diskWrites{$timestamp} += $blk_hda_wrBytes;
|
202
|
|
203
|
$networkActivityRX{$timestamp} += $if_vnet0_rxBytes;
|
204
|
$networkActivityTX{$timestamp} += $if_vnet0_txBytes;
|
205
|
}
|
206
|
}
|
207
|
my @t = ( $now-$dif, $now);
|
208
|
my @a = (undef, undef);
|
209
|
$i = $i || 1;
|
210
|
|
211
|
my $item = ();
|
212
|
$item->{"uuid"} = $suuid;
|
213
|
my @tstamps = sort keys %cpuLoad;
|
214
|
$item->{"timestamps"} = \@tstamps || \@t;
|
215
|
|
216
|
if (lc($params->{"cpuload"}) eq "true") {
|
217
|
my @vals;
|
218
|
foreach(@tstamps) {push @vals, int(100*$cpuLoad{$_})/100 unless ($cpuLoad{$_} > $i)};
|
219
|
$item->{"cpuload"} = \@vals || \@a;
|
220
|
}
|
221
|
if (lc($params->{"diskReads"}) eq "true") {
|
222
|
my @vals;
|
223
|
foreach(@tstamps) {push @vals, int(100*$diskReads{$_})/100;};
|
224
|
$item->{"diskReads"} = \@vals || \@a;
|
225
|
}
|
226
|
if (lc($params->{"diskWrites"}) eq "true") {
|
227
|
my @vals;
|
228
|
foreach(@tstamps) {push @vals, int(100*$diskWrites{$_})/100;};
|
229
|
$item->{"diskWrites"} = \@vals || \@a;
|
230
|
}
|
231
|
if (lc($params->{"networkactivityrx"}) eq "true") {
|
232
|
my @vals;
|
233
|
foreach(@tstamps) {push @vals, int(100*$networkActivityRX{$_})/100;};
|
234
|
$item->{"networkactivityrx"} = \@vals || \@a;
|
235
|
}
|
236
|
if (lc($params->{"networkactivitytx"}) eq "true") {
|
237
|
my @vals;
|
238
|
foreach(@tstamps) {push @vals, int(100*$networkActivityTX{$_})/100;};
|
239
|
$item->{"networkactivitytx"} = \@vals || \@a;
|
240
|
}
|
241
|
push @items, $item;
|
242
|
|
243
|
print(to_json(\@items, {pretty=>1}));
|
244
|
}
|
245
|
|
246
|
|
247
|
#$rrd->graph(
|
248
|
# image => "/var/www/orellana.org/stabile/static/img/rrd_out.png",
|
249
|
# vertical_label => 'Bits',
|
250
|
# start => $params->{"from"},
|
251
|
## end => time(),
|
252
|
# draw => { thickness => 1,
|
253
|
# dsname => "domain-cpuTime",
|
254
|
# color => 'FF0000',
|
255
|
# legend => 'Bits over Time',
|
256
|
# },
|
257
|
# ) if (0);
|
258
|
|
259
|
#
|
260
|
# hasRRD: Checks if a RRD for the specified uuid exists.
|
261
|
#
|
262
|
# @param uuid The uuid for which to look for a RRD for
|
263
|
#
|
264
|
sub hasRRD {
|
265
|
my($uuid) = @_;
|
266
|
my $rrd_file = "/var/cache/rrdtool/".$uuid."_highres.rrd";
|
267
|
|
268
|
if ((not -e $rrd_file) and ($uuid)) {
|
269
|
return(0);
|
270
|
} else {
|
271
|
return(1);
|
272
|
}
|
273
|
}
|
274
|
|