|
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
|
package Stabile::Images;
|
|
9
|
|
|
10
|
use Error qw(:try);
|
|
11
|
use File::Basename;
|
|
12
|
use Data::UUID;
|
|
13
|
use Proc::Daemon;
|
|
14
|
use Time::Local;
|
|
15
|
#use Time::HiRes qw( time );
|
|
16
|
use Date::Format;
|
|
17
|
use Date::Parse;
|
|
18
|
use Getopt::Std;
|
|
19
|
#use Encode::Escape;
|
|
20
|
use String::Escape;
|
|
21
|
use File::Glob qw(bsd_glob);
|
|
22
|
use Sys::Guestfs;
|
|
23
|
use Data::Dumper;
|
|
24
|
use XML::Simple;
|
|
25
|
#use POSIX qw(strftime);
|
|
26
|
use Time::Piece;
|
|
27
|
use Config::Simple;
|
|
28
|
use lib dirname (__FILE__); # Allows us to source libraries from current directory no matter where we are called from
|
|
29
|
use Stabile;
|
|
30
|
|
|
31
|
$\ = ''; # Some of the above seems to set this to \n, resulting in every print appending a line feed
|
|
32
|
|
|
33
|
# Read in some settings from config
|
|
34
|
$backupdir = $Stabile::config->get('STORAGE_BACKUPDIR') || "/mnt/stabile/backups";
|
|
35
|
$backupdir = $1 if ($backupdir =~ /(.+)/); #untaint
|
|
36
|
my $tenders = $Stabile::config->get('STORAGE_POOLS_ADDRESS_PATHS');
|
|
37
|
my @tenderlist = split(/,\s*/, $tenders);
|
|
38
|
my $tenderpaths = $Stabile::config->get('STORAGE_POOLS_LOCAL_PATHS') || "/mnt/stabile/images";
|
|
39
|
my @tenderpathslist = split(/,\s*/, $tenderpaths);
|
|
40
|
my $tendernames = $Stabile::config->get('STORAGE_POOLS_NAMES') || "Standard storage";
|
|
41
|
my @tendernameslist = split(/,\s*/, $tendernames);
|
|
42
|
my $mountabletenders = $Stabile::config->get('STORAGE_POOLS_MOUNTABLE');
|
|
43
|
my @mountabletenderslist = split(/,\s*/, $mountabletenders);
|
|
44
|
my $storagepools = $Stabile::config->get('STORAGE_POOLS_DEFAULTS') || "0";
|
|
45
|
my $spoolsrdiffenabled = $Stabile::config->get('STORAGE_POOLS_RDIFF-BACKUP_ENABLED') || "0";
|
|
46
|
my @rdiffenabledlist = split(/,\s*/, $spoolsrdiffenabled);
|
|
47
|
my $rdiffenabled = $Stabile::config->get('RDIFF-BACKUP_ENABLED') || "0";
|
|
48
|
my $userrdiffenabled = $Stabile::config->get('RDIFF-BACKUP_USERS') || "0";
|
|
49
|
my $nodestorageovercommission = $Stabile::config->get('NODE_STORAGE_OVERCOMMISSION') || "1";
|
|
50
|
my $engineid = $Stabile::config->get('ENGINEID') || "";
|
|
51
|
|
|
52
|
my $valve_readlimit = $Stabile::config->get('VALVE_READ_LIMIT'); # e.g. 125829120 = 120 * 1024 * 1024 = 120 MB / s
|
|
53
|
my $valve_writelimit = $Stabile::config->get('VALVE_WRITE_LIMIT');
|
|
54
|
my $valve_iopsreadlimit = $Stabile::config->get('VALVE_IOPS_READ_LIMIT'); # e.g. 1000 IOPS
|
|
55
|
my $valve_iopswritelimit = $Stabile::config->get('VALVE_IOPS_WRITE_LIMIT');
|
|
56
|
|
|
57
|
my $valve001id = '995e86b7-ae85-4ae0-9800-320c1f59ae33';
|
|
58
|
my $stackspool = '/mnt/stabile/images001';
|
|
59
|
|
|
60
|
our %ahash; # A hash of accounts and associated privileges current user has access to
|
|
61
|
#our %options=();
|
|
62
|
# -a action -h help -f full list -p full update -u uuid -i image -m match pattern -k keywords -g args to gearman task
|
|
63
|
# -v verbose, include HTTP headers -s impersonate subaccount -t target [uuid or image]
|
|
64
|
#Getopt::Std::getopts("a:hfpu:i:g:m:k:vs:t:", \%options);
|
|
65
|
|
|
66
|
try {
|
|
67
|
Init(); # Perform various initalization tasks
|
|
68
|
process() if ($package); # Parse and process request. $package is not set if called as a library
|
|
69
|
|
|
70
|
} catch Error with {
|
|
71
|
my $ex = shift;
|
|
72
|
print header('text/html', '500 Internal Server Error') unless ($console);
|
|
73
|
if ($ex->{-text}) {
|
|
74
|
print "Got error: ", $ex->{-text}, " on line ", $ex->{-line}, "\n";
|
|
75
|
} else {
|
|
76
|
print "Status=ERROR\n";
|
|
77
|
}
|
|
78
|
} finally {
|
|
79
|
};
|
|
80
|
|
|
81
|
1;
|
|
82
|
|
|
83
|
sub Init {
|
|
84
|
|
|
85
|
# Tie database tables to hashes
|
|
86
|
unless ( tie(%userreg,'Tie::DBI', Hash::Merge::merge({table=>'users', key=>'username', CLOBBER=>1}, $Stabile::dbopts)) ) {return "Unable to access user register"};
|
|
87
|
unless ( tie(%register,'Tie::DBI', Hash::Merge::merge({table=>'images', key=>'path'}, $Stabile::dbopts)) ) {return "Unable to access image register"};
|
|
88
|
unless ( tie(%networkreg,'Tie::DBI', Hash::Merge::merge({table=>'networks'}, $Stabile::dbopts)) ) {return "Unable to access network register"};
|
|
89
|
unless ( tie(%imagereg,'Tie::DBI', Hash::Merge::merge({table=>'images', CLOBBER=>1}, $Stabile::dbopts)) ) {return "Unable to access image uuid register"};
|
|
90
|
unless ( tie(%domreg,'Tie::DBI', Hash::Merge::merge({table=>'domains'}, $Stabile::dbopts)) ) {return "Unable to access domain register"};
|
|
91
|
|
|
92
|
# simplify globals initialized in Stabile.pm
|
|
93
|
$tktuser = $tktuser || $Stabile::tktuser;
|
|
94
|
$user = $user || $Stabile::user;
|
|
95
|
$isadmin = $isadmin || $Stabile::isadmin;
|
|
96
|
$sshcmd = $sshcmd || $Stabile::sshcmd;
|
|
97
|
$disablesnat = $disablesnat || $Stabile::disablesnat;
|
|
98
|
|
|
99
|
# Create aliases of functions
|
|
100
|
*header = \&CGI::header;
|
|
101
|
|
|
102
|
*Getimagesdevice = \&Liststoragedevices;
|
|
103
|
*Getbackupdevice = \&Liststoragedevices;
|
|
104
|
*Listimagesdevices = \&Liststoragedevices;
|
|
105
|
*Listbackupdevices = \&Liststoragedevices;
|
|
106
|
*Rebase = \&Unmaster;
|
|
107
|
|
|
108
|
*do_save = \&privileged_action_async;
|
|
109
|
*do_sync_save = \&privileged_action;
|
|
110
|
*do_sync_backup = \&privileged_action;
|
|
111
|
*do_sync_clone = \&privileged_action;
|
|
112
|
*do_updateregister = \&action;
|
|
113
|
*do_fullupdateregister = \&action;
|
|
114
|
*do_tablelistall = \&do_list;
|
|
115
|
*do_tablelist = \&do_list;
|
|
116
|
*Sync_save = \&Save;
|
|
117
|
*Sync_backup = \&Backup;
|
|
118
|
*Sync_clone = \&Clone;
|
|
119
|
*do_help = \&action;
|
|
120
|
|
|
121
|
*do_mount = \&privileged_action;
|
|
122
|
*do_unmount = \&privileged_action;
|
|
123
|
*do_convert = \&privileged_action;
|
|
124
|
*do_activate = \&privileged_action;
|
|
125
|
*do_publish = \&privileged_action;
|
|
126
|
*do_uploadtoregistry = \&privileged_action;
|
|
127
|
*do_release = \&privileged_action;
|
|
128
|
*do_download = \&privileged_action;
|
|
129
|
*do_linkmaster = \&privileged_action;
|
|
130
|
*do_listbackups = \&privileged_action;
|
|
131
|
*do_listcdroms = \&action;
|
|
132
|
*do_listfiles = \&privileged_action;
|
|
133
|
*do_getserverbackups = \&privileged_action;
|
|
134
|
*do_listserverbackups = \&privileged_action;
|
|
135
|
*Listserverbackups = \&Getserverbackups;
|
|
136
|
*do_restorefiles = \&privileged_action;
|
|
137
|
*do_remove = \&privileged_action;
|
|
138
|
*do_removeuserimages = \&privileged_action;
|
|
139
|
*do_updatedownloads = \&privileged_action;
|
|
140
|
*do_master = \&privileged_action_async;
|
|
141
|
*do_unmaster = \&privileged_action_async;
|
|
142
|
*do_rebase = \&privileged_action_async;
|
|
143
|
*do_clone = \&privileged_action_async;
|
|
144
|
*do_snapshot = \&privileged_action_async;
|
|
145
|
*do_unsnap = \&privileged_action_async;
|
|
146
|
*do_revert = \&privileged_action_async;
|
|
147
|
*do_inject = \&privileged_action_async;
|
|
148
|
*do_backup = \&privileged_action_async;
|
|
149
|
*do_zbackup = \&privileged_action;
|
|
150
|
*do_restore = \&privileged_action_async;
|
|
151
|
*do_updatebackingfile = \&privileged_action;
|
|
152
|
*do_updatebtime = \&privileged_action;
|
|
153
|
*do_updateallbtimes = \&privileged_action;
|
|
154
|
*do_initializestorage = \&privileged_action;
|
|
155
|
*do_liststoragedevices = \&privileged_action;
|
|
156
|
*do_listimagesdevices = \&privileged_action;
|
|
157
|
*do_listbackupdevices = \&privileged_action;
|
|
158
|
*do_getimagesdevice = \&privileged_action;
|
|
159
|
*do_getbackupdevice = \&privileged_action;
|
|
160
|
*do_setstoragedevice = \&privileged_action;
|
|
161
|
*do_backupfuel = \&privileged_action;
|
|
162
|
|
|
163
|
*do_gear_save = \&do_gear_action;
|
|
164
|
*do_gear_sync_save = \&do_gear_action;
|
|
165
|
*do_gear_sync_backup = \&do_gear_action;
|
|
166
|
*do_gear_sync_clone = \&do_gear_action;
|
|
167
|
*do_gear_mount = \&do_gear_action;
|
|
168
|
*do_gear_unmount = \&do_gear_action;
|
|
169
|
*do_gear_convert = \&do_gear_action;
|
|
170
|
*do_gear_activate = \&do_gear_action;
|
|
171
|
*do_gear_publish = \&do_gear_action;
|
|
172
|
*do_gear_uploadtoregistry = \&do_gear_action;
|
|
173
|
*do_gear_release = \&do_gear_action;
|
|
174
|
*do_gear_download = \&do_gear_action;
|
|
175
|
*do_gear_linkmaster = \&do_gear_action;
|
|
176
|
*do_gear_listbackups = \&do_gear_action;
|
|
177
|
*do_gear_listserverbackups = \&do_gear_action;
|
|
178
|
*do_gear_getserverbackups = \&do_gear_action;
|
|
179
|
*do_gear_listfiles = \&do_gear_action;
|
|
180
|
*do_gear_restorefiles = \&do_gear_action;
|
|
181
|
*do_gear_remove = \&do_gear_action;
|
|
182
|
*do_gear_removeuserimages = \&do_gear_action;
|
|
183
|
*do_gear_updatedownloads = \&do_gear_action;
|
|
184
|
*do_gear_master = \&do_gear_action;
|
|
185
|
*do_gear_unmaster = \&do_gear_action;
|
|
186
|
*do_gear_rebase = \&do_gear_action;
|
|
187
|
*do_gear_clone = \&do_gear_action;
|
|
188
|
*do_gear_snapshot = \&do_gear_action;
|
|
189
|
*do_gear_unsnap = \&do_gear_action;
|
|
190
|
*do_gear_revert = \&do_gear_action;
|
|
191
|
*do_gear_inject = \&do_gear_action;
|
|
192
|
*do_gear_backup = \&do_gear_action;
|
|
193
|
*do_gear_zbackup = \&do_gear_action;
|
|
194
|
*do_gear_restore = \&do_gear_action;
|
|
195
|
*do_gear_updatebackingfile = \&do_gear_action;
|
|
196
|
*do_gear_updatebtime = \&do_gear_action;
|
|
197
|
*do_gear_updateallbtimes = \&do_gear_action;
|
|
198
|
*do_gear_initializestorage = \&do_gear_action;
|
|
199
|
*do_gear_liststoragedevices = \&do_gear_action;
|
|
200
|
*do_gear_listimagesdevices = \&do_gear_action;
|
|
201
|
*do_gear_listbackupdevices = \&do_gear_action;
|
|
202
|
*do_gear_getimagesdevice = \&do_gear_action;
|
|
203
|
*do_gear_getbackupdevice = \&do_gear_action;
|
|
204
|
*do_gear_setstoragedevice = \&do_gear_action;
|
|
205
|
*do_gear_backupfuel = \&do_gear_action;
|
|
206
|
|
|
207
|
*Fullupdateregister = \&Updateregister;
|
|
208
|
|
|
209
|
@users; # global
|
|
210
|
if ($fulllist) {
|
|
211
|
@users = keys %userreg;
|
|
212
|
push @users, "common";
|
|
213
|
} else {
|
|
214
|
@users = ($user, "common");
|
|
215
|
}
|
|
216
|
|
|
217
|
untie %userreg;
|
|
218
|
|
|
219
|
# my $mounts = decode('ascii-escape', `/bin/cat /proc/mounts`);
|
|
220
|
my $mounts = `/bin/cat /proc/mounts`;
|
|
221
|
@spools;
|
|
222
|
|
|
223
|
# Enumerate and define the storage pools a user has access to
|
|
224
|
my @spl = split(/,\s*/, $storagepools);
|
|
225
|
my $reloadnfs;
|
|
226
|
foreach my $p (@spl) {
|
|
227
|
if ($tenderlist[$p] && $tenderpathslist[$p] && $tendernameslist[$p]) {
|
|
228
|
my $rd = (defined $rdiffenabledlist[$p])?$rdiffenabledlist[$p]:"$rdiffenabledlist[0]";
|
|
229
|
my %pool = ("hostpath", $tenderlist[$p],
|
|
230
|
"path", $tenderpathslist[$p],
|
|
231
|
"name", $tendernameslist[$p],
|
|
232
|
"rdiffenabled", $rd,
|
|
233
|
"mountable", ($tenderlist[$p] eq 'local') || $mountabletenderslist[$p] || '0', # local pools always mountable
|
|
234
|
"lvm", 0+($tenderlist[$p] eq 'local' && ($mounts =~ m/\/dev\/mapper\/(\S+)-(\S+) $tenderpathslist[$p].+/g) ),
|
|
235
|
"zfs", (($mounts =~ /(\S+) $tenderpathslist[$p] zfs/)?$1:''),
|
|
236
|
"id", $p);
|
|
237
|
$spools[$p] = \%pool;
|
|
238
|
|
|
239
|
# Directory / mount point must exist
|
|
240
|
unless (-d $tenderpathslist[$p]) {return "Status=Error $tenderpathslist[$p] could not be accessed"};
|
|
241
|
|
|
242
|
# TODO: This section should be moved to pressurecontrol
|
|
243
|
if ($tenderlist[$p] eq "local") {
|
|
244
|
my $lpath = $tenderpathslist[$p];
|
|
245
|
`mkdir "$lpath"` unless (-e $lpath);
|
|
246
|
unless (`grep "$lpath 10" /etc/exports`) {
|
|
247
|
`echo "$lpath 10.0.0.0/255.255.255.0(sync,no_subtree_check,no_root_squash,rw)" >> /etc/exports`;
|
|
248
|
$reloadnfs = 1;
|
|
249
|
}
|
|
250
|
} elsif ($mounts =~ m/$tenderpathslist[$p]/i) {
|
|
251
|
; # do nothing
|
|
252
|
} else {
|
|
253
|
$main::syslogit->($user, 'info', "Mounting $tenderpathslist[$p] from $tenderlist[$p]");
|
|
254
|
eval {
|
|
255
|
system("/bin/mount -o intr,noatime,nfsvers=3 $tenderlist[$p] $tenderpathslist[$p]");
|
|
256
|
1;
|
|
257
|
} or {return "Status=Error $tenderpathslist[$p] could not be mounted"};
|
|
258
|
}
|
|
259
|
|
|
260
|
# Create user dir if it does not exist
|
|
261
|
unless(-d "$tenderpathslist[$p]/$user"){
|
|
262
|
umask "0000";
|
|
263
|
mkdir "$tenderpathslist[$p]/$user" or {return "Status=Cannot create user dir for $user in $tenderpathslist[$p]"};
|
|
264
|
}
|
|
265
|
unless(-d "$tenderpathslist[$p]/common"){
|
|
266
|
umask "0000";
|
|
267
|
mkdir "$tenderpathslist[$p]/common" or {return "Status=Cannot create common dir for $user in $tenderpathslist[$p]"};
|
|
268
|
}
|
|
269
|
}
|
|
270
|
}
|
|
271
|
`/usr/sbin/exportfs -r` if ($reloadnfs); #Reexport nfs shares
|
|
272
|
|
|
273
|
# Create user's backupdir if it does not exist
|
|
274
|
unless(-d "$backupdir/$user"){
|
|
275
|
umask "0000";
|
|
276
|
mkdir "$backupdir/$user" or {$postreply .= "Status=ERROR No backup dir $backupdir/$user\n"};
|
|
277
|
}
|
|
278
|
|
|
279
|
}
|
|
280
|
|
|
281
|
sub getObj {
|
|
282
|
my %h = %{@_[0]};
|
|
283
|
my $status = $h{"status"};
|
|
284
|
$console = 1 if $h{"console"};
|
|
285
|
$api = 1 if $h{"api"};
|
|
286
|
my $obj;
|
|
287
|
$action = $action || $h{'action'};
|
|
288
|
if (
|
|
289
|
$action =~ /^clone|^sync_clone|^removeuserimages|^gear_removeuserimages|^activate|^gear_activate|^publish|uploadtoregistry|^release|^download|^gear_publish/
|
|
290
|
|| $action =~ /^gear_release|zbackup|setimagesdevice|setbackupdevice|initializestorage|setstoragedevice|backupfuel|sync_backup|overquota/
|
|
291
|
|
|
292
|
) {
|
|
293
|
$obj = \%h;
|
|
294
|
return $obj;
|
|
295
|
}
|
|
296
|
my $uuid = $h{"uuid"};
|
|
297
|
if ($uuid && $uuid =~ /^\// ) { # Ugly clutch
|
|
298
|
$uuid = $register{$uuid}->{'uuid'};
|
|
299
|
}
|
|
300
|
if ($uuid eq 'this' && $curimg
|
|
301
|
&& ($register{$curimg}->{'user'} eq $user || $isadmin )) { # make an ugly exception
|
|
302
|
$uuid = $register{$curimg}->{'uuid'};
|
|
303
|
}
|
|
304
|
my $objaction = lc $h{"action"};
|
|
305
|
$status = "new" unless ($status || $h{'path'} || $uuid || $action eq 'inject');
|
|
306
|
if ($status eq "new") {
|
|
307
|
$objaction = "";
|
|
308
|
}
|
|
309
|
if (!$uuid && $register{$h{'path'}} && ( $register{$h{'path'}}->{'user'} eq $user || $isadmin )) {
|
|
310
|
$uuid = $register{$h{'path'}}->{'uuid'};
|
|
311
|
}
|
|
312
|
my $img = $imagereg{$uuid};
|
|
313
|
$status = $img->{'status'} if ($imagereg{$uuid});
|
|
314
|
if ($objaction eq 'buildsystem' && !$uuid && $h{'master'}) { # make another exception
|
|
315
|
my $master = $h{'master'};
|
|
316
|
foreach my $p (@spools) {
|
|
317
|
my $dir = $p->{'path'};
|
|
318
|
if ($master =~ /^$dir\/(common|$user)\/.+/ && $register{$master}) { # valid master image
|
|
319
|
$uuid = $register{$master}->{'uuid'};
|
|
320
|
last;
|
|
321
|
}
|
|
322
|
elsif ($register{"$dir/common/$master"}) { # valid master image
|
|
323
|
$uuid = $register{"$dir/$user/$master"}->{'uuid'};
|
|
324
|
last;
|
|
325
|
}
|
|
326
|
elsif ($register{"$dir/$user/$master"}) { # valid master image
|
|
327
|
$uuid = $register{"$dir/$user/$master"}->{'uuid'};
|
|
328
|
last;
|
|
329
|
}
|
|
330
|
}
|
|
331
|
}
|
|
332
|
my $path = '';
|
|
333
|
$path = $img->{'path'} unless ($status eq "new"); # Only trust path from db /co
|
|
334
|
my $dbobj = $register{$path} || {};
|
|
335
|
return 0 unless (($path && $dbobj->{'user'} eq $user) || $isadmin || $status eq "new"); # Security check
|
|
336
|
|
|
337
|
unless (($uuid && $imagereg{$uuid} && $status ne 'new') || ($status eq 'new' && !$imagereg{$uuid} && (!$uuid || length($uuid) == 36))) {
|
|
338
|
$postreply .= "Status=ERROR Invalid image " . (($uuid)?" uuid: $uuid":"") . (($path)?" path: $path":"") . "\n";
|
|
339
|
return 0;
|
|
340
|
}
|
|
341
|
if ($isadmin && $h{"status"}) {
|
|
342
|
$status = $h{"status"} unless ($status eq "new");
|
|
343
|
} else {
|
|
344
|
$status = $dbobj->{'status'} unless ($status eq "new"); # Read status from db for existing images
|
|
345
|
}
|
|
346
|
my $virtualsize = $h{"virtualsize"} || $dbobj->{'virtualsize'};
|
|
347
|
# allow shorthand size specifications
|
|
348
|
$virtualsize = 1024 * $virtualsize if ($virtualsize =~ /k$/i);
|
|
349
|
$virtualsize = 1024*1024* $virtualsize if ($virtualsize =~ /m$/i);
|
|
350
|
$virtualsize = 1024*1024*1024* $virtualsize if ($virtualsize =~ /g$/i);
|
|
351
|
$virtualsize = 10737418240 if ($status eq 'new' && !$virtualsize); # 10 GB
|
|
352
|
|
|
353
|
$obj = {
|
|
354
|
path => $path,
|
|
355
|
uuid => $uuid,
|
|
356
|
status => $status,
|
|
357
|
name => $h{"name"} || $dbobj->{'name'}, # || 'New Image',
|
|
358
|
size => $h{"size"} || $dbobj->{'size'},
|
|
359
|
realsize => $dbobj->{'realsize'} || 0,
|
|
360
|
virtualsize => $virtualsize,
|
|
361
|
ksize => int($virtualsize / 1024),
|
|
362
|
msize => int($virtualsize / (1024 * 1024)),
|
|
363
|
type => $h{"type"} || $dbobj->{'type'} || 'qcow2',
|
|
364
|
user => $h{"user"} || $dbobj->{'user'},
|
|
365
|
reguser => $dbobj->{'user'},
|
|
366
|
master => $dbobj->{'master'},
|
|
367
|
regstoragepool => $dbobj->{'storagepool'},
|
|
368
|
storagepool => (!$h{"storagepool"} && $h{"storagepool"} ne "0") ? $dbobj->{'storagepool'} : $h{"storagepool"},
|
|
369
|
bschedule => $h{"bschedule"} || $dbobj->{'bschedule'},
|
|
370
|
notes => $h{"notes"},
|
|
371
|
installable => ($installable && $installable ne "false") ? "true" : $h{"installable"},
|
|
372
|
snap1 => $dbobj->{'snap1'},
|
|
373
|
managementlink => $h{"managementlink"} || $dbobj->{'managementlink'},
|
|
374
|
upgradelink => $h{"upgradelink"} || $dbobj->{'upgradelink'},
|
|
375
|
terminallink => $h{"terminallink"} || $dbobj->{'terminallink'},
|
|
376
|
image2 => $h{"image2"} || $dbobj->{'image2'},
|
|
377
|
mac => $h{"mac"} || $dbobj->{'mac'},
|
|
378
|
backup => $h{"backup"} || '',
|
|
379
|
domains => $dbobj->{'domains'} || '--',
|
|
380
|
domainnames => $dbobj->{'domainnames'} || '--'
|
|
381
|
};
|
|
382
|
# Handle restore of files
|
|
383
|
$obj->{'restorepath'} = $h{'restorepath'} if ($h{'restorepath'});
|
|
384
|
$obj->{'files'} = $h{'files'} if ($h{'files'});
|
|
385
|
$obj->{'sync'} = 1 if ($h{'sync'});
|
|
386
|
# For backup
|
|
387
|
$obj->{'skipzfs'} = 1 if ($h{'skipzfs'});
|
|
388
|
|
|
389
|
# Sanity checks
|
|
390
|
if (
|
|
391
|
($obj->{name} && length $obj->{name} > 255)
|
|
392
|
|| ($obj->{virtualsize} && ($obj->{virtualsize}<1024 || $obj->{virtualsize} >1024**5))
|
|
393
|
|| ($obj->{master} && length $obj->{master} > 255)
|
|
394
|
|| ($obj->{bschedule} && length $obj->{bschedule} > 255)
|
|
395
|
|| ($path && length $path > 255)
|
|
396
|
|| ($obj->{image2} && length $obj->{image2} > 255)
|
|
397
|
) {
|
|
398
|
$postreply .= "Status=ERROR Bad image data for: $obj->{name}\n";
|
|
399
|
return 0;
|
|
400
|
}
|
|
401
|
# Security check
|
|
402
|
if (($user ne $obj->{reguser} && $objaction ne 'clone' && $objaction ne 'buildsystem' && !$isadmin && $objaction))
|
|
403
|
{
|
|
404
|
$postreply .= "Status=ERROR No privs\n";
|
|
405
|
return 0;
|
|
406
|
}
|
|
407
|
if ($status eq "new" && ($obj->{reguser} || -e $path)) {
|
|
408
|
$postreply .= "Status=ERROR Image \"$obj->{name}\" does already exist in $path\n";
|
|
409
|
return 0;
|
|
410
|
}
|
|
411
|
if (!$path && $status ne "new") {
|
|
412
|
$postreply .= "Status=ERROR Image $obj->{name} not found\n";
|
|
413
|
return 0;
|
|
414
|
}
|
|
415
|
return $obj;
|
|
416
|
}
|
|
417
|
|
|
418
|
sub createNodeTask {
|
|
419
|
my ($mac, $newtask, $status, $wake) = @_;
|
|
420
|
unless ( tie(%nodereg,'Tie::DBI', Hash::Merge::merge({table=>'nodes', key=>'mac'}, $Stabile::dbopts)) )
|
|
421
|
{$postreply .= "Status=Error Node register could not be accessed"};
|
|
422
|
|
|
423
|
if ($status eq "active" && $nodereg{$mac}->{'stor'} ne 'lvm') {
|
|
424
|
$postreply .= "Status=Error Node $mac is not using LVM, unable to backup active image\n";
|
|
425
|
return "node is is not using LVM, unable to backup active image.";
|
|
426
|
} elsif ($nodereg{$mac}->{'status'} =~ /asleep|inactive/ && !$wake) {
|
|
427
|
$postreply .= "Status=Error Node $mac is asleep, not waking\n";
|
|
428
|
return "node is asleep, please wake first!";
|
|
429
|
} else {
|
|
430
|
my $tasks = $nodereg{$mac}->{'tasks'};
|
|
431
|
$nodereg{$mac}->{'tasks'} = $tasks . "$newtask\n";
|
|
432
|
tied(%nodereg)->commit;
|
|
433
|
}
|
|
434
|
untie %nodereg;
|
|
435
|
return 0;
|
|
436
|
}
|
|
437
|
|
|
438
|
sub Recurse {
|
|
439
|
my($path) = shift; # @_;
|
|
440
|
my @files;
|
|
441
|
## append a trailing / if it's not there
|
|
442
|
$path .= '/' if($path !~ /\/$/);
|
|
443
|
## loop through the files contained in the directory
|
|
444
|
for my $eachFile (bsd_glob($path.'*')) {
|
|
445
|
next if ($eachFile =~ /\/fuel$/);
|
|
446
|
## if the file is a directory
|
|
447
|
if( -d $eachFile) {
|
|
448
|
## pass the directory to the routine ( recursion )
|
|
449
|
push(@files,Recurse($eachFile));
|
|
450
|
} else {
|
|
451
|
push(@files,$eachFile);
|
|
452
|
}
|
|
453
|
}
|
|
454
|
return @files;
|
|
455
|
}
|
|
456
|
|
|
457
|
# If used with the -f switch ($fulllist) from console, all users images are updated in the db
|
|
458
|
# If used with the -p switch ($fullupdate), also updates status information (ressource intensive - runs through all domains)
|
|
459
|
sub Updateregister {
|
|
460
|
my ($spath, $action) = @_;
|
|
461
|
if ($help) {
|
|
462
|
return <<END
|
|
463
|
GET:image,uuid:
|
|
464
|
If used with the -f switch ($fulllist) from console, all users images are updated in the db.
|
|
465
|
If used with the -p switch ($fullupdate), also updates status information (ressource intensive - runs through all domains)
|
|
466
|
Only images on shared storage are updated, images on node storage are handled on the node.
|
|
467
|
END
|
|
468
|
}
|
|
469
|
return "Status=ERROR You must be an admin to do this!\n" unless ($isadmin);
|
|
470
|
$fullupdate = 1 if ((!$fullupdate && $params{'fullupdate'}) || $action eq 'fullupdateregister');
|
|
471
|
my $force = $params{'force'};
|
|
472
|
my %userregister;
|
|
473
|
my $res;
|
|
474
|
# Update size information in db
|
|
475
|
foreach my $u (@users) {
|
|
476
|
foreach my $spool (@spools) {
|
|
477
|
my $pooldir = $spool->{"path"};
|
|
478
|
my $dir = "$pooldir/$u";
|
|
479
|
my @thefiles = Recurse($dir);
|
|
480
|
foreach my $f (@thefiles) {
|
|
481
|
next if ($spath && $spath ne $f); # Only specific image being updated
|
|
482
|
if ($f =~ /(.+)(-s\d\d\d\.vmdk$)/) {
|
|
483
|
# `touch "$1.vmdk" 2>/dev/null` unless -e "$1.vmdk";
|
|
484
|
} elsif ($f =~ /(.+)(-flat\.vmdk$)/) {
|
|
485
|
# `touch "$1.vmdk" 2>/dev/null` unless -e "$1.vmdk";
|
|
486
|
} elsif(-s $f && $f =~ /(\.vmdk$)|(\.img$)|(\.vhd$)|(\.vhdx$)|(\.qcow$)|(\.qcow2$)|(\.vdi$)|(\.iso$)/i) {
|
|
487
|
my($fname, $dirpath, $suffix) = fileparse($f, ("vmdk", "img", "vhd", "vhdx", "qcow", "qcow2", "vdi", "iso"));
|
|
488
|
my $uuid;
|
|
489
|
my $img = $register{$f};
|
|
490
|
$uuid = $img->{'uuid'};
|
|
491
|
# Create a new uuid if we are dealing with a new file in the file-system
|
|
492
|
if (!$uuid) {
|
|
493
|
my $ug = new Data::UUID;
|
|
494
|
$uuid = $ug->create_str();
|
|
495
|
}
|
|
496
|
my $storagepool = $spool->{"id"};
|
|
497
|
# Deal with sizes
|
|
498
|
my ($newmtime, $newbackupsize, $newsize, $newrealsize, $newvirtualsize) =
|
|
499
|
getSizes($f, $img->{'mtime'}, $img->{'status'}, $u, $force);
|
|
500
|
my $size = $newsize || $img->{'size'};
|
|
501
|
my $realsize = $newrealsize || $img->{'realsize'};
|
|
502
|
my $virtualsize = $newvirtualsize || $img->{'virtualsize'};
|
|
503
|
my $mtime = $newmtime || $img->{'mtime'};
|
|
504
|
my $created = $img->{'created'} || $mtime;
|
|
505
|
my $name = $img->{'name'} || substr($fname,0,-1);
|
|
506
|
$register{$f} = {
|
|
507
|
path=>$f,
|
|
508
|
user=>$u,
|
|
509
|
type=>$suffix,
|
|
510
|
size=>$size,
|
|
511
|
realsize=>$realsize,
|
|
512
|
virtualsize=>$virtualsize,
|
|
513
|
backupsize=>$newbackupsize,
|
|
514
|
name=>$name,
|
|
515
|
uuid=>$uuid,
|
|
516
|
# domains=>$domains,
|
|
517
|
# domainnames=>$domainnames,
|
|
518
|
storagepool=>$storagepool,
|
|
519
|
backup=>"", # Only set in uservalues at runtime
|
|
520
|
created=>$created,
|
|
521
|
mtime=>$mtime
|
|
522
|
};
|
|
523
|
# $postreply .= "Status=OK $f, $size, $newbackupsize\n" if ($console);
|
|
524
|
}
|
|
525
|
}
|
|
526
|
}
|
|
527
|
}
|
|
528
|
# Update status information in db
|
|
529
|
# my $mounts = decode('ascii-escape', `/bin/cat /proc/mounts`);
|
|
530
|
my $mounts = `/bin/cat /proc/mounts`;
|
|
531
|
unless ( tie(%nodereg,'Tie::DBI', Hash::Merge::merge({table=>'nodes', key=>'mac', CLOBBER=>1}, $Stabile::dbopts)) ) {return 0};
|
|
532
|
foreach my $u (@users) {
|
|
533
|
my @regkeys = (tied %register)->select_where("user = '$u'");
|
|
534
|
foreach my $k (@regkeys) {
|
|
535
|
my $valref = $register{$k};
|
|
536
|
my $path = $valref->{'path'};
|
|
537
|
# Only update info for images the user has access to.
|
|
538
|
# Remove DB entries for images on removed nodes
|
|
539
|
if ($valref->{'storagepool'}==-1 && $valref->{'mac'} && $valref->{'mac'} ne '--' && !$nodereg{$valref->{'mac'}}) {
|
|
540
|
delete $register{$path}; # Clean up database, remove rows which don't have corresponding file
|
|
541
|
$main::updateUI->({tab=>'images', user=>$u}) unless ($u eq 'common');
|
|
542
|
} elsif ($valref->{'user'} eq $u && (defined $spools[$valref->{'storagepool'}]->{'id'} || $valref->{'storagepool'}==-1)) {
|
|
543
|
my $path = $valref->{'path'};
|
|
544
|
next if ($spath && $spath ne $path); # Only specific image being updated
|
|
545
|
my $mounted = ($mounts =~ /$path/);
|
|
546
|
my $domains;
|
|
547
|
my $domainnames;
|
|
548
|
my $regstatus = $valref->{'status'};
|
|
549
|
my $status = $regstatus;
|
|
550
|
if (!$status || $status eq '--') {
|
|
551
|
$status = 'unused';
|
|
552
|
}
|
|
553
|
if (-e $path || $valref->{'storagepool'}==-1 || -s "$path.meta") {
|
|
554
|
# Deal with status
|
|
555
|
if ($valref->{'storagepool'}!=-1 && -s "$path.meta") {
|
|
556
|
my $metastatus;
|
|
557
|
$metastatus = `/bin/cat "$path.meta" 2>/dev/null`;
|
|
558
|
chomp $metastatus;
|
|
559
|
|
|
560
|
if ($metastatus =~ /status=(.+)&chunk=/) {
|
|
561
|
$status = $1;
|
|
562
|
} elsif ($metastatus =~ /status=(.+)&path2:(.+)=(.+)/) {
|
|
563
|
# A move operation has been completed - update status of both involved
|
|
564
|
$status = $1;
|
|
565
|
$register{$2}->{'status'} = $3;
|
|
566
|
unless ($userregister{$2}) { # If we have not yet parsed image, it is not yet in userregister, so put it there
|
|
567
|
my %mval = %{$register{$2}};
|
|
568
|
$userregister{$2} = \%mval;
|
|
569
|
}
|
|
570
|
$userregister{$2}->{'status'} = $3;
|
|
571
|
} elsif ($metastatus =~ /status=(\w+)/) {
|
|
572
|
$status = $1;
|
|
573
|
} else {
|
|
574
|
# $status = $metastatus; # Do nothing - this meta file contains no status info
|
|
575
|
}
|
|
576
|
} elsif (
|
|
577
|
$status eq "restoring"
|
|
578
|
|| $status eq "frestoring"
|
|
579
|
|| ($status eq "mounted" && $mounted)
|
|
580
|
|| $status eq "snapshotting"
|
|
581
|
|| $status eq "unsnapping"
|
|
582
|
|| $status eq "reverting"
|
|
583
|
|| $status eq "moving"
|
|
584
|
|| $status eq "converting"
|
|
585
|
|| $status eq "cloning"
|
|
586
|
|| $status eq "copying"
|
|
587
|
|| $status eq "rebasing"
|
|
588
|
|| $status eq "creating"
|
|
589
|
|| $status eq "resizing"
|
|
590
|
) { # When operation is done, status is updated by piston.cgi
|
|
591
|
; # Do nothing
|
|
592
|
} elsif ($status =~ /.(backingup)/) { # When backup is done, status is updated by steamExec
|
|
593
|
if ($valref->{'storagepool'}==-1) {
|
|
594
|
# unless ( tie(%nodereg,'Tie::DBI', Hash::Merge::merge({table=>'nodes', key=>'mac', CLOBBER=>1}, $Stabile::dbopts)) ) {return 0};
|
|
595
|
if ($nodereg{$valref->{'mac'}}) {
|
|
596
|
my $nodestatus = $nodereg{$valref->{'mac'}}->{status};
|
|
597
|
# If node is not available, it cannot be backing up...
|
|
598
|
if ($nodestatus eq 'inactive'
|
|
599
|
|| $nodestatus eq 'asleep'
|
|
600
|
|| $nodestatus eq 'shutoff'
|
|
601
|
) {
|
|
602
|
$valref->{'status'} = 'unused'; # Make sure we don't end here again in endless loop
|
|
603
|
$rstatus = Updateregister(0, $path);
|
|
604
|
$status = $rstatus if ($rstatus);
|
|
605
|
$main::syslogit->($user, 'info', "Updated image status for aborted backup - $user, $path, $rstatus");
|
|
606
|
}
|
|
607
|
}
|
|
608
|
#untie %nodereg;
|
|
609
|
}
|
|
610
|
|
|
611
|
} elsif ($status eq 'uploading') {
|
|
612
|
$status = 'unused' unless (-s "$path.meta");
|
|
613
|
|
|
614
|
} elsif (!$status || $status eq 'unused' || $status eq 'active') {
|
|
615
|
if ($fullupdate) {
|
|
616
|
$status = "unused";
|
|
617
|
my @domregkeys;
|
|
618
|
if ($fulllist) {@domregkeys = keys %domreg;}
|
|
619
|
else {@domregkeys = (tied %domreg)->select_where("user = '$u'");}
|
|
620
|
foreach my $domkey (@domregkeys) {
|
|
621
|
my $dom = $domreg{$domkey};
|
|
622
|
my $img = $dom->{'image'};
|
|
623
|
my $img2 = $dom->{'image2'};
|
|
624
|
my $img3 = $dom->{'image3'};
|
|
625
|
my $img4 = $dom->{'image4'};
|
|
626
|
if ($path eq $img || $path eq $img2 || $path eq $img3 || $path eq $img4) {
|
|
627
|
$status = "active";
|
|
628
|
my $domstatus = $dom->{'status'};
|
|
629
|
if ($domstatus eq "shutoff" || $domstatus eq "inactive") {$status = "used";}
|
|
630
|
elsif ($domstatus eq "paused") {$status = "paused";}
|
|
631
|
$domains = $dom->{'uuid'};
|
|
632
|
$domainnames = $dom->{'name'};
|
|
633
|
};
|
|
634
|
}
|
|
635
|
$valref->{'domains'} = $domains ;
|
|
636
|
$valref->{'domainnames'} = $domainnames ;
|
|
637
|
} elsif ($valref->{'domains'} && $valref->{'domains'} ne '--'){
|
|
638
|
my $dom = $domreg{$valref->{'domains'}};
|
|
639
|
if ($dom) {
|
|
640
|
my $img = $dom->{'image'};
|
|
641
|
my $img2 = $dom->{'image2'};
|
|
642
|
my $img3 = $dom->{'image3'};
|
|
643
|
my $img4 = $dom->{'image4'};
|
|
644
|
if ($path eq $img || $path eq $img2 || $path eq $img3 || $path eq $img4) {
|
|
645
|
$status = "active";
|
|
646
|
my $domstatus = $dom->{'status'};
|
|
647
|
if ($domstatus eq "shutoff" || $domstatus eq "inactive") {$status = "used";}
|
|
648
|
elsif ($domstatus eq "paused") {$status = "paused";}
|
|
649
|
$valref->{'domainnames'} = $dom->{'name'};
|
|
650
|
};
|
|
651
|
};
|
|
652
|
}
|
|
653
|
}
|
|
654
|
# Update info in db
|
|
655
|
$valref->{'status'} = $status ;
|
|
656
|
$res .= $status if ($spath);
|
|
657
|
} else {
|
|
658
|
delete $register{$path}; # Clean up database, remove rows which don't have corresponding file
|
|
659
|
$main::updateUI->({tab=>'images', user=>$u}) unless ($u eq 'common');
|
|
660
|
}
|
|
661
|
}
|
|
662
|
}
|
|
663
|
}
|
|
664
|
untie %nodereg;
|
|
665
|
tied(%register)->commit;
|
|
666
|
$res .= "Status=OK Updated image register for " . join(', ', @users) . "\n";
|
|
667
|
$res .= $postreply;
|
|
668
|
return $res if ($res);
|
|
669
|
}
|
|
670
|
|
|
671
|
sub getVirtualSize {
|
|
672
|
my $vpath = shift;
|
|
673
|
my $macip = shift;
|
|
674
|
my $qinfo;
|
|
675
|
my($bname, $dirpath, $suffix) = fileparse($vpath, (".vmdk", ".img", ".vhd", ".vhdx", ".qcow", ".qcow2", ".vdi", ".iso"));
|
|
676
|
if ($suffix eq ".qcow2") {
|
|
677
|
if ($macip) {
|
|
678
|
$qinfo = `$sshcmd $macip /usr/bin/qemu-img info --force-share "$vpath"`;
|
|
679
|
} else {
|
|
680
|
$qinfo = `/usr/bin/qemu-img info --force-share "$vpath"`;
|
|
681
|
}
|
|
682
|
$qinfo =~ /virtual size:.*\((.+) bytes\)/g;
|
|
683
|
return(int($1)); # report size of new image for billing purposes
|
|
684
|
} elsif ($status eq ".vdi") {
|
|
685
|
if ($macip) {
|
|
686
|
$qinfo = `$sshcmd $macip /usr/bin/VBoxManage showhdinfo "$vpath"`;
|
|
687
|
} else {
|
|
688
|
$qinfo = `/usr/bin/VBoxManage showhdinfo "$vpath"`;
|
|
689
|
}
|
|
690
|
$qinfo =~ /Logical size:\s*(\d+) MBytes/g;
|
|
691
|
return(int($1) * 1024 * 1024); # report size of new image for billing purposes
|
|
692
|
} else {
|
|
693
|
if ($macip) {
|
|
694
|
return `$sshcmd $macip perl -e 'my @stat=stat("$vpath"); print $stat[7];'`;
|
|
695
|
} else {
|
|
696
|
my @stat = stat($vpath);
|
|
697
|
return($stat[7]); # report size of new image for billing purposes
|
|
698
|
}
|
|
699
|
}
|
|
700
|
}
|
|
701
|
|
|
702
|
sub getSizes {
|
|
703
|
my ($f, $lmtime, $status, $buser, $force) = @_;
|
|
704
|
|
|
705
|
my @stat = stat($f);
|
|
706
|
my $size = $stat[7];
|
|
707
|
my $realsize = $stat[12] * 512;
|
|
708
|
my $virtualsize = $size;
|
|
709
|
my $backupsize = 0;
|
|
710
|
my $mtime = $stat[9];
|
|
711
|
my($fname, $dirpath, $suffix) = fileparse($f, ("vmdk", "img", "vhd", "vhdx", "qcow", "qcow2", "vdi", "iso"));
|
|
712
|
my $subdir = "";
|
|
713
|
if ($dirpath =~ /.+\/$buser(\/.+)?\//) {
|
|
714
|
$subdir = $1;
|
|
715
|
}
|
|
716
|
$backupsize = getBackupSize($subdir, "$fname$suffix", $buser);
|
|
717
|
my $ps = `/bin/ps ax`;
|
|
718
|
|
|
719
|
# Only fire up qemu-img etc. if image has been modified and is not being used
|
|
720
|
if ((
|
|
721
|
($mtime - $lmtime)>300 &&
|
|
722
|
($status ne 'active' && $status ne 'downloading') &&
|
|
723
|
!($ps =~ /$f/)) || $force
|
|
724
|
) {
|
|
725
|
|
|
726
|
# Special handling of vmdk's
|
|
727
|
if ($suffix eq "vmdk") {
|
|
728
|
my $qinfo = `/usr/bin/qemu-img info --force-share "$f"`;
|
|
729
|
$qinfo =~ /virtual size:.*\((.+) bytes\)/g;
|
|
730
|
$virtualsize = int($1);
|
|
731
|
if ( -s ($dirpath . substr($fname,0,-1) . "-flat." . $suffix)) {
|
|
732
|
my @fstatus = stat($dirpath . substr($fname,0,-1) . "-flat." . $suffix);
|
|
733
|
my $fsize = $fstatus[7];
|
|
734
|
my $frealsize = $fstatus[12] * 512;
|
|
735
|
$size += $fsize;
|
|
736
|
$virtualsize += $fsize;
|
|
737
|
$realsize += $frealsize;
|
|
738
|
} else {
|
|
739
|
# $main::syslogit->($user, "info", "VMDK " . $dirpath . substr($fname,0,-1) . "-flat." . $suffix . " does not exist");
|
|
740
|
}
|
|
741
|
my $i = 1;
|
|
742
|
while (@fstatus = stat($dirpath . substr($fname,0,-1) . "-s00$i." . $suffix)) {
|
|
743
|
my $fsize = $fstatus[7];
|
|
744
|
my $frealsize = $fstatus[12] * 512;
|
|
745
|
$size += $fsize;
|
|
746
|
#$virtualsize += $fsize;
|
|
747
|
$realsize += $frealsize;
|
|
748
|
|
|
749
|
my $cmdpath = $dirpath . substr($fname,0,-1) . "-s00$i." . $suffix;
|
|
750
|
my $qinfo = `/usr/bin/qemu-img info --force-share "$cmdpath"`;
|
|
751
|
$qinfo =~ /virtual size:.*\((.+) bytes\)/g;
|
|
752
|
$virtualsize += int($1);
|
|
753
|
|
|
754
|
$i++;
|
|
755
|
}
|
|
756
|
# Get virtual size of qcow2 auto-grow volumes
|
|
757
|
} elsif ($suffix eq "qcow2") {
|
|
758
|
my $qinfo = `/usr/bin/qemu-img info --force-share "$f"`;
|
|
759
|
$qinfo =~ /virtual size:.*\((.+) bytes\)/g;
|
|
760
|
$virtualsize = int($1);
|
|
761
|
# Get virtual size of vdi auto-grow volumes
|
|
762
|
} elsif ($suffix eq "vdi") {
|
|
763
|
my $qinfo = `/usr/bin/VBoxManage showhdinfo "$f"`;
|
|
764
|
$qinfo =~ /Logical size:\s*(\d+) MBytes/g;
|
|
765
|
$virtualsize = int($1) * 1024 * 1024;
|
|
766
|
}
|
|
767
|
# Actual used blocks times block size on disk, i.e. $realsize may be bigger than the
|
|
768
|
# logical size of the image file $size and the logical provisioned size of the disk $virtualsize
|
|
769
|
# in order to minimize confusion, we set $realsize to $size if this is the case
|
|
770
|
$realsize = $size if ($realsize > $size);
|
|
771
|
|
|
772
|
return ($mtime, $backupsize, $size, $realsize, $virtualsize);
|
|
773
|
} else {
|
|
774
|
return (0, $backupsize, $size, $realsize);
|
|
775
|
}
|
|
776
|
|
|
777
|
}
|
|
778
|
|
|
779
|
sub getHypervisor {
|
|
780
|
my $image = shift;
|
|
781
|
# Produce a mapping of image file suffixes to hypervisors
|
|
782
|
my %idreg;
|
|
783
|
unless ( tie(%idreg,'Tie::DBI', Hash::Merge::merge({table=>'nodeidentities', key=>'identity'}, $Stabile::dbopts)) )
|
|
784
|
{$postreply .= "Status=Error identity register could not be accessed"};
|
|
785
|
|
|
786
|
my @idvalues = values %idreg;
|
|
787
|
my %formats;
|
|
788
|
foreach my $val (@idvalues) {
|
|
789
|
my %h = %$val;
|
|
790
|
foreach (split(/,/,$h{'formats'})) {
|
|
791
|
$formats{lc $_} = $h{'hypervisor'}
|
|
792
|
}
|
|
793
|
}
|
|
794
|
untie %idreg;
|
|
795
|
|
|
796
|
# and then determine the hypervisor in question
|
|
797
|
my $hypervisor = "vbox";
|
|
798
|
my ($pathname, $path, $suffix) = fileparse($image, '\.[^\.]*');
|
|
799
|
$suffix = substr $suffix, 1;
|
|
800
|
my $hypervisor = $formats{lc $suffix};
|
|
801
|
return $hypervisor;
|
|
802
|
}
|
|
803
|
|
|
804
|
sub Getserverbackups {
|
|
805
|
my ($domuuid, $action) = @_;
|
|
806
|
if ($help) {
|
|
807
|
return <<END
|
|
808
|
GET:uuid:
|
|
809
|
Lists the image backups associated with a server, i.e. the backups of all the images attached to a server.
|
|
810
|
A server UUID should be passed as parameter. A JSON object is returned. May be called as <b>getserverbackups</b>, in
|
|
811
|
which case a JSON object is returned, or as <b>listserverbackups</b>, in which case a string is returned.
|
|
812
|
END
|
|
813
|
}
|
|
814
|
my $res;
|
|
815
|
my @sbackups;
|
|
816
|
my $backuplist;
|
|
817
|
|
|
818
|
if ($domreg{$domuuid} && (($domreg{$domuuid}->{'user'} eq $user) || $isadmin)) {
|
|
819
|
push @sbackups, Listbackups($domreg{$domuuid}->{'image'}, 'getbackups');
|
|
820
|
push @sbackups, Listbackups($domreg{$domuuid}->{'image2'}, 'getbackups') if ($domreg{$domuuid}->{'image2'} && $domreg{$domuuid}->{'image2'} ne '--');
|
|
821
|
push @sbackups, Listbackups($domreg{$domuuid}->{'image3'}, 'getbackups') if ($domreg{$domuuid}->{'image3'} && $domreg{$domuuid}->{'image3'} ne '--');
|
|
822
|
push @sbackups, Listbackups($domreg{$domuuid}->{'image4'}, 'getbackups') if ($domreg{$domuuid}->{'image4'} && $domreg{$domuuid}->{'image4'} ne '--');
|
|
823
|
}
|
|
824
|
foreach my $sbackup (@sbackups) {
|
|
825
|
my @back = @{$sbackup};
|
|
826
|
my $t = $back[0]->{time};
|
|
827
|
my $epoch;
|
|
828
|
my $z;
|
|
829
|
if ($t eq '--') {
|
|
830
|
$epoch = $t;
|
|
831
|
} elsif ($t =~ /(z)/) {
|
|
832
|
# my $time = Time::Piece->strptime($t, "%Y-%m-%d-%H-%M-%S (z)");
|
|
833
|
my $time = Time::Piece->strptime($t, "%b %d %T %Y (z)");
|
|
834
|
$epoch = $time->epoch;
|
|
835
|
$z = ' (z)';
|
|
836
|
} else {
|
|
837
|
$t = $1 if ($t =~ /\* (.*)/);
|
|
838
|
my $time = Time::Piece->strptime($t, "%b %d %T %Y");
|
|
839
|
$epoch = $time->epoch;
|
|
840
|
}
|
|
841
|
$backuplist .= "$back[-1]->{name}$z/$epoch, " if (@back && $epoch);
|
|
842
|
}
|
|
843
|
$backuplist = substr($backuplist,0,-2);
|
|
844
|
|
|
845
|
if ($action eq 'getserverbackups') {
|
|
846
|
$res .= to_json(\@sbackups, {pretty=>1});
|
|
847
|
} else {
|
|
848
|
$res .= header() unless ($console);
|
|
849
|
$res .= $backuplist;
|
|
850
|
}
|
|
851
|
return $res;
|
|
852
|
|
|
853
|
}
|
|
854
|
|
|
855
|
sub Listbackups {
|
|
856
|
my ($curimg, $action) = @_;
|
|
857
|
if ($help) {
|
|
858
|
return <<END
|
|
859
|
GET:image:
|
|
860
|
List backups on file for the give image, which may be specified as path or uuid.
|
|
861
|
END
|
|
862
|
}
|
|
863
|
|
|
864
|
my $res;
|
|
865
|
my $buser = $user;
|
|
866
|
$curimg = '' unless ($register{$curimg}); # Image must exist
|
|
867
|
$buser = $register{$curimg}->{'user'} if ($isadmin && $curimg);
|
|
868
|
my @backups;
|
|
869
|
my $subdir = "";
|
|
870
|
if ($curimg && $curimg ne '--') {
|
|
871
|
my($bname, $dirpath) = fileparse($curimg);
|
|
872
|
if ($dirpath =~ /.+\/$buser(\/.+)?\//) {
|
|
873
|
$subdir = $1;
|
|
874
|
}
|
|
875
|
my $sbname = "$subdir/$bname";
|
|
876
|
$sbname =~ s/ /\\ /g;
|
|
877
|
$sbname = $1 if ($sbname =~ /(.+)/); # untaint
|
|
878
|
foreach my $spool (@spools) {
|
|
879
|
my $imgbasedir = $spool->{"path"};
|
|
880
|
if (-d "$imgbasedir/.zfs/snapshot") {
|
|
881
|
my $snaps = `/bin/ls -l --time-style=full-iso $imgbasedir/.zfs/snapshot/*/$buser$sbname 2> /dev/null`;
|
|
882
|
my @snaplines = split("\n", $snaps);
|
|
883
|
# -rw-r--r-- 1 root root 216174592 2012-02-19 17:51 /mnt/stabile/images/.zfs/snapshot/SNAPSHOT-20120106002116/cabo/Outlook2007.iso
|
|
884
|
foreach $line (@snaplines) {
|
|
885
|
if ($line =~ /$imgbasedir\/.zfs\/snapshot\/SNAPSHOT-(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})\/$buser$subdir\/$bname$/) {
|
|
886
|
my $timestamp = timelocal($6,$5,$4,$3,$2-1,$1); #$sec,$min,$hour,$mday,$mon,$year
|
|
887
|
my $t = localtime($timestamp)->strftime("%b %e %H:%M:%S %Y");
|
|
888
|
# my %incr = ("increment", "SNAPSHOT-$1$2$3$4$5$6", "time", "$1-$2-$3-$4-$5-$6 (z)", "pool", $imgbasedir);
|
|
889
|
my %incr = ("increment", "SNAPSHOT-$1$2$3$4$5$6", "time", "$t (z)", "pool", $imgbasedir);
|
|
890
|
unshift (@backups, \%incr);
|
|
891
|
};
|
|
892
|
}
|
|
893
|
}
|
|
894
|
}
|
|
895
|
# Also include ZFS snapshots transferred from nodes
|
|
896
|
$imgbasedir = "/stabile-backup";
|
|
897
|
my $snaps = `/bin/ls -l --time-style=full-iso $imgbasedir/node-*/.zfs/snapshot/*/$buser$sbname 2> /dev/null`;
|
|
898
|
my @snaplines = split("\n", $snaps);
|
|
899
|
foreach $line (@snaplines) {
|
|
900
|
if ($line =~ /($imgbasedir\/node-.+)\/.zfs\/snapshot\/SNAPSHOT-(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})\/$buser$subdir\/$bname$/) {
|
|
901
|
my $timestamp = timelocal($7,$6,$5,$4,$3-1,$2); #$sec,$min,$hour,$mday,$mon,$year
|
|
902
|
my $t = localtime($timestamp)->strftime("%b %e %H:%M:%S %Y");
|
|
903
|
# my %incr = ("increment", "SNAPSHOT-$2$3$4$5$6$7", "time", "$2-$3-$4-$5-$6-$7 (z)", "pool", $1);
|
|
904
|
my %incr = ("increment", "SNAPSHOT-$2$3$4$5$6$7", "time", "$t (z)", "pool", $1);
|
|
905
|
unshift (@backups, \%incr);
|
|
906
|
};
|
|
907
|
}
|
|
908
|
my $bpath = "$backupdir/$buser$subdir/$bname";
|
|
909
|
$bpath = $1 if ($bpath =~ /(.+)/); # untaint
|
|
910
|
if (-d "$bpath") {
|
|
911
|
my $rdiffs = `/usr/bin/rdiff-backup -l "$bpath"`;
|
|
912
|
my @mlines = split("\n", $rdiffs);
|
|
913
|
my $curmirror;
|
|
914
|
foreach my $line (@mlines) {
|
|
915
|
if ($line =~ /\s+increments\.(\S+)\.dir\s+\S\S\S (.+)$/) {
|
|
916
|
my %incr = ("increment", $1, "time", $2);
|
|
917
|
if (-e "$bpath/rdiff-backup-data/increments/$bname.$1.diff.gz"
|
|
918
|
) {
|
|
919
|
unshift (@backups, \%incr);
|
|
920
|
}
|
|
921
|
};
|
|
922
|
if ($line =~ /Current mirror: \S\S\S (.+)$/) {
|
|
923
|
$curmirror = $1;
|
|
924
|
};
|
|
925
|
}
|
|
926
|
if ($curmirror) {
|
|
927
|
my %incr = ("increment", "mirror", "time", "* $curmirror");
|
|
928
|
unshift @backups, \%incr;
|
|
929
|
}
|
|
930
|
my %incr = ("increment", "--", "time", "--", "name", $bname);
|
|
931
|
push @backups, \%incr;
|
|
932
|
} else {
|
|
933
|
my %incr = ("increment", "--", "time", "--", "name", $bname);
|
|
934
|
push @backups, \%incr;
|
|
935
|
}
|
|
936
|
}
|
|
937
|
|
|
938
|
if ($action eq 'getbackups') {
|
|
939
|
return \@backups;
|
|
940
|
} elsif ($console) {
|
|
941
|
my $t2 = Text::SimpleTable->new(28,28);
|
|
942
|
$t2->row('increment', 'time');
|
|
943
|
$t2->hr;
|
|
944
|
foreach my $fref (@backups) {
|
|
945
|
$t2->row($fref->{'increment'}, scalar localtime( $fref->{'time'} )) unless ($fref->{'increment'} eq '--');
|
|
946
|
}
|
|
947
|
return $t2->draw;
|
|
948
|
} else {
|
|
949
|
$res .= header('application/json');
|
|
950
|
my $json_text = to_json(\@backups, {pretty=>1});
|
|
951
|
$res .= qq|{"identifier": "increment", "label": "time", "items": $json_text }|;
|
|
952
|
return $res;
|
|
953
|
}
|
|
954
|
}
|
|
955
|
|
|
956
|
# Get the timestamp of latest backup of an image
|
|
957
|
sub getBtime {
|
|
958
|
my $curimg = shift;
|
|
959
|
my $buser = shift || $user;
|
|
960
|
return unless ($buser eq $user || $isadmin);
|
|
961
|
$buser = 'common' if ($register{$curimg}->{user} eq 'common' && $isadmin);
|
|
962
|
my $subdir = "";
|
|
963
|
my $lastbtimestamp;
|
|
964
|
my($bname, $dirpath) = fileparse($curimg);
|
|
965
|
if ($dirpath =~ /.+\/$buser(\/.+)?\//) {
|
|
966
|
$subdir = $1;
|
|
967
|
}
|
|
968
|
|
|
969
|
#require File::Spec;
|
|
970
|
#my $devnull = File::Spec->devnull();
|
|
971
|
|
|
972
|
foreach my $spool (@spools) {
|
|
973
|
my $imgbasedir = $spool->{"path"};
|
|
974
|
if (-d "$imgbasedir/.zfs/snapshot") {
|
|
975
|
my $sbname = "$subdir/$bname";
|
|
976
|
$sbname =~ s/ /\\ /g;
|
|
977
|
my $cmd = qq|/bin/ls -l --time-style=full-iso $imgbasedir/.zfs/snapshot/*/$buser$sbname 2>/dev/null|;
|
|
978
|
my $snaps = `$cmd`;
|
|
979
|
my @snaplines = split("\n", $snaps);
|
|
980
|
foreach $line (@snaplines) {
|
|
981
|
if ($line =~ /$imgbasedir\/.zfs\/snapshot\/SNAPSHOT-(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})\/$buser$subdir\/$bname$/) {
|
|
982
|
my $timestamp = timelocal($6,$5,$4,$3,$2-1,$1); #$sec,$min,$hour,$mday,$mon,$year
|
|
983
|
$lastbtimestamp = $timestamp if ($timestamp > $lastbtimestamp);
|
|
984
|
};
|
|
985
|
}
|
|
986
|
}
|
|
987
|
}
|
|
988
|
# Also include ZFS snapshots transferred from nodes
|
|
989
|
$imgbasedir = "/stabile-backup";
|
|
990
|
my $snaps = `/bin/ls -l --time-style=full-iso $imgbasedir/node-*/.zfs/snapshot/*/$buser/$bname 2> /dev/null`;
|
|
991
|
my @snaplines = split("\n", $snaps);
|
|
992
|
foreach $line (@snaplines) {
|
|
993
|
if ($line =~ /$imgbasedir\/node-.+\/.zfs\/snapshot\/SNAPSHOT-(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})\/$buser$subdir\/$bname$/) {
|
|
994
|
my $timestamp = timelocal($6,$5,$4,$3,$2-1,$1); #$sec,$min,$hour,$mday,$mon,$year
|
|
995
|
$lastbtimestamp = $timestamp if ($timestamp > $lastbtimestamp);
|
|
996
|
};
|
|
997
|
}
|
|
998
|
my $bpath = "$backupdir/$buser$subdir/$bname";
|
|
999
|
$bpath = $1 if ($bpath =~ /(.+)/);
|
|
1000
|
if (-d "$bpath") {
|
|
1001
|
my $rdiffs = `/usr/bin/rdiff-backup --parsable-output -l "$bpath"`;
|
|
1002
|
my @mlines = split("\n", $rdiffs);
|
|
1003
|
foreach my $line (@mlines) {
|
|
1004
|
if ($line =~ /(\d+) (\S+)$/) {
|
|
1005
|
my $timestamp = $1;
|
|
1006
|
$lastbtimestamp = $timestamp if ($timestamp > $lastbtimestamp);
|
|
1007
|
};
|
|
1008
|
}
|
|
1009
|
}
|
|
1010
|
return $lastbtimestamp;
|
|
1011
|
}
|
|
1012
|
|
|
1013
|
sub Unmount {
|
|
1014
|
my $path = shift;
|
|
1015
|
my $action = shift;
|
|
1016
|
if ($help) {
|
|
1017
|
return <<END
|
|
1018
|
GET:image: Unmounts a previously mounted image.
|
|
1019
|
END
|
|
1020
|
}
|
|
1021
|
my($bname, $dirpath, $suffix) = fileparse($path, (".vmdk", ".img", ".vhd", ".vhdx", ".qcow", ".qcow2", ".vdi", ".iso"));
|
|
1022
|
my $mountpath = "$dirpath.$bname$suffix";
|
|
1023
|
# my $mounts = decode('ascii-escape', `/bin/cat /proc/mounts`);
|
|
1024
|
my $mounts = `/bin/cat /proc/mounts`;
|
|
1025
|
my $mounted = ($mounts =~ /$mountpath/);
|
|
1026
|
|
|
1027
|
# eval {`/bin/umount "$mountpath"` if ($mounted); 1;}
|
|
1028
|
# eval {`/bin/fusermount -u "$mountpath"` if ($mounted); 1;}
|
|
1029
|
# or do {$postreply .= "Status=ERROR Problem mounting image $@\n";};
|
|
1030
|
|
|
1031
|
if ($mounted) {
|
|
1032
|
$cmd = qq|/bin/fusermount -u "$mountpath" 2>&1|;
|
|
1033
|
my $mes = qx($cmd);
|
|
1034
|
my $xc = $? >> 8;
|
|
1035
|
$main::syslogit->($user, 'info', "Unmounted $curimg $xc");
|
|
1036
|
if ($xc) {
|
|
1037
|
$postreply .= "Status=ERROR Problem unmounting image ($mes). ";
|
|
1038
|
return $postreply;
|
|
1039
|
}
|
|
1040
|
}
|
|
1041
|
# my $mounts2 = decode('ascii-escape', `/bin/cat /proc/mounts`);
|
|
1042
|
my $mounts2 = `/bin/cat /proc/mounts`;
|
|
1043
|
$mounts2 = String::Escape::unbackslash($mounts2);
|
|
1044
|
my $mounted2 = ($mounts2 =~ /$mountpath/);
|
|
1045
|
eval {`/bin/rmdir "$mountpath"` if (!$mounted2 && -e $mountpath); 1;}
|
|
1046
|
or do {$postreply .= "Status=ERROR Problem removing mount point $@\n";};
|
|
1047
|
|
|
1048
|
if ($mounted) {
|
|
1049
|
if ($mounted2) {
|
|
1050
|
$postreply .= "Status=ERROR Unable to unmount $register{$path}->{'name'}\n";
|
|
1051
|
return $postreply;
|
|
1052
|
} else {
|
|
1053
|
$postreply .= "Status=OK Unmounted image $register{$path}->{'name'}\n";
|
|
1054
|
return $postreply;
|
|
1055
|
}
|
|
1056
|
} else {
|
|
1057
|
$postreply .= "Status=OK Image $path not mounted\n";
|
|
1058
|
return $postreply;
|
|
1059
|
}
|
|
1060
|
}
|
|
1061
|
|
|
1062
|
sub unmountAll {
|
|
1063
|
my @mounts = split(/\n/, `/bin/cat /proc/mounts`);
|
|
1064
|
foreach my $mount (@mounts) {
|
|
1065
|
foreach my $spool (@spools) {
|
|
1066
|
my $pooldir = $spool->{"path"};
|
|
1067
|
if ($mount =~ /($pooldir\/$user\/\S+) / || ($mount =~ /($pooldir\/common\/\S+) / && $isadmin)) {
|
|
1068
|
# $mountpath = decode('ascii-escape', $1);
|
|
1069
|
$mountpath = $1;
|
|
1070
|
$rpath = $mountpath;
|
|
1071
|
$rpath =~ s/\/\./\//;
|
|
1072
|
my $processes = `/bin/ps`;
|
|
1073
|
# if ($register{$rpath} && !($processes =~ /steamExec.+$rpath/)) {
|
|
1074
|
$postreply .= "Status=OK Unmounting $rpath\n";
|
|
1075
|
Unmount($rpath);
|
|
1076
|
# }
|
|
1077
|
}
|
|
1078
|
}
|
|
1079
|
}
|
|
1080
|
return;
|
|
1081
|
}
|
|
1082
|
|
|
1083
|
sub Mount {
|
|
1084
|
my $path = shift;
|
|
1085
|
my $action = shift;
|
|
1086
|
if ($help) {
|
|
1087
|
return <<END
|
|
1088
|
GET:image:
|
|
1089
|
Tries to mount an image on admin server for listfiles/restorefiles operations.
|
|
1090
|
END
|
|
1091
|
}
|
|
1092
|
my($bname, $dirpath, $suffix) = fileparse($path, (".vmdk", ".img", ".vhd", ".vhdx", ".qcow", ".qcow2", ".vdi", ".iso"));
|
|
1093
|
my $mountpath = "$dirpath.$bname$suffix";
|
|
1094
|
my $mounts = `/bin/cat /proc/mounts`;
|
|
1095
|
$mounts = String::Escape::unbackslash($mounts);
|
|
1096
|
my $mounted = ($mounts =~ /$mountpath/);
|
|
1097
|
if ($mounted) {
|
|
1098
|
unless (`ls "$mountpath"`) { # Check if really mounted
|
|
1099
|
Unmount($mountpath);
|
|
1100
|
$mounted = 0;
|
|
1101
|
}
|
|
1102
|
}
|
|
1103
|
|
|
1104
|
if ($mounted) {
|
|
1105
|
$postreply .= "Status=OK Image $register{$path}->{'name'} already mounted\n";
|
|
1106
|
return $postreply;
|
|
1107
|
} else {
|
|
1108
|
`/bin/mkdir "$mountpath"` unless (-e "$mountpath");
|
|
1109
|
`/bin/chown www-data:www-data "$mountpath"`;
|
|
1110
|
my $cmd;
|
|
1111
|
|
|
1112
|
if (lc $suffix eq '.iso') {
|
|
1113
|
#eval {`/bin/mount -o allow_other,ro,loop "$path" "$mountpath"`; 1;}
|
|
1114
|
#eval {`/usr/bin/fuseiso -n "$path" "$mountpath" -o user=www-data`; 1;}
|
|
1115
|
eval {`/usr/bin/fuseiso -n "$path" "$mountpath" -o allow_other`; 1;}
|
|
1116
|
or do {
|
|
1117
|
$postreply .= header('text/html', '500 Internal Server Error') unless ($console);
|
|
1118
|
$postreply .= "Status=ERROR Problem mounting image $@\n";
|
|
1119
|
return $postreply;
|
|
1120
|
};
|
|
1121
|
} else {
|
|
1122
|
# First try to mount using autodiscover -i. If that fails, try to mount /dev/sda1
|
|
1123
|
$cmd = qq|/usr/bin/guestmount --ro -o allow_other -a "$path" "$mountpath" -i 2>&1|;
|
|
1124
|
my $mes = qx($cmd);
|
|
1125
|
my $xc = $? >> 8;
|
|
1126
|
$main::syslogit->($user, 'info', "Trying to mount $curimg $xc");
|
|
1127
|
if ($xc) {
|
|
1128
|
$cmd = qq|/usr/bin/guestmount --ro -o allow_other -a "$path" "$mountpath" -m /dev/sda1:/ 2>&1|;
|
|
1129
|
$mes = qx($cmd);
|
|
1130
|
$xc = $? >> 8;
|
|
1131
|
$main::syslogit->($user, 'info', "Trying to mount $curimg $xc");
|
|
1132
|
if ($xc) {
|
|
1133
|
$postreply = header('text/html', '500 Internal Server Error') . $postreply unless ($console);
|
|
1134
|
chomp $mes;
|
|
1135
|
$postreply .= "Status=Error Problem mounting image ($mes).\n$cmd\n";
|
|
1136
|
return $postreply;
|
|
1137
|
}
|
|
1138
|
}
|
|
1139
|
}
|
|
1140
|
|
|
1141
|
my $mounts2;
|
|
1142
|
for (my $i=0; $i<5; $i++) {
|
|
1143
|
$mounts2 = `/bin/cat /proc/mounts`;
|
|
1144
|
$mounts2 = String::Escape::unbackslash($mounts2);
|
|
1145
|
next if ( $mounts2 =~ /$mountpath/);
|
|
1146
|
sleep 2;
|
|
1147
|
}
|
|
1148
|
if ( $mounts2 =~ /$mountpath/) {
|
|
1149
|
$postreply .= "Status=OK Mounted image $register{$path}->{'name'}\n";
|
|
1150
|
return $postreply;
|
|
1151
|
} else {
|
|
1152
|
$postreply .= header('text/html', '500 Internal Server Error') unless ($console);
|
|
1153
|
$postreply .= "Status=ERROR Giving up mounting image $register{$path}->{'name'}\n";
|
|
1154
|
return $postreply;
|
|
1155
|
}
|
|
1156
|
}
|
|
1157
|
}
|
|
1158
|
|
|
1159
|
sub Updatebackingfile {
|
|
1160
|
my ($img, $action) = @_;
|
|
1161
|
if ($help) {
|
|
1162
|
return <<END
|
|
1163
|
GET:image:
|
|
1164
|
END
|
|
1165
|
}
|
|
1166
|
my $f = $img || $curimg;
|
|
1167
|
return "Status=Error Image $f not found\n" unless (-e $f);
|
|
1168
|
my $vinfo = `qemu-img info --force-share "$f"`;
|
|
1169
|
my $master = $1 if ($vinfo =~ /backing file: (.+)/);
|
|
1170
|
(my $fname, my $fdir) = fileparse($f);
|
|
1171
|
if (!$master) {
|
|
1172
|
$register{$f}->{'master'} = '';
|
|
1173
|
$postreply .= "Status=OK Image $f does not use a backing file\n";
|
|
1174
|
} elsif (-e $master){ # Master OK
|
|
1175
|
$register{$f}->{'master'} = $master;
|
|
1176
|
$postreply .= "Status=OK $master exists, no changes to $f.\n";
|
|
1177
|
} elsif (-e "$fdir/$master") { # Master OK
|
|
1178
|
$register{$f}->{'master'} = "$fdir/$master";
|
|
1179
|
$postreply .= "Status=OK $master exists in $fdir. No changes to $f.\n"
|
|
1180
|
} else {
|
|
1181
|
# Master not immediately found, look for it
|
|
1182
|
(my $master, my $mdir) = fileparse($master);
|
|
1183
|
my @busers = @users;
|
|
1184
|
push (@busers, $billto) if ($billto); # We include images from 'parent' user
|
|
1185
|
foreach my $u (@busers) {
|
|
1186
|
foreach my $spool (@spools) {
|
|
1187
|
my $pooldir = $spool->{"path"};
|
|
1188
|
my $masterpath = "$pooldir/$u/$master";
|
|
1189
|
if (-e $masterpath) {
|
|
1190
|
my $cmd = qq|qemu-img rebase -f qcow2 -u -b "$masterpath" "$f"|;
|
|
1191
|
$register{$f}->{'master'} = $masterpath;
|
|
1192
|
$postreply .= "Status=OK found $masterpath, rebasing from $mdir to $pooldir/$u ";
|
|
1193
|
$postreply .= `$cmd` . "\n";
|
|
1194
|
last;
|
|
1195
|
}
|
|
1196
|
}
|
|
1197
|
}
|
|
1198
|
$postreply .= "Status=Error $master not found in any user dir. You must provide this backing file to use this image.\n" unless ($postreply);
|
|
1199
|
}
|
|
1200
|
tied(%register)->commit;
|
|
1201
|
return $postreply;
|
|
1202
|
}
|
|
1203
|
|
|
1204
|
# List files in a mounted image. Mount image if not mounted.
|
|
1205
|
sub Listfiles {
|
|
1206
|
my ($curimg, $action, $obj) = @_;
|
|
1207
|
if ($help) {
|
|
1208
|
return <<END
|
|
1209
|
GET:image,path:
|
|
1210
|
Try to mount the file system on the given image, and list the files from the given path in the mounted file system.
|
|
1211
|
The image must contain a bootable file system, in order to locate a mount point.
|
|
1212
|
END
|
|
1213
|
}
|
|
1214
|
my $res;
|
|
1215
|
my $curpath = $obj->{'restorepath'};
|
|
1216
|
$res .= header('application/json') unless ($console);
|
|
1217
|
|
|
1218
|
my($bname, $dirpath, $suffix) = fileparse($curimg, (".vmdk", ".img", ".vhd", ".vhdx", ".qcow", ".qcow2", ".vdi", ".iso"));
|
|
1219
|
my $mountpath = "$dirpath.$bname$suffix";
|
|
1220
|
my @files;
|
|
1221
|
my @dirs;
|
|
1222
|
my $mounted = (Mount($curimg) =~ /\w=OK/);
|
|
1223
|
|
|
1224
|
if ($mounted) {
|
|
1225
|
my @patterns = ('');
|
|
1226
|
$curpath .= '/' unless ($curpath =~ /\/$/);
|
|
1227
|
$mountpath .= "$curpath";
|
|
1228
|
if (-d $mountpath) { # We are listing a directory
|
|
1229
|
# loop through the files contained in the directory
|
|
1230
|
@patterns = ('*', '.*');
|
|
1231
|
}
|
|
1232
|
foreach $pat (@patterns) {
|
|
1233
|
for my $f (bsd_glob($mountpath.$pat)) {
|
|
1234
|
my %fhash;
|
|
1235
|
($bname, $dirpath) = fileparse($f);
|
|
1236
|
my @stat = stat($f);
|
|
1237
|
my $size = $stat[7];
|
|
1238
|
my $realsize = $stat[12] * 512;
|
|
1239
|
my $mtime = $stat[9];
|
|
1240
|
|
|
1241
|
$fhash{'name'} = $bname;
|
|
1242
|
$fhash{'mtime'} = $mtime;
|
|
1243
|
## if the file is a directory
|
|
1244
|
if( -d $f) {
|
|
1245
|
$fhash{'size'} = 0;
|
|
1246
|
$fhash{'fullpath'} = $f . '/';
|
|
1247
|
$fhash{'path'} = $curpath . $bname . '/';
|
|
1248
|
push(@dirs, \%fhash) unless ($bname eq '.' || $bname eq '..');
|
|
1249
|
} else {
|
|
1250
|
$fhash{'size'} = $size;
|
|
1251
|
$fhash{'fullpath'} = $f;
|
|
1252
|
$fhash{'path'} = $curpath . $bname;
|
|
1253
|
push(@files, \%fhash);
|
|
1254
|
}
|
|
1255
|
}
|
|
1256
|
}
|
|
1257
|
|
|
1258
|
if ($console) {
|
|
1259
|
my $t2 = Text::SimpleTable->new(48,16,28);
|
|
1260
|
$t2->row('name', 'size', 'mtime');
|
|
1261
|
$t2->hr;
|
|
1262
|
foreach my $fref (@dirs) {
|
|
1263
|
$t2->row($fref->{'name'}, $fref->{'size'}, scalar localtime( $fref->{'mtime'} )) unless ($bname eq '.' || $bname eq '..');
|
|
1264
|
}
|
|
1265
|
foreach my $fref (@files) {
|
|
1266
|
$t2->row($fref->{'name'}, $fref->{'size'}, scalar localtime( $fref->{'mtime'} ) ) unless ($bname eq '.' || $bname eq '..');
|
|
1267
|
}
|
|
1268
|
return $t2->draw;
|
|
1269
|
} else {
|
|
1270
|
my @comb = (@dirs, @files);
|
|
1271
|
$res .= to_json(\@comb, {pretty => 1});
|
|
1272
|
}
|
|
1273
|
} else {
|
|
1274
|
$res .= qq|{"status": "Error", "message": "Image $curimg not mounted. Mount first."}|;
|
|
1275
|
}
|
|
1276
|
return $res;
|
|
1277
|
}
|
|
1278
|
|
|
1279
|
sub Restorefiles {
|
|
1280
|
my ($path, $action, $obj) = @_;
|
|
1281
|
if ($help) {
|
|
1282
|
return <<END
|
|
1283
|
GET:image,files:
|
|
1284
|
Restores files from the given path in the given image to a newly created ISO image. The given image must be mountable.
|
|
1285
|
END
|
|
1286
|
}
|
|
1287
|
my $res;
|
|
1288
|
$curfiles = $obj->{'files'};
|
|
1289
|
$path = $path || $curimg;
|
|
1290
|
|
|
1291
|
return "Status=ERROR Your account does not have the necessary privileges\n" if ($isreadonly);
|
|
1292
|
return "Status=ERROR You must specify which files you want to restore\n" unless ($curfiles);
|
|
1293
|
|
|
1294
|
my $name = $register{$path}->{'name'};
|
|
1295
|
my($bname, $dirpath, $suffix) = fileparse($path, (".vmdk", ".img", ".vhd", ".vhdx", ".qcow", ".qcow2", ".vdi", ".iso"));
|
|
1296
|
my $mountpath = "$dirpath.$bname$suffix";
|
|
1297
|
# my $mounts = decode('ascii-escape', `/bin/cat /proc/mounts`);
|
|
1298
|
my $mounts = `/bin/cat /proc/mounts`;
|
|
1299
|
my $mmounts = `/bin/df`;
|
|
1300
|
my $mounted = ($mounts =~ /$mountpath/ && $mmounts =~ /$mountpath/);
|
|
1301
|
my $restorepath = "$dirpath$bname.iso";
|
|
1302
|
|
|
1303
|
if (-e $restorepath) {
|
|
1304
|
my $i = 1;
|
|
1305
|
while (-e "$dirpath$bname.$i.iso") {$i++;}
|
|
1306
|
$restorepath = "$dirpath$bname.$i.iso";
|
|
1307
|
}
|
|
1308
|
|
|
1309
|
my $uistatus = "frestoring";
|
|
1310
|
if ($mounted && $curfiles) {
|
|
1311
|
my $ug = new Data::UUID;
|
|
1312
|
my $newuuid = $ug->create_str();
|
|
1313
|
$register{$restorepath} = {
|
|
1314
|
uuid=>$newuuid,
|
|
1315
|
status=>$uistatus,
|
|
1316
|
name=>"Files from: $name",
|
|
1317
|
size=>0,
|
|
1318
|
realsize=>0,
|
|
1319
|
virtualsize=>0,
|
|
1320
|
type=>"iso",
|
|
1321
|
user=>$user
|
|
1322
|
};
|
|
1323
|
|
|
1324
|
eval {
|
|
1325
|
my $oldstatus = $register{$path}->{'status'};
|
|
1326
|
# my $cmd = qq|steamExec $user $uistatus $oldstatus "$path" "$curfiles"|;
|
|
1327
|
# my $cmdres = `$cmd`;
|
|
1328
|
if ($mounted) {
|
|
1329
|
$res .= "Restoring files to: /tmp/restore/$user/$bname$suffix -> $restorepath\n";
|
|
1330
|
$res .= `/bin/echo $status > "$restorepath.meta"`;
|
|
1331
|
|
|
1332
|
`/bin/mkdir -p "/tmp/restore/$user/$bname$suffix"` unless (-e "/tmp/restore/$user/$bname$suffix");
|
|
1333
|
my @files = split(/:/, uri_unescape($curfiles));
|
|
1334
|
foreach $f (@files) {
|
|
1335
|
if (-e "$mountpath$f" && chdir($mountpath)) {
|
|
1336
|
$f = substr($f,1) if ($f =~ /^\//);
|
|
1337
|
eval {`/usr/bin/rsync -aR --sparse "$f" /tmp/restore/$user/$bname$suffix`; 1;}
|
|
1338
|
or do {$e=1; $res .= "ERROR Problem restoring files $@\n";};
|
|
1339
|
} else {
|
|
1340
|
$res .= "Status=Error $f not found in $mountpath\n";
|
|
1341
|
}
|
|
1342
|
}
|
|
1343
|
if (chdir "/tmp/restore/$user/$bname$suffix") {
|
|
1344
|
eval {$res .= `/usr/bin/genisoimage -o "$restorepath" -iso-level 4 .`; 1;}
|
|
1345
|
or do {$e=1; $res .= "Status=ERROR Problem restoring files $@\n";};
|
|
1346
|
$res .= `/bin/rm -rf /tmp/restore/$user/$bname$suffix`;
|
|
1347
|
$res .= "Status=OK Restored files from /tmp/restore/$user/$bname$suffix to $restorepath\n";
|
|
1348
|
} else {
|
|
1349
|
$res .= "Status=ERROR Unable to chdir to /tmp/restore/$user/$bname$suffix\n";
|
|
1350
|
}
|
|
1351
|
$main::updateUI->({tab=>"images", user=>$user, type=>"update"});
|
|
1352
|
|
|
1353
|
# Update billing
|
|
1354
|
my $newvirtualsize = getVirtualSize($restorepath);
|
|
1355
|
unlink "$restorepath.meta";
|
|
1356
|
$res .= Unmount($path);
|
|
1357
|
$register{$restorepath}->{'status'} = 'unused';
|
|
1358
|
$register{$restorepath}->{'virtualsize'} = $newvirtualsize;
|
|
1359
|
$register{$restorepath}->{'realsize'} = $newvirtualsize;
|
|
1360
|
$register{$restorepath}->{'size'} = $newvirtualsize;
|
|
1361
|
$postmsg = "OK - restored your files into a new ISO.";
|
|
1362
|
} else {
|
|
1363
|
$res .= "Status=Error You must mount image on $mountpath before restoring\n";
|
|
1364
|
}
|
|
1365
|
$res .= "Status=OK $uistatus files from $name to iso, $newuuid, $cmd\n";
|
|
1366
|
$main::syslogit->($user, "info", "$uistatus files from $path to iso, $newuuid");
|
|
1367
|
1;
|
|
1368
|
} or do {$res .= "Status=ERROR $@\n";}
|
|
1369
|
|
|
1370
|
} else {
|
|
1371
|
$res .= "Status=ERROR Image not mounted, mount before restoring: ". $curfiles ."\n";
|
|
1372
|
}
|
|
1373
|
return $res;
|
|
1374
|
}
|
|
1375
|
|
|
1376
|
sub trim{
|
|
1377
|
my $string = shift;
|
|
1378
|
$string =~ s/^\s+|\s+$//g;
|
|
1379
|
return $string;
|
|
1380
|
}
|
|
1381
|
|
|
1382
|
sub do_overquota {
|
|
1383
|
my ($path, $action, $obj) = @_;
|
|
1384
|
if ($help) {
|
|
1385
|
return <<END
|
|
1386
|
GET:inc,onnode:
|
|
1387
|
Check if 'inc' bytes will bring you over your storage quota. Set onnode to 1 to check node storage quota.
|
|
1388
|
END
|
|
1389
|
}
|
|
1390
|
if (overQuotas($obj->{inc}, $obj->{onnode})) {
|
|
1391
|
return "Status=Error Over storage quota\n";
|
|
1392
|
} else {
|
|
1393
|
return "Status=OK Not over storage quota\n";
|
|
1394
|
}
|
|
1395
|
}
|
|
1396
|
|
|
1397
|
sub overQuotas {
|
|
1398
|
my $inc = shift;
|
|
1399
|
my $onnode = shift;
|
|
1400
|
my $usedstorage = 0;
|
|
1401
|
my $overquota = 0;
|
|
1402
|
return 0 if ($Stabile::userprivileges =~ /a/); # Don't enforce quotas for admins
|
|
1403
|
my $storagequota = ($onnode)?$Stabile::usernodestoragequota:$Stabile::userstoragequota;
|
|
1404
|
|
|
1405
|
if (!$storagequota) { # 0 or empty quota means use defaults
|
|
1406
|
$storagequota = (($onnode)?$Stabile::config->get('NODESTORAGE_QUOTA'):$Stabile::config->get('STORAGE_QUOTA')) + 0;
|
|
1407
|
}
|
|
1408
|
return 0 if ($storagequota == -1); # -1 means no quota
|
|
1409
|
|
|
1410
|
my @regkeys = (tied %register)->select_where("user = '$user'");
|
|
1411
|
foreach my $k (@regkeys) {
|
|
1412
|
my $val = $register{$k};
|
|
1413
|
if ($val->{'user'} eq $user) {
|
|
1414
|
$usedstorage += $val->{'virtualsize'} if ((!$onnode && $val->{'storagepool'}!=-1) || ($onnode && $val->{'storagepool'}==-1));
|
|
1415
|
}
|
|
1416
|
}
|
|
1417
|
if ($usedstorage+$inc > $storagequota * 1024 *1024) {
|
|
1418
|
$overquota = $usedstorage+$inc;
|
|
1419
|
}
|
|
1420
|
return $overquota;
|
|
1421
|
}
|
|
1422
|
|
|
1423
|
sub overStorage {
|
|
1424
|
my ($reqstor, $spool, $mac) = @_;
|
|
1425
|
my $storfree;
|
|
1426
|
if ($spool == -1) {
|
|
1427
|
if ($mac) {
|
|
1428
|
unless ( tie(%nodereg,'Tie::DBI', Hash::Merge::merge({table=>'nodes', key=>'mac', CLOBBER=>1}, $Stabile::dbopts)) ) {return 0};
|
|
1429
|
$storfree = $nodereg{$mac}->{'storfree'};
|
|
1430
|
$storfree = $storfree *1024 * $nodestorageovercommission;
|
|
1431
|
untie %nodereg;
|
|
1432
|
} else {
|
|
1433
|
return 1;
|
|
1434
|
}
|
|
1435
|
} else {
|
|
1436
|
my $storpath = $spools[$spool]->{'path'};
|
|
1437
|
$storfree = `df $storpath`;
|
|
1438
|
$storfree =~ m/(\d\d\d\d+)(\s+)(\d\d*)(\s+)(\d\d+)(\s+)(\S+)/i;
|
|
1439
|
my $stortotal = $1;
|
|
1440
|
my $storused = $3;
|
|
1441
|
$storfree = $5 *1024;
|
|
1442
|
}
|
|
1443
|
return ($reqstor > $storfree);
|
|
1444
|
}
|
|
1445
|
|
|
1446
|
sub updateBilling {
|
|
1447
|
my $event = shift;
|
|
1448
|
my %billing;
|
|
1449
|
|
|
1450
|
my @regkeys = (tied %register)->select_where("user = '$user'");
|
|
1451
|
foreach my $k (@regkeys) {
|
|
1452
|
my $valref = $register{$k};
|
|
1453
|
my %val = %{$valref}; # Deference and assign to new array, effectively cloning object
|
|
1454
|
$val{'virtualsize'} += 0;
|
|
1455
|
$val{'realsize'} += 0;
|
|
1456
|
$val{'backupsize'} += 0;
|
|
1457
|
|
|
1458
|
if ($val{'user'} eq $user && (defined $spools[$val{'storagepool'}]->{'id'} || $val{'storagepool'}==-1)) {
|
|
1459
|
$billing{$val{'storagepool'}}->{'virtualsize'} += $val{'virtualsize'};
|
|
1460
|
$billing{$val{'storagepool'}}->{'realsize'} += $val{'realsize'};
|
|
1461
|
$billing{$val{'storagepool'}}->{'backupsize'} += $val{'backupsize'};
|
|
1462
|
}
|
|
1463
|
}
|
|
1464
|
|
|
1465
|
my %billingreg;
|
|
1466
|
|
|
1467
|
unless (tie %billingreg,'Tie::DBI', {
|
|
1468
|
db=>'mysql:steamregister',
|
|
1469
|
table=>'billing_images',
|
|
1470
|
key=>'userstoragepooltime',
|
|
1471
|
autocommit=>0,
|
|
1472
|
CLOBBER=>3,
|
|
1473
|
user=>$dbiuser,
|
|
1474
|
password=>$dbipasswd}) {throw Error::Simple("Stroke=Error Billing register (images) could not be accessed")};
|
|
1475
|
|
|
1476
|
my $monthtimestamp = timelocal(0,0,0,1,$mon,$year); #$sec,$min,$hour,$mday,$mon,$year
|
|
1477
|
|
|
1478
|
unless ( tie(%nodereg,'Tie::DBI', Hash::Merge::merge({table=>'billing_images', key=>'userstoragepooltime'}, $Stabile::dbopts)) )
|
|
1479
|
{throw Error::Simple("Status=Error Billing register could not be accessed")};
|
|
1480
|
|
|
1481
|
my %pool = ("hostpath", "--",
|
|
1482
|
"path", "--",
|
|
1483
|
"name", "local",
|
|
1484
|
"rdiffenabled", 1,
|
|
1485
|
"id", -1);
|
|
1486
|
my @bspools = @spools;
|
|
1487
|
push @bspools, \%pool;
|
|
1488
|
|
|
1489
|
foreach my $spool (@bspools) {
|
|
1490
|
my $storagepool = $spool->{"id"};
|
|
1491
|
my $b = $billing{$storagepool};
|
|
1492
|
my $virtualsize = $b->{'virtualsize'} +0;
|
|
1493
|
my $realsize = $b->{'realsize'} +0;
|
|
1494
|
my $backupsize = $b->{'backupsize'} +0;
|
|
1495
|
|
|
1496
|
# Setting default start averages for use when no row found under the assumption that we entered a new month
|
|
1497
|
my $startvirtualsizeavg = 0;
|
|
1498
|
my $virtualsizeavg = 0;
|
|
1499
|
my $startrealsizeavg = 0;
|
|
1500
|
my $realsizeavg = 0;
|
|
1501
|
my $startbackupsizeavg = 0;
|
|
1502
|
my $backupsizeavg = 0;
|
|
1503
|
my $starttimestamp = $current_time;
|
|
1504
|
# We have proably entered a new month if less than 4 hours since change of month, since this is run hourly
|
|
1505
|
if ($current_time - $monthtimestamp < 4*3600) {
|
|
1506
|
$starttimestamp = $monthtimestamp;
|
|
1507
|
$startvirtualsizeavg = $virtualsizeavg = $virtualsize;
|
|
1508
|
$startrealsizeavg = $realsizeavg = $realsize;
|
|
1509
|
$startbackupsizeavg = $backupsizeavg = $backupsize;
|
|
1510
|
}
|
|
1511
|
# Update existing row
|
|
1512
|
if ($billingreg{"$user-$storagepool-$year-$month"}) {
|
|
1513
|
if (
|
|
1514
|
($virtualsize != $billingreg{"$user-$storagepool-$year-$month"}->{'virtualsize'})
|
|
1515
|
|| ($realsize != $billingreg{"$user-$storagepool-$year-$month"}->{'realsize'})
|
|
1516
|
|| ($backupsize != $billingreg{"$user-$storagepool-$year-$month"}->{'backupsize'})
|
|
1517
|
)
|
|
1518
|
{
|
|
1519
|
# Sizes changed, update start averages and time, i.e. move the marker
|
|
1520
|
# Averages and start averages are the same when a change has occurred
|
|
1521
|
$startvirtualsizeavg = $virtualsizeavg = $billingreg{"$user-$storagepool-$year-$month"}->{'virtualsizeavg'};
|
|
1522
|
$startrealsizeavg = $realsizeavg = $billingreg{"$user-$storagepool-$year-$month"}->{'realsizeavg'};
|
|
1523
|
$startbackupsizeavg = $backupsizeavg = $billingreg{"$user-$storagepool-$year-$month"}->{'backupsizeavg'};
|
|
1524
|
$starttimestamp = $current_time;
|
|
1525
|
} else {
|
|
1526
|
# Update averages and timestamp when no change on existing row
|
|
1527
|
$startvirtualsizeavg = $billingreg{"$user-$storagepool-$year-$month"}->{'startvirtualsizeavg'};
|
|
1528
|
$startrealsizeavg = $billingreg{"$user-$storagepool-$year-$month"}->{'startrealsizeavg'};
|
|
1529
|
$startbackupsizeavg = $billingreg{"$user-$storagepool-$year-$month"}->{'startbackupsizeavg'};
|
|
1530
|
$starttimestamp = $billingreg{"$user-$storagepool-$year-$month"}->{'starttimestamp'};
|
|
1531
|
|
|
1532
|
$virtualsizeavg = ($startvirtualsizeavg*($starttimestamp - $monthtimestamp) + $virtualsize*($current_time - $starttimestamp)) /
|
|
1533
|
($current_time - $monthtimestamp);
|
|
1534
|
$realsizeavg = ($startrealsizeavg*($starttimestamp - $monthtimestamp) + $realsize*($current_time - $starttimestamp)) /
|
|
1535
|
($current_time - $monthtimestamp);
|
|
1536
|
$backupsizeavg = ($startbackupsizeavg*($starttimestamp - $monthtimestamp) + $backupsize*($current_time - $starttimestamp)) /
|
|
1537
|
($current_time - $monthtimestamp);
|
|
1538
|
}
|
|
1539
|
# Update sizes in DB
|
|
1540
|
$billingreg{"$user-$storagepool-$year-$month"}->{'virtualsize'} = $virtualsize;
|
|
1541
|
$billingreg{"$user-$storagepool-$year-$month"}->{'realsize'} = $realsize;
|
|
1542
|
$billingreg{"$user-$storagepool-$year-$month"}->{'backupsize'} = $backupsize;
|
|
1543
|
# Update start averages
|
|
1544
|
$billingreg{"$user-$storagepool-$year-$month"}->{'startvirtualsizeavg'} = $startvirtualsizeavg;
|
|
1545
|
$billingreg{"$user-$storagepool-$year-$month"}->{'startrealsizeavg'} = $startrealsizeavg;
|
|
1546
|
$billingreg{"$user-$storagepool-$year-$month"}->{'startbackupsizeavg'} = $startbackupsizeavg;
|
|
1547
|
# Update current averages with values just calculated
|
|
1548
|
$billingreg{"$user-$storagepool-$year-$month"}->{'virtualsizeavg'} = $virtualsizeavg;
|
|
1549
|
$billingreg{"$user-$storagepool-$year-$month"}->{'realsizeavg'} = $realsizeavg;
|
|
1550
|
$billingreg{"$user-$storagepool-$year-$month"}->{'backupsizeavg'} = $backupsizeavg;
|
|
1551
|
# Update time stamps and inc
|
|
1552
|
$billingreg{"$user-$storagepool-$year-$month"}->{'timestamp'} = $current_time;
|
|
1553
|
$billingreg{"$user-$storagepool-$year-$month"}->{'starttimestamp'} = $starttimestamp;
|
|
1554
|
$billingreg{"$user-$storagepool-$year-$month"}->{'inc'}++;
|
|
1555
|
|
|
1556
|
# Write new row
|
|
1557
|
} else {
|
|
1558
|
$billingreg{"$user-$storagepool-$year-$month"} = {
|
|
1559
|
virtualsize=>$virtualsize+0,
|
|
1560
|
realsize=>$realsize+0,
|
|
1561
|
backupsize=>$backupsize+0,
|
|
1562
|
|
|
1563
|
virtualsizeavg=>$virtualsizeavg,
|
|
1564
|
realsizeavg=>$realsizeavg,
|
|
1565
|
backupsizeavg=>$backupsizeavg,
|
|
1566
|
|
|
1567
|
startvirtualsizeavg=>$startvirtualsizeavg,
|
|
1568
|
startrealsizeavg=>$startrealsizeavg,
|
|
1569
|
startbackupsizeavg=>$startbackupsizeavg,
|
|
1570
|
|
|
1571
|
timestamp=>$current_time,
|
|
1572
|
starttimestamp=>$starttimestamp,
|
|
1573
|
event=>$event,
|
|
1574
|
inc=>1,
|
|
1575
|
};
|
|
1576
|
}
|
|
1577
|
}
|
|
1578
|
tied(%billingreg)->commit;
|
|
1579
|
untie %billingreg;
|
|
1580
|
}
|
|
1581
|
|
|
1582
|
sub Removeuserimages {
|
|
1583
|
my ($path, $action, $obj) = @_;
|
|
1584
|
if ($help) {
|
|
1585
|
return <<END
|
|
1586
|
GET::
|
|
1587
|
Removes all images belonging to a user from storage, i.e. completely deletes the image and its backups (be careful).
|
|
1588
|
END
|
|
1589
|
}
|
|
1590
|
|
|
1591
|
$postreply = removeUserImages($user) unless ($isreadonly);
|
|
1592
|
return $postreply;
|
|
1593
|
}
|
|
1594
|
|
|
1595
|
sub removeUserImages {
|
|
1596
|
my $username = shift;
|
|
1597
|
return unless ($username && ($isadmin || $user eq $username) && !$isreadonly);
|
|
1598
|
$user = $username;
|
|
1599
|
foreach my $path (keys %register) {
|
|
1600
|
if ($register{$path}->{'user'} eq $user) {
|
|
1601
|
$postreply .= "Removing " . ($preserveimagesonremove?"(preserving) ":"") . " $username image $register{$path}->{'name'}, $uuid" . ($console?'':'<br>') . "\n";
|
|
1602
|
Remove($path, 'remove', 0, $preserveimagesonremove);
|
|
1603
|
}
|
|
1604
|
}
|
|
1605
|
$postreply .= "Status=Error No storage pools!\n" unless (@spools);
|
|
1606
|
foreach my $spool (@spools) {
|
|
1607
|
my $pooldir = $spool->{"path"};
|
|
1608
|
unless (-e $pooldir) {
|
|
1609
|
$postreply .= "Status=Error Storage $pooldir, $spool->{name} does not exist\n" unless (@spools);
|
|
1610
|
next;
|
|
1611
|
}
|
|
1612
|
|
|
1613
|
$postreply .= "Status=OK Removing user dir $pooldir/$username ";
|
|
1614
|
$postreply .= `/bin/rm "$pooldir/$username/.htaccess"` if (-e "$pooldir/$username/.htaccess");
|
|
1615
|
$postreply .= `/bin/rmdir --ignore-fail-on-non-empty "$pooldir/$username/fuel"` if (-e "$pooldir/$username/fuel");
|
|
1616
|
$postreply .= `/bin/rmdir --ignore-fail-on-non-empty "$pooldir/$username"` if (-e "$pooldir/$username");
|
|
1617
|
$postreply .= "\n";
|
|
1618
|
}
|
|
1619
|
|
|
1620
|
unless ( tie(%nodereg,'Tie::DBI', Hash::Merge::merge({table=>'nodes', key=>'mac', CLOBBER=>1}, $Stabile::dbopts)) ) {return 0};
|
|
1621
|
|
|
1622
|
foreach $mac (keys %nodereg) {
|
|
1623
|
$macip = $nodereg{$mac}->{'ip'};
|
|
1624
|
my $esc_path = "/mnt/stabile/node/$username";
|
|
1625
|
$esc_path =~ s/([ ])/\\$1/g;
|
|
1626
|
if (!$preserveimagesonremove) {
|
|
1627
|
`$sshcmd $macip "/bin/rmdir $esc_path"`;
|
|
1628
|
$postreply .= "Status=OK Removing node user dir /mnt/stabile/node/$username on node $mac\n";
|
|
1629
|
}
|
|
1630
|
}
|
|
1631
|
untie %nodereg;
|
|
1632
|
|
|
1633
|
return $postreply;
|
|
1634
|
}
|
|
1635
|
|
|
1636
|
sub Remove {
|
|
1637
|
my ($path, $action, $obj, $preserve) = @_;
|
|
1638
|
if ($help) {
|
|
1639
|
return <<END
|
|
1640
|
DELETE:image:
|
|
1641
|
Removes an image from storage, i.e. completely deletes the image and its backups (be careful).
|
|
1642
|
END
|
|
1643
|
}
|
|
1644
|
$path = $imagereg{$path}->{'path'} if ($imagereg{$path}); # Check if we were passed a uuid
|
|
1645
|
$path = $curimg if (!$path && $register{$curimg});
|
|
1646
|
if (!$curimg && $path && !($path =~ /^\//)) {
|
|
1647
|
$curimg = $path;
|
|
1648
|
$path = '';
|
|
1649
|
}
|
|
1650
|
if (!$path && $curimg && !($curimg =~ /\//) ) { # Allow passing only image name if we are deleting an app master
|
|
1651
|
my $dspool = $stackspool;
|
|
1652
|
$dspool = $spools[0]->{'path'} unless ($engineid eq $valve001id);
|
|
1653
|
if ($curimg =~ /\.master.qcow2$/ && $register{"$dspool/$user/$curimg"}) {
|
|
1654
|
$path = "$dspool/$user/$curimg";
|
|
1655
|
} elsif ($isadmin && $curimg =~ /\.master.qcow2$/ && $register{"$dspool/common/$curimg"}) {
|
|
1656
|
$path = "$dspool/common/$curimg";
|
|
1657
|
}
|
|
1658
|
}
|
|
1659
|
utf8::decode($path);
|
|
1660
|
|
|
1661
|
my $img = $register{$path};
|
|
1662
|
my $status = $img->{'status'};
|
|
1663
|
my $mac = $img->{'mac'};
|
|
1664
|
my $name = $img->{'name'};
|
|
1665
|
my $uuid = $img->{'uuid'};
|
|
1666
|
utf8::decode($name);
|
|
1667
|
my $type = $img->{'type'};
|
|
1668
|
my $username = $img->{'user'};
|
|
1669
|
|
|
1670
|
unless ($username && ($isadmin || $user eq $username) && !$isreadonly) {
|
|
1671
|
return qq|[]|;
|
|
1672
|
# $postmsg = "Cannot delete image";
|
|
1673
|
# $postreply .= "Status=Error $postmsg\n";
|
|
1674
|
# return $postreply;
|
|
1675
|
}
|
|
1676
|
|
|
1677
|
$uistatus = "deleting";
|
|
1678
|
if ($status eq "unused" || $status eq "uploading" || $path =~ /(.+)\.master\.$type/) {
|
|
1679
|
my $haschildren;
|
|
1680
|
my $child;
|
|
1681
|
my $hasprimary;
|
|
1682
|
my $primary;
|
|
1683
|
my $master = ($img->{'master'} && $img->{'master'} ne '--')?$img->{'master'}:'';
|
|
1684
|
my $usedmaster = '';
|
|
1685
|
my @regvalues = values %register;
|
|
1686
|
foreach my $valref (@regvalues) {
|
|
1687
|
if ($valref->{'master'} eq $path) {
|
|
1688
|
$haschildren = 1;
|
|
1689
|
$child = $valref->{'name'};
|
|
1690
|
# last;
|
|
1691
|
}
|
|
1692
|
if ($master) {
|
|
1693
|
$usedmaster = 1 if ($valref->{'master'} eq $master && $valref->{'path'} ne $path); # Check if another image is also using this master
|
|
1694
|
}
|
|
1695
|
}
|
|
1696
|
if ($master && !$usedmaster && $register{$master}) {
|
|
1697
|
$register{$master}->{'status'} = 'unused';
|
|
1698
|
$main::syslogit->($user, "info", "Freeing master $master");
|
|
1699
|
}
|
|
1700
|
if ($type eq "qcow2") {
|
|
1701
|
my @regkeys = (tied %register)->select_where("image2 = '$path'");
|
|
1702
|
foreach my $k (@regkeys) {
|
|
1703
|
my $val = $register{$k};
|
|
1704
|
if ($val->{'image2'} eq $path) {
|
|
1705
|
$hasprimary = 1;
|
|
1706
|
$primary = $val->{'name'};
|
|
1707
|
last;
|
|
1708
|
}
|
|
1709
|
}
|
|
1710
|
}
|
|
1711
|
|
|
1712
|
if ($haschildren) {
|
|
1713
|
$postmsg = "Cannot delete image. This image is used as master by: $child";
|
|
1714
|
$postreply .= "Status=Error $postmsg\n";
|
|
1715
|
# } elsif ($hasprimary) {
|
|
1716
|
# $postmsg = "Cannot delete image. This image is used as secondary image by: $primary";
|
|
1717
|
# $postreply .= "Status=Error $postmsg\n";
|
|
1718
|
} else {
|
|
1719
|
if ($mac && $path =~ /\/mnt\/stabile\/node\//) {
|
|
1720
|
unless ( tie(%nodereg,'Tie::DBI', Hash::Merge::merge({table=>'nodes', key=>'mac', CLOBBER=>1}, $Stabile::dbopts)) ) {return "Status=Error Cannot connect to DB\n";};
|
|
1721
|
$macip = $nodereg{$mac}->{'ip'};
|
|
1722
|
my $wakenode = ($nodereg{$mac}->{'status'} eq 'asleep' || $nodereg{$mac}->{'status'} eq 'waking');
|
|
1723
|
|
|
1724
|
if ($wakenode) {
|
|
1725
|
my $tasks = $nodereg{$mac}->{'tasks'};
|
|
1726
|
my $upath = URI::Escape::uri_escape($path);
|
|
1727
|
$tasks .= "REMOVE $upath $user\n";
|
|
1728
|
$nodereg{$mac}->{'tasks'} = $tasks;
|
|
1729
|
tied(%nodereg)->commit;
|
|
1730
|
$postmsg = "We are waking up the node your image $name is on - it will be removed shortly";
|
|
1731
|
if ($nodereg{$mac}->{'status'} eq 'asleep') {
|
|
1732
|
require "$Stabile::basedir/cgi/nodes.cgi";
|
|
1733
|
$Stabile::Nodes::console = 1;
|
|
1734
|
Stabile::Nodes::wake($mac);
|
|
1735
|
}
|
|
1736
|
$register{$path}->{'status'} = $uistatus;
|
|
1737
|
} else {
|
|
1738
|
my $esc_path = $path;
|
|
1739
|
$esc_path =~ s/([ ])/\\$1/g;
|
|
1740
|
if ($preserve) {
|
|
1741
|
`$sshcmd $macip "/bin/mv $esc_path $esc_path.bak"`;
|
|
1742
|
} else {
|
|
1743
|
`$sshcmd $macip "/usr/bin/unlink $esc_path"`;
|
|
1744
|
}
|
|
1745
|
`$sshcmd $macip "/usr/bin/unlink $esc_path.meta"`;
|
|
1746
|
delete $register{$path};
|
|
1747
|
}
|
|
1748
|
untie %nodereg;
|
|
1749
|
|
|
1750
|
} else {
|
|
1751
|
if ($preserve) {
|
|
1752
|
`/bin/mv "$path" "$path.bak"`;
|
|
1753
|
} else {
|
|
1754
|
unlink $path;
|
|
1755
|
}
|
|
1756
|
if (substr($path,-5) eq '.vmdk') {
|
|
1757
|
if ( -s (substr($path,0,-5) . "-flat.vmdk")) {
|
|
1758
|
my $flat = substr($path,0,-5) . "-flat.vmdk";
|
|
1759
|
if ($preserve) {
|
|
1760
|
`/bin/mv $flat "$flat.bak"`;
|
|
1761
|
} else {
|
|
1762
|
unlink($flat);
|
|
1763
|
}
|
|
1764
|
} elsif ( -e (substr($path,0,-5) . "-s001.vmdk")) {
|
|
1765
|
my $i = 1;
|
|
1766
|
my $rmpath = substr($path,0,-5);
|
|
1767
|
while (-e "$rmpath-s00$i.vmdk") {
|
|
1768
|
if ($preserve) {
|
|
1769
|
`/bin/mv "$rmpath-s00$i.vmdk" "$rmpath-s00$i.vmdk.bak"`;
|
|
1770
|
} else {
|
|
1771
|
unlink("$rmpath-s00$i.vmdk");
|
|
1772
|
}
|
|
1773
|
$i++;
|
|
1774
|
}
|
|
1775
|
}
|
|
1776
|
}
|
|
1777
|
unlink "$path.meta" if (-e "$path.meta");
|
|
1778
|
delete $register{$path};
|
|
1779
|
}
|
|
1780
|
|
|
1781
|
my $subdir = "";
|
|
1782
|
my($bname, $dirpath) = fileparse($path);
|
|
1783
|
if ($dirpath =~ /.+\/$buser(\/.+)?\//) {
|
|
1784
|
$subdir = $1;
|
|
1785
|
}
|
|
1786
|
my $bpath = "$backupdir/$user$subdir/$bname";
|
|
1787
|
$bpath = $1 if ($bpath =~ /(.+)/);
|
|
1788
|
# Remove backup of image if it exists
|
|
1789
|
if (-d "$bpath") {
|
|
1790
|
`/bin/rm -rf "$bpath"`;
|
|
1791
|
}
|
|
1792
|
|
|
1793
|
# $postmsg = "Deleted image $name ($path, $uuid, $mac)";
|
|
1794
|
$postreply = "[]";
|
|
1795
|
# $postreply .= "Status=deleting OK $postmsg\n";
|
|
1796
|
updateBilling("delete $path");
|
|
1797
|
$main::syslogit->($user, "info", "$uistatus $type image: $name: $path");
|
|
1798
|
if ($status eq 'downloading') {
|
|
1799
|
my $daemon = Proc::Daemon->new(
|
|
1800
|
work_dir => '/usr/local/bin',
|
|
1801
|
exec_command => qq|pkill -f "$path"|
|
|
1802
|
) or do {$postreply .= "Status=ERROR $@\n";};
|
|
1803
|
my $pid = $daemon->Init();
|
|
1804
|
}
|
|
1805
|
sleep 1;
|
|
1806
|
}
|
|
1807
|
} else {
|
|
1808
|
$postmsg = "Cannot delete $type image with status: $status";
|
|
1809
|
$postreply .= "Status=ERROR $postmsg\n";
|
|
1810
|
}
|
|
1811
|
return $postreply;
|
|
1812
|
}
|
|
1813
|
|
|
1814
|
# Clone image $path to destination storage pool $istoragepool, possibly changing backup schedule $bschedule
|
|
1815
|
sub Clone {
|
|
1816
|
my ($path, $action, $obj, $istoragepool, $imac, $name, $bschedule, $buildsystem, $managementlink, $appid, $wait, $vcpu, $mem) = @_;
|
|
1817
|
if ($help) {
|
|
1818
|
return <<END
|
|
1819
|
GET:image,name,storagepool,wait:
|
|
1820
|
Clones an image. In the case of cloning a master image, a child is produced.
|
|
1821
|
Only cloning to same storagepool is supported, with the exception of cloning to nodes (storagepool -1).
|
|
1822
|
If you want to perform the clone synchronously, set wait to 1;
|
|
1823
|
END
|
|
1824
|
}
|
|
1825
|
$postreply = "" if ($buildsystem);
|
|
1826
|
return "Status=Error no valid user\n" unless ($user);
|
|
1827
|
|
|
1828
|
unless ($register{$path} && ($register{$path}->{'user'} eq $user
|
|
1829
|
|| $register{$path}->{'user'} eq 'common'
|
|
1830
|
|| $register{$path}->{'user'} eq $billto
|
|
1831
|
|| $register{$path}->{'user'} eq $Stabile::Systems::billto
|
|
1832
|
|| $isadmin)) {
|
|
1833
|
$postreply .= "Status=ERROR Cannot clone!\n";
|
|
1834
|
return;
|
|
1835
|
}
|
|
1836
|
$istoragepool = $istoragepool || $obj->{storagepool};
|
|
1837
|
$name = $name || $obj->{name};
|
|
1838
|
$wait = $wait || $obj->{wait};
|
|
1839
|
my $status = $register{$path}->{'status'};
|
|
1840
|
my $type = $register{$path}->{'type'};
|
|
1841
|
my $master = $register{$path}->{'master'};
|
|
1842
|
my $notes = $register{$path}->{'notes'};
|
|
1843
|
my $image2 = $register{$path}->{'image2'};
|
|
1844
|
my $snap1 = $register{$path}->{'snap1'};
|
|
1845
|
$managementlink = $register{$path}->{'managementlink'} unless ($managementlink);
|
|
1846
|
$appid = $register{$path}->{'appid'} unless ($appid);
|
|
1847
|
my $upgradelink = $register{$path}->{'upgradelink'} || '';
|
|
1848
|
my $terminallink = $register{$path}->{'terminallink'} || '';
|
|
1849
|
my $version = $register{$path}->{'version'} || '';
|
|
1850
|
my $regmac = $register{$path}->{'mac'};
|
|
1851
|
|
|
1852
|
my $virtualsize = $register{$path}->{'virtualsize'};
|
|
1853
|
my $dindex = 0;
|
|
1854
|
|
|
1855
|
my($bname, $dirpath, $suffix) = fileparse($path, (".vmdk", ".img", ".vhd", ".vhdx", ".qcow", ".qcow2", ".vdi", ".iso"));
|
|
1856
|
$path =~ /(.+)\.$type/;
|
|
1857
|
my $namepath = $1;
|
|
1858
|
if ($namepath =~ /(.+)\.master/) {
|
|
1859
|
$namepath = $1;
|
|
1860
|
}
|
|
1861
|
if ($namepath =~ /(.+)\.clone\d+/) {
|
|
1862
|
$namepath = $1;
|
|
1863
|
}
|
|
1864
|
if ($namepath =~ /.+\/common\/(.+)/) { # Support one subdir
|
|
1865
|
$namepath = $1;
|
|
1866
|
} elsif ($namepath =~ /.+\/$user\/(.+)/) { # Support one subdir
|
|
1867
|
$namepath = $1;
|
|
1868
|
} elsif ($namepath =~ /.+\/(.+)/) { # Extract only the name
|
|
1869
|
$namepath = $1;
|
|
1870
|
}
|
|
1871
|
|
|
1872
|
# Find unique path in DB across storage pools
|
|
1873
|
my $upath;
|
|
1874
|
my $npath = "/mnt/stabile/node/$user/$namepath"; # Also check for uniqueness on nodes
|
|
1875
|
my $i = 1;
|
|
1876
|
foreach my $spool (@spools) {
|
|
1877
|
$upath = $spool->{'path'} . "/$user/$namepath";
|
|
1878
|
while ($register{"$upath.clone$i.$type"} || $register{"$npath.clone$i.$type"}) {$i++;};
|
|
1879
|
}
|
|
1880
|
$upath = "$spools[$istoragepool]->{'path'}/$user/$namepath";
|
|
1881
|
|
|
1882
|
my $iname = $register{$path}->{'name'};
|
|
1883
|
$iname = "$name" if ($name); # Used when name supplied when building a system
|
|
1884
|
$iname =~ /(.+)( \(master\))/;
|
|
1885
|
$iname = $1 if $2;
|
|
1886
|
$iname =~ /(.+)( \(clone\d*\))/;
|
|
1887
|
$iname = $1 if $2;
|
|
1888
|
$iname =~ /(.+)( \(child\d*\))/;
|
|
1889
|
$iname = $1 if $2;
|
|
1890
|
my $ippath = $path;
|
|
1891
|
my $macip;
|
|
1892
|
my $ug = new Data::UUID;
|
|
1893
|
my $newuuid = $ug->create_str();
|
|
1894
|
my $wakenode;
|
|
1895
|
my $identity;
|
|
1896
|
|
|
1897
|
# We only support cloning images to nodes - not the other way round
|
|
1898
|
if ($imac && $regmac && $imac ne $regmac) {
|
|
1899
|
$postreply .= "Status=ERROR Cloning from a node not supported\n";
|
|
1900
|
return $postreply;
|
|
1901
|
}
|
|
1902
|
|
|
1903
|
if ($istoragepool==-1) {
|
|
1904
|
# Find the ip address of target node
|
|
1905
|
($imac, $macip, $dindex, $wakenode, $identity) = locateNode($virtualsize, $imac, $vcpu, $mem);
|
|
1906
|
if ($identity eq 'local_kvm') {
|
|
1907
|
$postreply .= "Status=OK Cloning to local node with index: $dindex\n";
|
|
1908
|
$istoragepool = 0; # cloning to local node
|
|
1909
|
$upath = "$spools[$istoragepool]->{'path'}/$user/$namepath";
|
|
1910
|
} elsif (!$macip) {
|
|
1911
|
$postreply .= "Status=ERROR Unable to locate node with sufficient ressources\n";
|
|
1912
|
$postmsg = "Unable to locate node with sufficient ressources!";
|
|
1913
|
$main::updateUI->({tab=>"images", user=>$user, type=>"message", message=>$postmsg});
|
|
1914
|
return $postreply;
|
|
1915
|
} else {
|
|
1916
|
$postreply .= "Status=OK Cloning to $macip with index: $dindex\n";
|
|
1917
|
$ippath = "$macip:$path";
|
|
1918
|
$upath = "/mnt/stabile/node/$user/$namepath";
|
|
1919
|
}
|
|
1920
|
}
|
|
1921
|
my $ipath = "$upath.clone$i.$type";
|
|
1922
|
|
|
1923
|
if ($bschedule eq 'daily7' || $bschedule eq 'daily14') {
|
|
1924
|
$bschedule = "manually" if ($istoragepool!=-1 && (!$spools[$istoragepool]->{'rdiffenabled'} || !$spools[$istoragepool]->{'lvm'}));
|
|
1925
|
} elsif ($bschedule ne 'manually') {
|
|
1926
|
$bschedule = '';
|
|
1927
|
}
|
|
1928
|
|
|
1929
|
# Find storage pool with space
|
|
1930
|
my $foundstorage = 1;
|
|
1931
|
if (overStorage($virtualsize, $istoragepool, $imac)) {
|
|
1932
|
$foundstorage = 0;
|
|
1933
|
foreach my $p (@spools) {
|
|
1934
|
if (overStorage($virtualsize, $p->{'id'}, $imac)) {
|
|
1935
|
;
|
|
1936
|
} else {
|
|
1937
|
$istoragepool = $p->{'id'};
|
|
1938
|
$foundstorage = 1;
|
|
1939
|
last;
|
|
1940
|
}
|
|
1941
|
}
|
|
1942
|
}
|
|
1943
|
|
|
1944
|
# We allow multiple clone operations on master images
|
|
1945
|
if ($status ne "used" && $status ne "unused" && $status ne "paused" && $path !~ /(.+)\.master\.$type/) {
|
|
1946
|
$postreply .= "Status=ERROR Please shut down your virtual machine before cloning\n";
|
|
1947
|
|
|
1948
|
} elsif ($type eq 'vmdk' && (-e "$dirpath$bname-s001$suffix" || -e "$dirpath$bname-flat$suffix")) {
|
|
1949
|
$postreply .= "Status=ERROR Cannot clone this image - please convert first!\n";
|
|
1950
|
|
|
1951
|
} elsif (overQuotas($virtualsize, ($istoragepool==-1))) {
|
|
1952
|
$postreply .= "Status=ERROR Over quota (". overQuotas($virtualsize, ($istoragepool==-1)) . ") cloning: $name\n";
|
|
1953
|
|
|
1954
|
} elsif (!$foundstorage) {
|
|
1955
|
$postreply .= "Status=ERROR Not enough storage ($virtualsize) in destination pool $istoragepool $imac cloning: $name\n";
|
|
1956
|
|
|
1957
|
} elsif ($wakenode && !($path =~ /(.+)\.master\.$type/)) { # For now we dont support simply copying images on sleeping nodes
|
|
1958
|
$postreply .= "Status=ERROR We are waking up the node your image $name is on, please try again later\n";
|
|
1959
|
require "$Stabile::basedir/cgi/nodes.cgi";
|
|
1960
|
$Stabile::Nodes::console = 1;
|
|
1961
|
Stabile::Nodes::wake($imac);
|
|
1962
|
} elsif ($type eq "img" || $type eq "qcow2" || $type eq "vmdk") {
|
|
1963
|
my $masterimage2 = $register{"$path"}->{'image2'};
|
|
1964
|
# Cloning a master produces a child
|
|
1965
|
if ($type eq "qcow2" && $path =~ /(.+)\.master\.$type/) {
|
|
1966
|
$uistatus = "cloning";
|
|
1967
|
# VBoxManage probably does a more efficient job at cloning than simply copying
|
|
1968
|
} elsif ($type eq "vdi" || $type eq "vhd" || $type eq "vhdx") {
|
|
1969
|
$uistatus = "vcloning";
|
|
1970
|
# Cloning another child produces a sibling with the same master
|
|
1971
|
} else {
|
|
1972
|
$uistatus = "copying";
|
|
1973
|
}
|
|
1974
|
$uipath = $path;
|
|
1975
|
eval {
|
|
1976
|
$register{$ipath} = {
|
|
1977
|
uuid=>$newuuid,
|
|
1978
|
master=>($uistatus eq 'cloning')?$path:$master,
|
|
1979
|
name=>"$iname (clone$i)",
|
|
1980
|
notes=>$notes,
|
|
1981
|
image2=>$image2,
|
|
1982
|
snap1=>($uistatus eq 'copying')?$snap1:'',
|
|
1983
|
storagepool=>$istoragepool,
|
|
1984
|
status=>$uistatus,
|
|
1985
|
mac=>($istoragepool == -1)?$imac:"",
|
|
1986
|
size=>0,
|
|
1987
|
realsize=>0,
|
|
1988
|
virtualsize=>$virtualsize,
|
|
1989
|
bschedule=>$bschedule,
|
|
1990
|
type=>"qcow2",
|
|
1991
|
created=>$current_time,
|
|
1992
|
user=>$user
|
|
1993
|
};
|
|
1994
|
$register{$ipath}->{'managementlink'} = $managementlink if ($managementlink);
|
|
1995
|
$register{$ipath}->{'appid'} = $appid if ($appid);
|
|
1996
|
$register{$ipath}->{'upgradelink'} = $upgradelink if ($upgradelink);
|
|
1997
|
$register{$ipath}->{'terminallink'} = $terminallink if ($terminallink);
|
|
1998
|
$register{$ipath}->{'version'} = $version if ($version);
|
|
1999
|
$register{$path}->{'status'} = $uistatus;
|
|
2000
|
my $dstatus = ($buildsystem)?'bcloning':$uistatus;
|
|
2001
|
if ($wakenode) { # We are waking a node for clone operation, so ask movepiston to do the work
|
|
2002
|
unless ( tie(%nodereg,'Tie::DBI', Hash::Merge::merge({table=>'nodes', key=>'mac', CLOBBER=>1}, $Stabile::dbopts)) ) {return 0};
|
|
2003
|
my $tasks = $nodereg{$imac}->{'tasks'};
|
|
2004
|
$upath = URI::Escape::uri_escape($ipath);
|
|
2005
|
$tasks .= "BCLONE $upath $user\n";
|
|
2006
|
$nodereg{$imac}->{'tasks'} = $tasks;
|
|
2007
|
tied(%nodereg)->commit;
|
|
2008
|
untie %nodereg;
|
|
2009
|
} elsif ($wait) {
|
|
2010
|
my $cmd = qq|steamExec $user $dstatus $status "$ippath" "$ipath"|;
|
|
2011
|
$cmd = $1 if ($cmd =~ /(.+)/);
|
|
2012
|
`$cmd`;
|
|
2013
|
} else {
|
|
2014
|
my $daemon = Proc::Daemon->new(
|
|
2015
|
work_dir => '/usr/local/bin',
|
|
2016
|
exec_command => "perl -U steamExec $user $dstatus $status \"$ippath\" \"$ipath\""
|
|
2017
|
) or do {$postreply .= "Status=ERROR $@\n";};
|
|
2018
|
my $pid = $daemon->Init();
|
|
2019
|
}
|
|
2020
|
$postreply .= "Status=$uistatus OK $uistatus to: $iname (clone$i)" . ($isadmin? " -> $ipath ":"") . "\n";
|
|
2021
|
$postreply .= "Status=OK uuid: $newuuid\n"; # if ($console || $api);
|
|
2022
|
$postreply .= "Status=OK path: $ipath\n"; # if ($console || $api);
|
|
2023
|
$postreply .= "Status=OK mac: $imac\n"; # if ($console || $api);
|
|
2024
|
$postreply .= "Status=OK wakenode: $wakenode\n"; # if ($console || $api);
|
|
2025
|
$main::syslogit->($user, "info", "$uistatus $wakenode $type image: $name $uuid to $ipath");
|
|
2026
|
1;
|
|
2027
|
} or do {$postreply .= "Status=ERROR $@\n";}
|
|
2028
|
|
|
2029
|
} else {
|
|
2030
|
$postreply .= "Status=ERROR Not a valid type: $type\n";
|
|
2031
|
}
|
|
2032
|
tied(%register)->commit;
|
|
2033
|
$main::updateUI->({tab=>"images", user=>$user, type=>"update"});
|
|
2034
|
return $postreply;
|
|
2035
|
}
|
|
2036
|
|
|
2037
|
|
|
2038
|
# Link master image to fuel
|
|
2039
|
sub Linkmaster {
|
|
2040
|
my ($mpath, $action) = @_;
|
|
2041
|
if ($help) {
|
|
2042
|
return <<END
|
|
2043
|
GET:image:
|
|
2044
|
Link master image to fuel
|
|
2045
|
END
|
|
2046
|
}
|
|
2047
|
my $res;
|
|
2048
|
|
|
2049
|
return "Your account does not have the necessary privileges\n" if ($isreadonly);
|
|
2050
|
return "Please specify master image to link\n" unless ($mpath);
|
|
2051
|
|
|
2052
|
unless ($mpath =~ /^\//) { # We did not get an absolute path, look for it in users storagepools
|
|
2053
|
foreach my $p (@spools) {
|
|
2054
|
my $dir = $p->{'path'};
|
|
2055
|
my $cpath = "$dir/common/$mpath";
|
|
2056
|
my $upath = "$dir/$user/$mpath";
|
|
2057
|
if (-e $cpath) {
|
|
2058
|
$mpath = $cpath;
|
|
2059
|
last;
|
|
2060
|
} elsif (-e $upath) {
|
|
2061
|
$mpath = $upath;
|
|
2062
|
last;
|
|
2063
|
}
|
|
2064
|
}
|
|
2065
|
}
|
|
2066
|
my $img = $register{$mpath};
|
|
2067
|
$mpath = $img->{"path"};
|
|
2068
|
$imguser = $img->{"user"};
|
|
2069
|
if (!$mpath || ($imguser ne $user && $imguser ne 'common' && !$isadmin)) {
|
|
2070
|
$postreply = qq|{"status": "Error", "message": "No privs. or not found @_[0]"}|;
|
|
2071
|
return $postreply;
|
|
2072
|
}
|
|
2073
|
my $status = $img->{"status"};
|
|
2074
|
my $type = $img->{"type"};
|
|
2075
|
$mpath =~ /(.+)\/(.+)\.master\.$type$/;
|
|
2076
|
my $namepath = $2;
|
|
2077
|
my $msg;
|
|
2078
|
if ($status ne "unused" && $status ne "used") {
|
|
2079
|
$res .= qq|{"status": "Error", "message": "Only used and unused images may be linked ($status, $mpath)."}|;
|
|
2080
|
} elsif (!( $mpath =~ /(.+)\.master\.$type$/ ) ) {
|
|
2081
|
$res .= qq|{"status": "Error", "message": "You can only link master images"}|;
|
|
2082
|
} elsif ($type eq "qcow2") {
|
|
2083
|
my $pool = $img->{'storagepool'};
|
|
2084
|
`chmod 444 "$mpath"`;
|
|
2085
|
my $linkpath = $tenderpathslist[$pool] . "/$user/fuel/$namepath.link.master.$type";
|
|
2086
|
my $fuellinkpath = "/mnt/fuel/pool$pool/$namepath.link.master.$type";
|
|
2087
|
if (-e $tenderpathslist[$pool] . "/$user/fuel") { # master should be on fuel-enabled storage
|
|
2088
|
unlink ($linkpath) if (-e $linkpath);
|
|
2089
|
`ln "$mpath" "$linkpath"`;
|
|
2090
|
} else {
|
|
2091
|
foreach my $p (@spools) {
|
|
2092
|
my $dir = $p->{'path'};
|
|
2093
|
my $poolid = $p->{'id'};
|
|
2094
|
if (-e "$dir/$user/fuel") {
|
|
2095
|
$linkpath = "$dir/$user/fuel/$namepath.copy.master.$type";
|
|
2096
|
$fuellinkpath = "/mnt/fuel/pool$poolid/$namepath.copy.master.$type";
|
|
2097
|
unlink ($linkpath) if (-e $linkpath);
|
|
2098
|
`cp "$mpath" "$linkpath"`;
|
|
2099
|
$msg = "Different file systems, master copied";
|
|
2100
|
last;
|
|
2101
|
}
|
|
2102
|
}
|
|
2103
|
}
|
|
2104
|
$res .= qq|{"status": "OK", "message": "$msg", "path": "$fuellinkpath", "linkpath": "$linkpath", "masterpath": "$mpath"}|;
|
|
2105
|
} else {
|
|
2106
|
$res .= qq|{"status": "Error", "message": "You can only link qcow2 images"}|;
|
|
2107
|
}
|
|
2108
|
$postreply = $res;
|
|
2109
|
return $res;
|
|
2110
|
}
|
|
2111
|
|
|
2112
|
# Link master image to fuel
|
|
2113
|
sub unlinkMaster {
|
|
2114
|
my $mpath = shift;
|
|
2115
|
unless ($mpath =~ /^\//) { # We did not get an absolute path, look for it in users storagepools
|
|
2116
|
foreach my $p (@spools) {
|
|
2117
|
my $dir = $p->{'path'};
|
|
2118
|
my $upath = "$dir/$user/fuel/$mpath";
|
|
2119
|
if (-e $upath) {
|
|
2120
|
$mpath = "/mnt/fuel/pool$p->{id}/$mpath";
|
|
2121
|
last;
|
|
2122
|
}
|
|
2123
|
}
|
|
2124
|
}
|
|
2125
|
|
|
2126
|
$mpath =~ /\/pool(\d+)\/(.+)\.link\.master\.qcow2$/;
|
|
2127
|
my $pool = $1;
|
|
2128
|
my $namepath = $2;
|
|
2129
|
if (!( $mpath =~ /\/pool(\d+)\/(.+)\.link\.master\.qcow2$/ ) ) {
|
|
2130
|
$postreply = qq|{"status": "Error", "message": "You can only unlink linked master images ($mpath)"}|;
|
|
2131
|
} else {
|
|
2132
|
my $linkpath = $tenderpathslist[$pool] . "/$user/fuel/$namepath.link.master.qcow2";
|
|
2133
|
if (-e $linkpath) {
|
|
2134
|
`chmod 644 "$linkpath"`;
|
|
2135
|
`rm "$linkpath"`;
|
|
2136
|
$postreply = qq|{"status": "OK", "message": "Link removed", "path": "/mnt/fuel/pool$pool/$namepath.qcow2", "linkpath": "$linkpath"}|;
|
|
2137
|
} else {
|
|
2138
|
$postreply = qq|{"status": "Error", "message": "Link $linkpath does not exists."}|;
|
|
2139
|
}
|
|
2140
|
}
|
|
2141
|
}
|
|
2142
|
|
|
2143
|
#sub do_getstatus {
|
|
2144
|
# my ($img, $action) = @_;
|
|
2145
|
# if ($help) {
|
|
2146
|
# return <<END
|
|
2147
|
#GET::
|
|
2148
|
#END
|
|
2149
|
# }
|
|
2150
|
# # Allow passing only image name if we are dealing with an app master
|
|
2151
|
# my $dspool = $stackspool;
|
|
2152
|
# my $masteruser = $params{'masteruser'};
|
|
2153
|
# my $destuser = $params{'destuser'};
|
|
2154
|
# my $destpath;
|
|
2155
|
# $dspool = $spools[0]->{'path'} unless ($engineid eq $valve001id);
|
|
2156
|
# if (!$register{$img} && $img && !($img =~ /\//) && $masteruser) {
|
|
2157
|
# if ($img =~ /\.master\.qcow2$/ && $register{"$dspool/$masteruser/$img"}) {
|
|
2158
|
# if ($ismanager || $isadmin
|
|
2159
|
# || ($userreg{$masteruser}->{'billto'} eq $user)
|
|
2160
|
# ) {
|
|
2161
|
# $img = "$dspool/$masteruser/$img";
|
|
2162
|
# }
|
|
2163
|
# }
|
|
2164
|
# }
|
|
2165
|
# my $status = $register{$img}->{'status'};
|
|
2166
|
# if ($status) {
|
|
2167
|
# my $iuser = $register{$img}->{'user'};
|
|
2168
|
# # First check if user is allowed to access image
|
|
2169
|
# if ($iuser ne $user && $iuser ne 'common' && $userreg{$iuser}->{'billto'} ne $user) {
|
|
2170
|
# $status = '' unless ($isadmin || $ismanager);
|
|
2171
|
# }
|
|
2172
|
# if ($destuser) { # User is OK, now check if destination exists
|
|
2173
|
# my ($dest, $folder) = fileparse($img);
|
|
2174
|
# $destpath = "$dspool/$destuser/$dest";
|
|
2175
|
# $status = 'exists' if ($register{$destpath} || -e ($destpath));
|
|
2176
|
# }
|
|
2177
|
# }
|
|
2178
|
# my $res;
|
|
2179
|
# $res .= $Stabile::q->header('text/plain') unless ($console);
|
|
2180
|
# $res .= "$status";
|
|
2181
|
# return $res;
|
|
2182
|
#}
|
|
2183
|
|
|
2184
|
# sub do_move {
|
|
2185
|
# my ($uuid, $action) = @_;
|
|
2186
|
# if ($help) {
|
|
2187
|
# return <<END
|
|
2188
|
# GET:image,destuser,masteruser:
|
|
2189
|
# Move image to a different storage pool or user
|
|
2190
|
# END
|
|
2191
|
# }
|
|
2192
|
# return "Your account does not have the necessary privileges\n" if ($isreadonly);
|
|
2193
|
# Move($curimg, $params{'user'});
|
|
2194
|
# return $postreply;
|
|
2195
|
# }
|
|
2196
|
|
|
2197
|
sub Move {
|
|
2198
|
my ($path, $iuser, $istoragepool, $mac, $force) = @_;
|
|
2199
|
# Allow passing only image name if we are deleting an app master
|
|
2200
|
my $dspool = $stackspool;
|
|
2201
|
my $masteruser = $params{'masteruser'};
|
|
2202
|
$dspool = $spools[0]->{'path'} unless ($engineid eq $valve001id);
|
|
2203
|
unless ( tie(%userreg,'Tie::DBI', Hash::Merge::merge({table=>'users', key=>'username', CLOBBER=>1}, $Stabile::dbopts)) ) {return 0};
|
|
2204
|
if (!$register{$path} && $path && !($path =~ /\//) && $masteruser) {
|
|
2205
|
if ($path =~ /\.master\.qcow2$/ && $register{"$dspool/$masteruser/$path"}) {
|
|
2206
|
if ($ismanager || $isadmin
|
|
2207
|
|| ($userreg{$masteruser}->{'billto'} eq $user && $iuser eq $user)
|
|
2208
|
|| ($masteruser eq $user && $userreg{$iuser}->{'billto'} eq $user)
|
|
2209
|
) {
|
|
2210
|
$path = "$dspool/$masteruser/$path";
|
|
2211
|
}
|
|
2212
|
}
|
|
2213
|
}
|
|
2214
|
my $regimg = $register{$path};
|
|
2215
|
$istoragepool = ($istoragepool eq '0' || $istoragepool)? $istoragepool: $regimg->{'storagepool'};
|
|
2216
|
$mac = $mac || $regimg->{'mac'};
|
|
2217
|
my $bschedule = $regimg->{'bschedule'};
|
|
2218
|
my $name = $regimg->{'name'};
|
|
2219
|
my $status = $regimg->{'status'};
|
|
2220
|
my $type = $regimg->{'type'};
|
|
2221
|
my $reguser = $regimg->{'user'};
|
|
2222
|
my $regstoragepool = $regimg->{'storagepool'};
|
|
2223
|
my $virtualsize = $regimg->{'virtualsize'};
|
|
2224
|
|
|
2225
|
my $newpath;
|
|
2226
|
my $newdirpath;
|
|
2227
|
my $oldpath = $path;
|
|
2228
|
my $olddirpath = $path;
|
|
2229
|
my $newuser = $reguser;
|
|
2230
|
my $newstoragepool = $regstoragepool;
|
|
2231
|
my $haschildren;
|
|
2232
|
my $hasprimary;
|
|
2233
|
my $child;
|
|
2234
|
my $primary;
|
|
2235
|
my $macip;
|
|
2236
|
my $alreadyexists;
|
|
2237
|
my $subdir;
|
|
2238
|
# $subdir = $1 if ($path =~ /\/$reguser(\/.+)\//);
|
|
2239
|
$subdir = $1 if ($path =~ /.+\/$reguser(\/.+)?\//);
|
|
2240
|
my $restpath;
|
|
2241
|
$restpath = $1 if ($path =~ /.+\/$reguser\/(.+)/);
|
|
2242
|
|
|
2243
|
if ($type eq "qcow2" && $path =~ /(.+)\.master\.$type/) {
|
|
2244
|
my @regkeys = (tied %register)->select_where("master = '$path'");
|
|
2245
|
foreach my $k (@regkeys) {
|
|
2246
|
my $val = $register{$k};
|
|
2247
|
if ($val->{'master'} eq $path) {
|
|
2248
|
$haschildren = 1;
|
|
2249
|
$child = $val->{'name'};
|
|
2250
|
last;
|
|
2251
|
}
|
|
2252
|
}
|
|
2253
|
}
|
|
2254
|
if ($type eq "qcow2") {
|
|
2255
|
my @regkeys = (tied %register)->select_where("image2 = '$path'");
|
|
2256
|
foreach my $k (@regkeys) {
|
|
2257
|
my $val = $register{$k};
|
|
2258
|
if ($val->{'image2'} eq $path) {
|
|
2259
|
$hasprimary = 1;
|
|
2260
|
$primary = $val->{'name'};
|
|
2261
|
last;
|
|
2262
|
}
|
|
2263
|
}
|
|
2264
|
}
|
|
2265
|
if (!$register{$path}) {
|
|
2266
|
$postreply .= "Status=ERROR Unable to move $path (invalid path, $path, $masteruser)\n" unless ($istoragepool eq '--' || $regstoragepool eq '--');
|
|
2267
|
} elsif ($type eq 'vmdk' && -s (substr($path,0,-5) . "-flat.vmdk") || -s (substr($path,0,-5) . "-s001.vmdk")) {
|
|
2268
|
$postreply .= "Status=Error Cannot move this image. Please convert before moving\n";
|
|
2269
|
# Moving an image to a different users dir
|
|
2270
|
} elsif ($iuser ne $reguser && ($status eq "unused" || $status eq "used")) {
|
|
2271
|
unless ( tie(%nodereg,'Tie::DBI', Hash::Merge::merge({table=>'users', key=>'username', CLOBBER=>1}, $Stabile::dbopts)) ) {return 0};
|
|
2272
|
my @accounts = split(/,\s*/, $userreg{$tktuser}->{'accounts'});
|
|
2273
|
my @accountsprivs = split(/,\s*/, $userreg{$tktuser}->{'accountsprivileges'});
|
|
2274
|
%ahash = ($tktuser, $userreg{$tktuser}->{'privileges'} || 'r' ); # Include tktuser in accounts hash
|
|
2275
|
for my $i (0 .. scalar @accounts)
|
|
2276
|
{
|
|
2277
|
next unless $accounts[$i];
|
|
2278
|
$ahash{$accounts[$i]} = $accountsprivs[$i] || 'u';
|
|
2279
|
}
|
|
2280
|
|
|
2281
|
if ((($isadmin || $ismanager ) && $iuser eq 'common') # Check if user is allowed to access account
|
|
2282
|
|| ($isadmin && $userreg{$iuser})
|
|
2283
|
|| ($user eq $engineuser)
|
|
2284
|
|| ($userreg{$iuser}->{'billto'} eq $user)
|
|
2285
|
|| ($ahash{$iuser} && !($ahash{$iuser} =~ /r/))
|
|
2286
|
) {
|
|
2287
|
if ($haschildren) {
|
|
2288
|
$main::updateUI->({tab=>"images", user=>$user, type=>"update", uuid=>$register{$path}->{'uuid'}, status=>$status, message=>"Error Cannot move image. This image is used as master by: $child"});
|
|
2289
|
$postreply .= "Status=Error Cannot move image. This image is used as master by: $child\n";
|
|
2290
|
} elsif ($hasprimary) {
|
|
2291
|
$main::updateUI->({tab=>"images", user=>$user, type=>"update", uuid=>$register{$path}->{'uuid'}, status=>$status, message=>"Error Cannot move image. This image is used as secondary image by: $primary"});
|
|
2292
|
$postreply .= "Status=Error Cannot move image. This image is used as secondary image by: $primary\n";
|
|
2293
|
} else {
|
|
2294
|
if ($regstoragepool == -1) { # The image is located on a node
|
|
2295
|
my $uprivs = $userreg{$iuser}->{'privileges'};
|
|
2296
|
if ($uprivs =~ /[an]/) {
|
|
2297
|
unless ( tie(%nodereg,'Tie::DBI', Hash::Merge::merge({table=>'nodes', key=>'mac', CLOBBER=>1}, $Stabile::dbopts)) ) {return 0};
|
|
2298
|
$macip = $nodereg{$mac}->{'ip'};
|
|
2299
|
untie %nodereg;
|
|
2300
|
$oldpath = "$macip:/mnt/stabile/node/$reguser/$restpath";
|
|
2301
|
$newdirpath = "/mnt/stabile/node/$iuser/$restpath";
|
|
2302
|
$newpath = "$macip:$newdirpath";
|
|
2303
|
$newuser = $iuser;
|
|
2304
|
$newstoragepool = $istoragepool;
|
|
2305
|
# Check if image already exists in target dir
|
|
2306
|
$alreadyexists = `ssh -l irigo -i /var/www/.ssh/id_rsa_www -o UserKnownHostsFile=/dev/null -o StrictHostKeyChecking=no $macip "perl -e 'print 1 if -e q{/mnt/stabile/node/$iuser/$restpath}'"`;
|
|
2307
|
} else {
|
|
2308
|
$postreply .= "Status=Error Target account $iuser cannot use node storage\n";
|
|
2309
|
}
|
|
2310
|
} else {
|
|
2311
|
my $reguser = $userreg{$iuser};
|
|
2312
|
my $upools = $reguser->{'storagepools'} || $Stabile::config->get('STORAGE_POOLS_DEFAULTS') || "0";
|
|
2313
|
my @nspools = split(/, ?/, $upools);
|
|
2314
|
my %ispools = map {$_=>1} @nspools; # Build a hash with destination users storagepools
|
|
2315
|
if ($ispools{$regstoragepool}) { # Destination user has access to image's storagepool
|
|
2316
|
$newpath = "$spools[$regstoragepool]->{'path'}/$iuser/$restpath";
|
|
2317
|
} else {
|
|
2318
|
$newpath = "$spools[0]->{'path'}/$iuser/$restpath";
|
|
2319
|
}
|
|
2320
|
$newdirpath = $newpath;
|
|
2321
|
$newuser = $iuser;
|
|
2322
|
# Check if image already exists in target dir
|
|
2323
|
$alreadyexists = -e $newpath;
|
|
2324
|
}
|
|
2325
|
}
|
|
2326
|
} else {
|
|
2327
|
$postreply .= "Status=Error Cannot move image to account $iuser $ahash{$iuser} - not allowed\n";
|
|
2328
|
}
|
|
2329
|
# Moving an image to a different storage pool
|
|
2330
|
} elsif ($istoragepool ne '--' && $regstoragepool ne '--' && $istoragepool ne $regstoragepool
|
|
2331
|
&& ($status eq "unused" || $status eq "used" || $status eq "paused")) {
|
|
2332
|
|
|
2333
|
my $dindex;
|
|
2334
|
my $wakenode;
|
|
2335
|
if ($istoragepool == -1 && $regstoragepool != -1) {
|
|
2336
|
($mac, $macip, $dindex, $wakenode) = locateNode($virtualsize, $mac);
|
|
2337
|
}
|
|
2338
|
|
|
2339
|
$main::syslogit->($user, "info", "Moving $name from $regstoragepool to $istoragepool $macip $wakenode");
|
|
2340
|
|
|
2341
|
if ($haschildren) {
|
|
2342
|
$main::updateUI->({tab=>"images", user=>$user, type=>"update", uuid=>$register{$path}->{'uuid'}, status=>$status, message=>"ERROR Unable to move $name (has children)"});
|
|
2343
|
$postreply .= "Status=ERROR Unable to move $name (has children)\n";
|
|
2344
|
} elsif ($hasprimary) {
|
|
2345
|
$main::updateUI->({tab=>"images", user=>$user, type=>"update", uuid=>$register{$path}->{'uuid'}, status=>$status, message=>"Error Cannot move image. This image is used as secondary image by: $primary"});
|
|
2346
|
$postreply .= "Status=Error Cannot move image. This image is used as secondary image by: $primary\n";
|
|
2347
|
} elsif ($wakenode) {
|
|
2348
|
$postreply .= "Status=ERROR All available nodes are asleep moving $name, waking $mac, please try again later\n";
|
|
2349
|
$main::updateUI->({tab=>"images", user=>$user, type=>"update", uuid=>$register{$path}->{'uuid'}, status=>$status, message=>"All available nodes are asleep moving $name, waking $mac, please try again later"});
|
|
2350
|
require "$Stabile::basedir/cgi/nodes.cgi";
|
|
2351
|
$Stabile::Nodes::console = 1;
|
|
2352
|
Stabile::Nodes::wake($mac);
|
|
2353
|
} elsif (overStorage($virtualsize, $istoragepool+0, $mac)) {
|
|
2354
|
$main::updateUI->({tab=>"images", user=>$user, type=>"update", uuid=>$register{$path}->{'uuid'}, status=>$status, message=>"ERROR Out of storage in destination pool $istoragepool $mac moving: $name"});
|
|
2355
|
$postreply .= "Status=ERROR Out of storage in destination pool $istoragepool $mac moving: $name\n";
|
|
2356
|
} elsif (overQuotas($virtualsize, ($istoragepool==-1))) {
|
|
2357
|
$main::updateUI->({tab=>"images", user=>$user, type=>"update", uuid=>$register{$path}->{'uuid'}, status=>$status, message=>"ERROR Over quota (". overQuotas($virtualsize, ($istoragepool==-1)) . ") moving: $name"});
|
|
2358
|
$postreply .= "Status=ERROR Over quota (". overQuotas($virtualsize, ($istoragepool==-1)) . ") moving: $name\n";
|
|
2359
|
} elsif ($istoragepool == -1 && $regstoragepool != -1 && $path =~ /\.master\.$type/) {
|
|
2360
|
$postreply .= "Status=ERROR Unable to move $name (master images are not supported on node storage)\n";
|
|
2361
|
$main::updateUI->({tab=>"images", user=>$user, type=>"update", uuid=>$register{$path}->{'uuid'}, status=>$status, message=>"Unable to move $name (master images are not supported on node storage)"});
|
|
2362
|
# Moving to node
|
|
2363
|
} elsif ($istoragepool == -1 && $regstoragepool != -1) {
|
|
2364
|
if (index($privileges,"a")!=-1 || index($privileges,"n")!=-1) { # Privilege "n" means user may use node storage
|
|
2365
|
if ($macip) {
|
|
2366
|
$newdirpath = "/mnt/stabile/node/$reguser/$restpath";
|
|
2367
|
$newpath = "$macip:$newdirpath";
|
|
2368
|
$newstoragepool = $istoragepool;
|
|
2369
|
# Check if image already exists in target dir
|
|
2370
|
$alreadyexists = `ssh -l irigo -i /var/www/.ssh/id_rsa_www -o UserKnownHostsFile=/dev/null -o StrictHostKeyChecking=no $macip "perl -e 'print 1 if -e q{/mnt/stabile/node/$reguser/$restpath}'"`;
|
|
2371
|
|
|
2372
|
} else {
|
|
2373
|
$postreply .= "Status=ERROR Unable to move $name (not enough space)\n";
|
|
2374
|
}
|
|
2375
|
} else {
|
|
2376
|
$postreply .= "Status=ERROR Unable to move $name (no node)\n";
|
|
2377
|
}
|
|
2378
|
# Moving from node
|
|
2379
|
} elsif ($regstoragepool == -1 && $istoragepool != -1 && $spools[$istoragepool]) {
|
|
2380
|
if (index($privileges,"a")!=-1 || index($privileges,"n")!=-1 && $mac) { # Privilege "n" means user may use node storage
|
|
2381
|
unless ( tie(%nodereg,'Tie::DBI', Hash::Merge::merge({table=>'nodes', key=>'mac', CLOBBER=>1}, $Stabile::dbopts)) ) {return 0};
|
|
2382
|
$macip = $nodereg{$mac}->{'ip'};
|
|
2383
|
untie %nodereg;
|
|
2384
|
$newpath = "$spools[$istoragepool]->{'path'}/$reguser/$restpath";
|
|
2385
|
$newdirpath = $newpath;
|
|
2386
|
$oldpath = "$macip:/mnt/stabile/node/$reguser/$restpath";
|
|
2387
|
$newstoragepool = $istoragepool;
|
|
2388
|
# Check if image already exists in target dir
|
|
2389
|
$alreadyexists = -e $newpath;
|
|
2390
|
} else {
|
|
2391
|
$postreply .= "Status=ERROR Unable to move $name - select node\n";
|
|
2392
|
}
|
|
2393
|
} elsif ($spools[$istoragepool]) { # User has access to storagepool
|
|
2394
|
$newpath = "$spools[$istoragepool]->{'path'}/$reguser/$restpath";
|
|
2395
|
$newdirpath = $newpath;
|
|
2396
|
$newstoragepool = $istoragepool;
|
|
2397
|
$alreadyexists = -e $newpath && -s $newpath;
|
|
2398
|
} else {
|
|
2399
|
$postreply .= "Status=ERROR Cannot move image. This image is used as master by: $child\n";
|
|
2400
|
}
|
|
2401
|
} else {
|
|
2402
|
$postreply .= "Status=ERROR Unable to move $path (bad status or pool $status, $reguser, $iuser, $regstoragepool, $istoragepool)\n" unless ($istoragepool eq '--' || $regstoragepool eq '--');
|
|
2403
|
}
|
|
2404
|
untie %userreg;
|
|
2405
|
|
|
2406
|
if ($alreadyexists && !$force) {
|
|
2407
|
$postreply = "Status=ERROR Image \"$name\" already exists in destination\n";
|
|
2408
|
return $postreply;
|
|
2409
|
}
|
|
2410
|
# Request actual move operation
|
|
2411
|
elsif ($newpath) {
|
|
2412
|
if ($newstoragepool == -1) {
|
|
2413
|
my $diruser = $iuser || $reguser;
|
|
2414
|
`ssh -l irigo -i /var/www/.ssh/id_rsa_www -o UserKnownHostsFile=/dev/null -o StrictHostKeyChecking=no $macip "/bin/mkdir -v /mnt/stabile/node/$diruser"`; # rsync will create the last dir if needed
|
|
2415
|
}
|
|
2416
|
if ($subdir && $istoragepool != -1) {
|
|
2417
|
my $fulldir = "$spools[$istoragepool]->{'path'}/$reguser$subdir";
|
|
2418
|
`/bin/mkdir -p "$fulldir"` unless -d $fulldir;
|
|
2419
|
}
|
|
2420
|
$uistatus = "moving";
|
|
2421
|
my $ug = new Data::UUID;
|
|
2422
|
my $tempuuid = $ug->create_str();
|
|
2423
|
|
|
2424
|
$register{$path}->{'status'} = $uistatus;
|
|
2425
|
$register{$newdirpath} = \%{$register{$path}}; # Clone db entry
|
|
2426
|
|
|
2427
|
if ($bschedule eq 'daily7' || $bschedule eq 'daily14') {
|
|
2428
|
$bschedule = "manually" if (!$spools[$regstoragepool]->{'rdiffenabled'} || !$spools[$regstoragepool]->{'lvm'});
|
|
2429
|
} elsif ($bschedule ne 'manually') {
|
|
2430
|
$bschedule = '';
|
|
2431
|
}
|
|
2432
|
|
|
2433
|
$register{$path}->{'uuid'} = $tempuuid; # Use new temp uuid for old image
|
|
2434
|
$register{$newdirpath}->{'storagepool'} = $newstoragepool;
|
|
2435
|
if ($newstoragepool == -1) {
|
|
2436
|
$register{$newdirpath}->{'mac'} = $mac;
|
|
2437
|
} else {
|
|
2438
|
$register{$newdirpath}->{'mac'} = '';
|
|
2439
|
}
|
|
2440
|
$register{$newdirpath}->{'user'} = $newuser;
|
|
2441
|
tied(%register)->commit;
|
|
2442
|
my $domuuid = $register{$path}->{'domains'};
|
|
2443
|
if ($status eq "used" || $status eq "paused" || $status eq "moving") {
|
|
2444
|
my $dom = $domreg{$domuuid};
|
|
2445
|
if ($dom->{'image'} eq $olddirpath) {
|
|
2446
|
$dom->{'image'} = $newdirpath;
|
|
2447
|
} elsif ($dom->{'image2'} eq $olddirpath) {
|
|
2448
|
$dom->{'image2'} = $newdirpath;
|
|
2449
|
} elsif ($dom->{'image3'} eq $olddirpath) {
|
|
2450
|
$dom->{'image3'} = $newdirpath;
|
|
2451
|
} elsif ($dom->{'image4'} eq $olddirpath) {
|
|
2452
|
$dom->{'image4'} = $newdirpath;
|
|
2453
|
}
|
|
2454
|
$dom->{'mac'} = $mac if ($newstoragepool == -1);
|
|
2455
|
if ($dom->{'system'} && $dom->{'system'} ne '--') {
|
|
2456
|
unless (tie(%sysreg,'Tie::DBI', Hash::Merge::merge({table=>'systems'}, $Stabile::dbopts)) ) {$res .= qq|{"status": "Error": "message": "Unable to access systems register"}|; return $res;};
|
|
2457
|
my $sys = $sysreg{$dom->{'system'}};
|
|
2458
|
$sys->{'image'} = $newdirpath if ($sys->{'image'} eq $olddirpath);
|
|
2459
|
untie %sysreg;
|
|
2460
|
}
|
|
2461
|
}
|
|
2462
|
my $cmd = qq|/usr/local/bin/steamExec $user $uistatus $status "$oldpath" "$newpath"|;
|
|
2463
|
`$cmd`;
|
|
2464
|
$main::syslogit->($user, "info", "$uistatus $type image $name ($oldpath -> $newpath) ($regstoragepool -> $istoragepool) ($register{$newdirpath}->{uuid})");
|
|
2465
|
return "$newdirpath\n";
|
|
2466
|
} else {
|
|
2467
|
return $postreply;
|
|
2468
|
}
|
|
2469
|
|
|
2470
|
}
|
|
2471
|
|
|
2472
|
sub locateNode {
|
|
2473
|
my ($virtualsize, $mac, $vcpu, $mem) = @_;
|
|
2474
|
$vcpu = $vcpu || 1;
|
|
2475
|
unless ( tie(%nodereg,'Tie::DBI', Hash::Merge::merge({table=>'nodes', key=>'mac'}, $Stabile::dbopts)) ) {return 0};
|
|
2476
|
my $macip;
|
|
2477
|
my $dmac;
|
|
2478
|
my $dindex;
|
|
2479
|
my $asleep;
|
|
2480
|
my $identity;
|
|
2481
|
my $node;
|
|
2482
|
if ($mac && $mac ne "--") { # A node was specified
|
|
2483
|
if (1024 * $nodestorageovercommission * $nodereg{$mac}->{'storfree'} > $virtualsize && $nodereg{$mac}->{'status'} eq 'running') {
|
|
2484
|
$node = $nodereg{$mac};
|
|
2485
|
}
|
|
2486
|
} else { # Locate a node
|
|
2487
|
require "$Stabile::basedir/cgi/servers.cgi";
|
|
2488
|
$Stabile::Servers::console = 1;
|
|
2489
|
my ($temp1, $temp2, $temp3, $temp4, $ahashref) = Stabile::Servers::locateTargetNode();
|
|
2490
|
my @avalues = values %$ahashref;
|
|
2491
|
my @sorted_values = (sort {$b->{'index'} <=> $a->{'index'}} @avalues);
|
|
2492
|
foreach my $snode (@sorted_values) {
|
|
2493
|
if (
|
|
2494
|
(1024 * $nodestorageovercommission * $snode->{'storfree'} > $virtualsize)
|
|
2495
|
&& ($snode->{'cpuindex'} > $vcpu)
|
|
2496
|
&& ($snode->{'memfree'} > $mem+512*1024)
|
|
2497
|
&& !($snode->{'maintenance'})
|
|
2498
|
&& ($snode->{'status'} eq 'running' || $snode->{'status'} eq 'asleep' || $snode->{'status'} eq 'waking')
|
|
2499
|
&& ($snode->{'index'} > 0)
|
|
2500
|
) {
|
|
2501
|
next if (!($mem) && $snode->{'identity'} eq 'local_kvm'); # Ugly hack - prevent moving images from default storage to local_kvm node
|
|
2502
|
$node = $snode;
|
|
2503
|
last;
|
|
2504
|
}
|
|
2505
|
}
|
|
2506
|
}
|
|
2507
|
$macip = $node->{'ip'};
|
|
2508
|
$dmac = $node->{'mac'};
|
|
2509
|
$dindex = $node->{'index'};
|
|
2510
|
$asleep = ($node->{'status'} eq 'asleep' || $node->{'status'} eq 'waking');
|
|
2511
|
$identity = $node->{'identity'};
|
|
2512
|
untie %nodereg;
|
|
2513
|
return ($dmac, $macip, $dindex, $asleep, $identity);
|
|
2514
|
}
|
|
2515
|
|
|
2516
|
sub do_getimagestatus {
|
|
2517
|
my ($image, $action) = @_;
|
|
2518
|
if ($help) {
|
|
2519
|
return <<END
|
|
2520
|
GET:image:
|
|
2521
|
Check if image already exists. Pass image name including suffix.
|
|
2522
|
END
|
|
2523
|
}
|
|
2524
|
my $res;
|
|
2525
|
$imagename = $params{'name'} || $image;
|
|
2526
|
foreach my $spool (@spools) {
|
|
2527
|
my $ipath = $spool->{'path'} . "/$user/$imagename";
|
|
2528
|
if ($register{$ipath}) {
|
|
2529
|
$res .= "Status=OK Image $ipath found with status $register{$ipath}->{'status'}\n";
|
|
2530
|
} elsif (-f "$ipath" && -s "$ipath") {
|
|
2531
|
$res .= "Status=OK Image $ipath found on disk, please wait for it to be updated in DB\n";
|
|
2532
|
}
|
|
2533
|
}
|
|
2534
|
$res .= "Status=ERROR Image $image not found\n" unless ($res);
|
|
2535
|
return $res;;
|
|
2536
|
}
|
|
2537
|
|
|
2538
|
# Check if image already exists.
|
|
2539
|
# Pass image name including suffix.
|
|
2540
|
sub imageExists {
|
|
2541
|
my $imagename = shift;
|
|
2542
|
foreach my $spool (@spools) {
|
|
2543
|
my $ipath = $spool->{'path'} . "/$user/$imagename";
|
|
2544
|
if ($register{$ipath}) {
|
|
2545
|
return $register{$ipath}->{'status'} || 1;
|
|
2546
|
} elsif (-e "$ipath") {
|
|
2547
|
return 1
|
|
2548
|
}
|
|
2549
|
}
|
|
2550
|
return '';
|
|
2551
|
}
|
|
2552
|
|
|
2553
|
# Pass image name including suffix.
|
|
2554
|
# Returns incremented name of an image which does not already exist.
|
|
2555
|
sub getValidName {
|
|
2556
|
my $imagename = shift;
|
|
2557
|
my $name = $imagename;
|
|
2558
|
my $type;
|
|
2559
|
if ($imagename =~ /(.+)\.(.+)/) {
|
|
2560
|
$name = $1;
|
|
2561
|
$type = $2;
|
|
2562
|
}
|
|
2563
|
if (imageExists($imagename)) {
|
|
2564
|
my $i = 1;
|
|
2565
|
while (imageExists("$name.$i.$type")) {$i++;};
|
|
2566
|
$imagename = "$name.$i.$type";
|
|
2567
|
}
|
|
2568
|
return $imagename;
|
|
2569
|
}
|
|
2570
|
|
|
2571
|
# Print list of available actions on objects
|
|
2572
|
sub do_plainhelp {
|
|
2573
|
my $res;
|
|
2574
|
$res .= header('text/plain') unless $console;
|
|
2575
|
$res .= <<END
|
|
2576
|
* new [size="size", name="name"]: Creates a new image
|
|
2577
|
* clone: Creates new clone of an image. A clone of a master image is a child of the master. A clone of a child or regular
|
|
2578
|
image is a regular copy.
|
|
2579
|
* convert: Creates a copy of a non-qcow2 image in qcow2 format
|
|
2580
|
* snapshot: Takes a qcow2 snapshot of the image. Server can not be running.
|
|
2581
|
* unsnap: Removes a qcow2 snapshot.
|
|
2582
|
* revert: Applies a snapshot, reverting the image to the state it was in, when the snapshot was taken.
|
|
2583
|
* master: Turns an image into a master image which child images may be cloned from. Image can not be in use.
|
|
2584
|
* unmaster: Turns a master image into a regular image, which can not be used to clone child images from.
|
|
2585
|
* backup: Backs up an image using rdiff-backup. Rdiff-backup must be enabled in admin server configuration. This is a
|
|
2586
|
very expensive operation, since typically the entire image must be read.
|
|
2587
|
* buildsystem [master="master image"]: Constructs one or optionally multiple servers, images and networks and assembles
|
|
2588
|
them in one app.
|
|
2589
|
* restore [backup="backup"]: Restores an image from a backup. The restore is named after the backup.
|
|
2590
|
* delete: Deletes an image. Use with care. Image can not be in use.
|
|
2591
|
* mount: Mounts an image for restorefiles and listfiles operations.
|
|
2592
|
* unmount: Unmounts an image
|
|
2593
|
END
|
|
2594
|
;
|
|
2595
|
return $res;
|
|
2596
|
}
|
|
2597
|
|
|
2598
|
# Print list of images
|
|
2599
|
# Showing a single image is also handled by specifying uuid or path in $curuuid or $curimg
|
|
2600
|
# When showing a single image a single action may be performed on image
|
|
2601
|
sub do_list {
|
|
2602
|
my ($img, $action, $obj) = @_;
|
|
2603
|
if ($help) {
|
|
2604
|
return <<END
|
|
2605
|
GET:image,uuid:
|
|
2606
|
Lists all the images a user has access to. This is also the default action for the endpoint, so if no action is specified this is what you get.
|
|
2607
|
The returned list may be filtered by specifying storagepool, type, name, path or uuid, like e.g.:
|
|
2608
|
|
|
2609
|
<a href="/stabile/images/type:user" target="_blank">/stabile/images/type:user</a>
|
|
2610
|
<a href="/stabile/images/name:test* AND storagepool:shared" target="_blank">/stabile/images/name:test* AND storagepool:shared</a>
|
|
2611
|
<a href="/stabile/images/storagepool:shared AND path:test*" target="_blank">/stabile/images/storagepool:shared AND path:test*</a>
|
|
2612
|
<a href="/stabile/images/name:* AND storagepool:all AND type:usercdroms" target="_blank">/stabile/images/name:* AND storagepool:all AND type:usercdroms</a>
|
|
2613
|
<a href="/stabile/images/[uuid]" target="_blank">/stabile/images/[uuid]</a>
|
|
2614
|
|
|
2615
|
storagepool may be either of: all, node, shared
|
|
2616
|
type may be either of: user, usermasters, commonmasters, usercdroms
|
|
2617
|
|
|
2618
|
May also be called as tablelist or tablelistall, for use by stash.
|
|
2619
|
|
|
2620
|
END
|
|
2621
|
}
|
|
2622
|
my $res;
|
|
2623
|
my $filter;
|
|
2624
|
my $storagepoolfilter;
|
|
2625
|
my $typefilter;
|
|
2626
|
my $pathfilter;
|
|
2627
|
my $uuidfilter;
|
|
2628
|
$curimg = $img if ($img);
|
|
2629
|
my $regimg = $register{$curimg};
|
|
2630
|
# if ($curimg && ($isadmin || $regimg->{'user'} eq $user || $regimg->{'user'} eq 'common') ) {
|
|
2631
|
if ($curimg) { # security is enforced below, we hope...
|
|
2632
|
$pathfilter = $curimg;
|
|
2633
|
} elsif ($uripath =~ /images(\.cgi)?\/(\?|)(name|storagepool|type|path)/) {
|
|
2634
|
$filter = $3 if ($uripath =~ /images(\.cgi)?\/.*name(:|=)(.+)/);
|
|
2635
|
$filter = $1 if ($filter =~ /(.*) AND storagepool/);
|
|
2636
|
$filter = $1 if ($filter =~ /(.*) AND type/);
|
|
2637
|
$filter = $1 if ($filter =~ /(.*)\*$/);
|
|
2638
|
$storagepoolfilter = $2 if ($uripath =~ /images(\.cgi)?\/.*storagepool:(\w+)/);
|
|
2639
|
$typefilter = $2 if ($uripath =~ /images(\.cgi)?\/.*type:(\w+)/);
|
|
2640
|
$typefilter = $2 if ($uripath =~ /images(\.cgi)?\/.*type=(\w+)/);
|
|
2641
|
$pathfilter = $2 if ($uripath =~ /images(\.cgi)?\/.*path:(.+)/);
|
|
2642
|
$pathfilter = $2 if ($uripath =~ /images(\.cgi)?\/.*path=(.+)/);
|
|
2643
|
} elsif ($uripath =~ /images(\.cgi)?\/(\w{8}-\w{4}-\w{4}-\w{4}-\w{12})\/?(\w*)/) {
|
|
2644
|
$uuidfilter = $2;
|
|
2645
|
$curaction = lc $3;
|
|
2646
|
}
|
|
2647
|
$uuidfilter = $options{u} unless $uuidfilter;
|
|
2648
|
|
|
2649
|
if ($uuidfilter && $curaction) {
|
|
2650
|
if ($imagereg{$uuidfilter}) {
|
|
2651
|
$curuuid = $uuidfilter;
|
|
2652
|
my $obj = getObj(%params);
|
|
2653
|
# Now perform the requested action
|
|
2654
|
my $objfunc = "obj_$curaction";
|
|
2655
|
if (defined &$objfunc) { # If a function named objfunc exists, call it
|
|
2656
|
$res = $objfunc->($obj);
|
|
2657
|
chomp $postreply;
|
|
2658
|
unless ($res) {
|
|
2659
|
$res .= qq|{"status": "OK", "message": "$postreply"}|;
|
|
2660
|
$res = join(", ", split("\n", $res));
|
|
2661
|
}
|
|
2662
|
unless ($curaction eq 'download') {
|
|
2663
|
$res = header('application/json; charset=UTF8') . $res unless ($console);
|
|
2664
|
}
|
|
2665
|
} else {
|
|
2666
|
$res .= header('application/json') unless $console;
|
|
2667
|
$res .= qq|{"status": "Error", "message": "Unknown image action: $curaction"}|;
|
|
2668
|
}
|
|
2669
|
} else {
|
|
2670
|
$res .= header('application/json') unless $console;
|
|
2671
|
$res .= qq|{"status": "Error", "message": "Unknown image $uuidfilter"}|;
|
|
2672
|
}
|
|
2673
|
return $res;
|
|
2674
|
}
|
|
2675
|
|
|
2676
|
|
|
2677
|
my %userregister; # User specific register
|
|
2678
|
|
|
2679
|
$res .= header('application/json; charset=UTF8') unless $console;
|
|
2680
|
unless (tie(%userreg,'Tie::DBI', Hash::Merge::merge({table=>'users', key=>'username', CLOBBER=>1}, $Stabile::dbopts)) ) {$res .= qq|{"status": "Error": "message": "Unable to access user register"}|; return $res;};
|
|
2681
|
|
|
2682
|
my @busers = @users;
|
|
2683
|
my @billusers = (tied %userreg)->select_where("billto = '$user'");
|
|
2684
|
push (@busers, $billto) if ($billto && $billto ne '--'); # We include images from 'parent' user
|
|
2685
|
push (@busers, @billusers) if (@billusers); # We include images from 'child' users
|
|
2686
|
untie %userreg;
|
|
2687
|
unless ( tie(%nodereg,'Tie::DBI', Hash::Merge::merge({table=>'nodes', key=>'mac', CLOBBER=>1}, $Stabile::dbopts)) ) {return 0};
|
|
2688
|
foreach my $u (@busers) {
|
|
2689
|
my @regkeys = (tied %register)->select_where("user = '$u'");
|
|
2690
|
foreach my $k (@regkeys) {
|
|
2691
|
my $valref = $register{$k};
|
|
2692
|
# Only update info for images the user has access to.
|
|
2693
|
if ($valref->{'user'} eq $u && (defined $spools[$valref->{'storagepool'}]->{'id'} || $valref->{'storagepool'}==-1)) {
|
|
2694
|
# Only list installable master images from billto account
|
|
2695
|
next if ($billto && ($billto ne $user) && ($u eq $billto) && ($valref->{'type'} ne 'qcow2' || $valref->{'installable'} ne 'true'));
|
|
2696
|
my $path = $valref->{'path'};
|
|
2697
|
my %val = %{$valref}; # Deference and assign to new array, effectively cloning object
|
|
2698
|
my $spool = $spools[$val{'storagepool'}];
|
|
2699
|
# Skip images which are in DB e.g. because of change of storage pool difinitions
|
|
2700
|
next unless ($val{'storagepool'}==-1 || $val{'path'} =~ /$spool->{'path'}/);
|
|
2701
|
$val{'virtualsize'} += 0;
|
|
2702
|
$val{'realsize'} += 0;
|
|
2703
|
$val{'size'} += 0;
|
|
2704
|
#$val{'lvm'} = 0+( (($spools[$val{'storagepool'}]->{"hostpath"} eq "local") && $spools[$val{'storagepool'}]->{"rdiffenabled"}) || $val{'storagepool'}==-1);
|
|
2705
|
if ($val{'storagepool'}==-1) {
|
|
2706
|
my $node = $nodereg{$val{'mac'}};
|
|
2707
|
$val{'lvm'} = 0+($node->{stor} eq 'lvm');
|
|
2708
|
} else {
|
|
2709
|
$val{'lvm'} = 0+$spool->{"lvm"};
|
|
2710
|
}
|
|
2711
|
# If image has a master, update the master with child info.
|
|
2712
|
# This info is specific to each user, so we don't store it in the db
|
|
2713
|
if ($valref->{'master'} && $register{$valref->{'master'}} && ((grep $_ eq $valref->{'user'}, @users))) {
|
|
2714
|
$register{$valref->{'master'}}->{'status'} = 'used';
|
|
2715
|
unless ($userregister{$val{'master'}}) { # If we have not yet parsed master, it is not yet in userregister, so put it there
|
|
2716
|
my %mval = %{$register{$val{'master'}}};
|
|
2717
|
$userregister{$val{'master'}} = \%mval;
|
|
2718
|
}
|
|
2719
|
# $userregister{$val{'master'}}->{'user'} = $u;
|
|
2720
|
$userregister{$val{'master'}}->{'status'} = 'used';
|
|
2721
|
if ($val{'domains'}) {
|
|
2722
|
$userregister{$val{'master'}}->{'domainnames'} .= ", " if ($userregister{$val{'master'}}->{'domainnames'});
|
|
2723
|
$userregister{$val{'master'}}->{'domainnames'} .= $val{'domainnames'};
|
|
2724
|
$userregister{$val{'master'}}->{'domainnames'} .= " (".$val{'user'}.")" if (index($privileges,"a")!=-1);
|
|
2725
|
|
|
2726
|
$userregister{$val{'master'}}->{'domains'} .= ", " if ($userregister{$val{'master'}}->{'domains'});
|
|
2727
|
$userregister{$val{'master'}}->{'domains'} .= $val{'domains'};
|
|
2728
|
}
|
|
2729
|
}
|
|
2730
|
my $status = $valref->{'status'};
|
|
2731
|
if ($rdiffenabled && ($userrdiffenabled || index($privileges,"a")!=-1) &&
|
|
2732
|
( ($spools[$valref->{'storagepool'}]->{'rdiffenabled'} &&
|
|
2733
|
($spools[$valref->{'storagepool'}]->{'lvm'} || $status eq 'unused' || $status eq 'used' || $status eq 'paused') )
|
|
2734
|
|| $valref->{'storagepool'}==-1 )
|
|
2735
|
) {
|
|
2736
|
$val{'backup'} = "" ;
|
|
2737
|
} else {
|
|
2738
|
$val{'backup'} = "disabled" ;
|
|
2739
|
}
|
|
2740
|
$val{'status'} = 'backingup' if ($status =~ /backingup/);
|
|
2741
|
$userregister{$path} = \%val unless ($userregister{$path});
|
|
2742
|
}
|
|
2743
|
}
|
|
2744
|
}
|
|
2745
|
untie(%nodereg);
|
|
2746
|
|
|
2747
|
my @uservalues;
|
|
2748
|
if ($filter || $storagepoolfilter || $typefilter || $pathfilter || $uuidfilter) { # List filtered images
|
|
2749
|
foreach $uvalref (values %userregister) {
|
|
2750
|
my $fmatch;
|
|
2751
|
my $smatch;
|
|
2752
|
my $tmatch;
|
|
2753
|
my $pmatch;
|
|
2754
|
my $umatch;
|
|
2755
|
$fmatch = 1 if (!$filter || $uvalref->{'name'}=~/$filter/i);
|
|
2756
|
$smatch = 1 if (!$storagepoolfilter || $storagepoolfilter eq 'all'
|
|
2757
|
|| ($storagepoolfilter eq 'node' && $uvalref->{'storagepool'}==-1)
|
|
2758
|
|| ($storagepoolfilter eq 'shared' && $uvalref->{'storagepool'}>=0)
|
|
2759
|
);
|
|
2760
|
$tmatch = 1 if (!$typefilter || $typefilter eq 'all'
|
|
2761
|
|| ($typefilter eq 'user' && $uvalref->{'user'} eq $user
|
|
2762
|
# && $uvalref->{'type'} ne 'iso'
|
|
2763
|
# && $uvalref->{'path'} !~ /\.master\.qcow2$/
|
|
2764
|
)
|
|
2765
|
|| ($typefilter eq 'usermasters' && $uvalref->{'user'} eq $user && $uvalref->{'path'} =~ /\.master\.qcow2$/)
|
|
2766
|
|| ($typefilter eq 'usercdroms' && $uvalref->{'user'} eq $user && $uvalref->{'type'} eq 'iso')
|
|
2767
|
|| ($typefilter eq 'commonmasters' && $uvalref->{'user'} ne $user && $uvalref->{'path'} =~ /\.master\.qcow2$/)
|
|
2768
|
|| ($typefilter eq 'commoncdroms' && $uvalref->{'user'} ne $user && $uvalref->{'type'} eq 'iso')
|
|
2769
|
);
|
|
2770
|
$pmatch = 1 if ($pathfilter && $uvalref->{'path'}=~/$pathfilter/i);
|
|
2771
|
$umatch = 1 if ($uvalref->{'uuid'} eq $uuidfilter);
|
|
2772
|
if ((!$pathfilter &&!$uuidfilter && $fmatch && $smatch && $tmatch) || $pmatch) {
|
|
2773
|
push @uservalues,$uvalref if ($uvalref->{'uuid'});
|
|
2774
|
} elsif ($umatch && $uvalref->{'uuid'}) {
|
|
2775
|
push @uservalues,$uvalref;
|
|
2776
|
last;
|
|
2777
|
}
|
|
2778
|
}
|
|
2779
|
} else {
|
|
2780
|
@uservalues = values %userregister;
|
|
2781
|
}
|
|
2782
|
|
|
2783
|
# Sort @uservalues
|
|
2784
|
@uservalues = (sort {$a->{'name'} cmp $b->{'name'}} @uservalues); # Always sort by name first
|
|
2785
|
my $sort = 'status';
|
|
2786
|
$sort = $2 if ($uripath =~ /sort\((\+|\-)(\S+)\)/);
|
|
2787
|
my $reverse;
|
|
2788
|
$reverse = 1 if ($1 eq '-');
|
|
2789
|
if ($reverse) { # sort reverse
|
|
2790
|
if ($sort =~ /realsize|virtualsize|size/) {
|
|
2791
|
@uservalues = (sort {$b->{$sort} <=> $a->{$sort}} @uservalues); # Sort as number
|
|
2792
|
} else {
|
|
2793
|
@uservalues = (sort {$b->{$sort} cmp $a->{$sort}} @uservalues); # Sort as string
|
|
2794
|
}
|
|
2795
|
} else {
|
|
2796
|
if ($sort =~ /realsize|virtualsize|size/) {
|
|
2797
|
@uservalues = (sort {$a->{$sort} <=> $b->{$sort}} @uservalues); # Sort as number
|
|
2798
|
} else {
|
|
2799
|
@uservalues = (sort {$a->{$sort} cmp $b->{$sort}} @uservalues); # Sort as string
|
|
2800
|
}
|
|
2801
|
}
|
|
2802
|
|
|
2803
|
if ($uuidfilter || $curimg) {
|
|
2804
|
if (scalar @uservalues > 1) { # prioritize user's own images
|
|
2805
|
foreach my $val (@uservalues) {
|
|
2806
|
if ($val->{'user'} eq 'common') {
|
|
2807
|
next;
|
|
2808
|
} else {
|
|
2809
|
$json_text = to_json($val, {pretty => 1});
|
|
2810
|
}
|
|
2811
|
}
|
|
2812
|
} else {
|
|
2813
|
$json_text = to_json($uservalues[0], {pretty => 1}) if (@uservalues);
|
|
2814
|
}
|
|
2815
|
} else {
|
|
2816
|
# $json_text = JSON->new->canonical(1)->pretty(1)->encode(\@uservalues) if (@uservalues);
|
|
2817
|
$json_text = to_json(\@uservalues, {pretty => 1}) if (@uservalues);
|
|
2818
|
}
|
|
2819
|
$json_text = "{}" unless $json_text;
|
|
2820
|
$json_text =~ s/""/"--"/g;
|
|
2821
|
$json_text =~ s/null/"--"/g;
|
|
2822
|
$json_text =~ s/"notes" {0,1}: {0,1}"--"/"notes":""/g;
|
|
2823
|
$json_text =~ s/"installable" {0,1}: {0,1}"(true|false)"/"installable":$1/g;
|
|
2824
|
|
|
2825
|
if ($action eq 'tablelist' || $action eq 'tablelistall') {
|
|
2826
|
my $t2 = Text::SimpleTable->new(36,26,5,20,14,10,7);
|
|
2827
|
$t2->row('uuid', 'name', 'type', 'domainnames', 'virtualsize', 'user', 'status');
|
|
2828
|
$t2->hr;
|
|
2829
|
my $pattern = $options{m};
|
|
2830
|
foreach $rowref (@uservalues){
|
|
2831
|
next unless ($action eq 'tablelistall' || $rowref->{'user'} eq $user);
|
|
2832
|
if ($pattern) {
|
|
2833
|
my $rowtext = $rowref->{'uuid'} . " " . $rowref->{'name'} . " " . $rowref->{'type'} . " " . $rowref->{'domainnames'}
|
|
2834
|
. " " . $rowref->{'virtualsize'} . " " . $rowref->{'user'} . " " . $rowref->{'status'};
|
|
2835
|
$rowtext .= " " . $rowref->{'mac'} if ($isadmin);
|
|
2836
|
next unless ($rowtext =~ /$pattern/i);
|
|
2837
|
}
|
|
2838
|
$t2->row($rowref->{'uuid'}, $rowref->{'name'}, $rowref->{'type'}, $rowref->{'domainnames'}||'--',
|
|
2839
|
$rowref->{'virtualsize'}, $rowref->{'user'}, $rowref->{'status'});
|
|
2840
|
}
|
|
2841
|
$res .= $t2->draw;
|
|
2842
|
} elsif ($console) {
|
|
2843
|
$res .= Dumper(\@uservalues);
|
|
2844
|
} else {
|
|
2845
|
$res .= $json_text;
|
|
2846
|
}
|
|
2847
|
return $res;
|
|
2848
|
}
|
|
2849
|
|
|
2850
|
# Internal action for looking up a uuid or part of a uuid and returning the complete uuid
|
|
2851
|
sub do_uuidlookup {
|
|
2852
|
my ($img, $action) = @_;
|
|
2853
|
if ($help) {
|
|
2854
|
return <<END
|
|
2855
|
GET:image,path:
|
|
2856
|
END
|
|
2857
|
}
|
|
2858
|
my $res;
|
|
2859
|
$res .= header('text/plain') unless $console;
|
|
2860
|
my $u = $options{u};
|
|
2861
|
$u = $curuuid unless ($u || $u eq '0');
|
|
2862
|
my $ruuid;
|
|
2863
|
if ($u || $u eq '0') {
|
|
2864
|
foreach my $uuid (keys %register) {
|
|
2865
|
if (($register{$uuid}->{'user'} eq $user || $register{$uuid}->{'user'} eq 'common' || $fulllist)
|
|
2866
|
&& ($register{$uuid}->{'uuid'} =~ /^$u/ || $register{$uuid}->{'name'} =~ /^$u/)) {
|
|
2867
|
$ruuid = $register{$uuid}->{'uuid'};
|
|
2868
|
last;
|
|
2869
|
}
|
|
2870
|
}
|
|
2871
|
if (!$ruuid && $isadmin) { # If no match and user is admin, do comprehensive lookup
|
|
2872
|
foreach $uuid (keys %register) {
|
|
2873
|
if ($register{$uuid}->{'uuid'} =~ /^$u/ || $register{$uuid}->{'name'} =~ /^$u/) {
|
|
2874
|
$ruuid = $register{$uuid}->{'uuid'};
|
|
2875
|
last;
|
|
2876
|
}
|
|
2877
|
}
|
|
2878
|
}
|
|
2879
|
}
|
|
2880
|
$res .= "$ruuid\n" if ($ruuid);
|
|
2881
|
return $res;
|
|
2882
|
}
|
|
2883
|
|
|
2884
|
# Internal action for showing a single image
|
|
2885
|
sub do_uuidshow {
|
|
2886
|
my ($img, $action) = @_;
|
|
2887
|
if ($help) {
|
|
2888
|
return <<END
|
|
2889
|
GET:image,path:
|
|
2890
|
END
|
|
2891
|
}
|
|
2892
|
my $res;
|
|
2893
|
$res .= header('text/plain') unless $console;
|
|
2894
|
my $u = $options{u};
|
|
2895
|
$u = $curuuid unless ($u || $u eq '0');
|
|
2896
|
if ($u || $u eq '0') {
|
|
2897
|
foreach my $uuid (keys %register) {
|
|
2898
|
if (($register{$uuid}->{'user'} eq $user || $register{$uuid}->{'user'} eq 'common' || index($privileges,"a")!=-1)
|
|
2899
|
&& $register{$uuid}->{'uuid'} =~ /^$u/) {
|
|
2900
|
my %hash = %{$register{$uuid}};
|
|
2901
|
delete $hash{'action'};
|
|
2902
|
my $dump = Dumper(\%hash);
|
|
2903
|
$dump =~ s/undef/"--"/g;
|
|
2904
|
$res .= $dump;
|
|
2905
|
last;
|
|
2906
|
}
|
|
2907
|
}
|
|
2908
|
}
|
|
2909
|
return $res;
|
|
2910
|
}
|
|
2911
|
|
|
2912
|
sub do_updatebilling {
|
|
2913
|
my ($img, $action) = @_;
|
|
2914
|
if ($help) {
|
|
2915
|
return <<END
|
|
2916
|
GET:image,path:
|
|
2917
|
END
|
|
2918
|
}
|
|
2919
|
my $res;
|
|
2920
|
$res .= header('text/plain') unless ($console);
|
|
2921
|
updateBilling($params{"event"});
|
|
2922
|
$res .= "Status=OK Updated billing for $user\n";
|
|
2923
|
return $res;
|
|
2924
|
}
|
|
2925
|
|
|
2926
|
# If used with the -f switch ($fulllist) from console, all users images are updated in the db
|
|
2927
|
# If used with the -p switch ($fullupdate), also updates status information (ressource intensive - runs through all domains)
|
|
2928
|
sub dont_updateregister {
|
|
2929
|
my ($img, $action) = @_;
|
|
2930
|
my $res;
|
|
2931
|
if ($help) {
|
|
2932
|
return <<END
|
|
2933
|
GET:image,path:
|
|
2934
|
END
|
|
2935
|
}
|
|
2936
|
return "Status=ERROR You must be an admin to do this!\n" unless ($isadmin);
|
|
2937
|
$fullupdate = 1 if ((!$fullupdate && $params{'fullupdate'}) || $action eq 'fullupdateregister');
|
|
2938
|
my $force = $params{'force'};
|
|
2939
|
Updateregister($force);
|
|
2940
|
$res .= "Status=OK Updated image register for " . join(', ', @users) . "\n";
|
|
2941
|
}
|
|
2942
|
|
|
2943
|
sub do_urlupload {
|
|
2944
|
my ($img, $action) = @_;
|
|
2945
|
if ($help) {
|
|
2946
|
return <<END
|
|
2947
|
GET:image,path:
|
|
2948
|
END
|
|
2949
|
}
|
|
2950
|
my $res;
|
|
2951
|
$res .= header('application/json') unless ($console);
|
|
2952
|
if ($params{'probe'} && $params{'url'}) {
|
|
2953
|
my $url = $params{'url'};
|
|
2954
|
my $cmd = qq!curl --http1.1 -kIL "$url" 2>&1!;
|
|
2955
|
my $headers = `$cmd`;
|
|
2956
|
my $filename;
|
|
2957
|
my $filesize = 0;
|
|
2958
|
$filename = $1 if ($headers =~ /content-disposition: .+filename="(.+)"/i);
|
|
2959
|
$filesize = $1 if ($headers =~ /content-length: (\d+)/i);
|
|
2960
|
my $ok;
|
|
2961
|
if (!$filename) {
|
|
2962
|
my $cmd = qq[curl --http1.1 -kIL "$url" 2>&1 | grep -i " 200 OK"];
|
|
2963
|
$ok = `$cmd`; chomp $ok;
|
|
2964
|
$filename = `basename "$url"` if ($ok);
|
|
2965
|
chomp $filename;
|
|
2966
|
}
|
|
2967
|
if ($filename =~ /\S+\.(vmdk|img|vhd|vhdx|qcow|qcow2|vdi|iso)$/) {
|
|
2968
|
$filename = $2 if ($filename =~ /(=|\?)(.+)/);
|
|
2969
|
$filename = $2 if ($filename =~ /(=|\?)(.+)/);
|
|
2970
|
$filename = getValidName($filename);
|
|
2971
|
my $filepath = $spools[0]->{'path'} . "/$user/$filename";
|
|
2972
|
$res .= qq|{"status": "OK", "name": "$filename", "message": "200 OK", "size": $filesize, "path": "$filepath"}|;
|
|
2973
|
} else {
|
|
2974
|
$res .= qq|{"status": "ERROR", "message": "An image file cannot be downloaded from this URL.", "url": "$url", "filename": "$filename"}|;
|
|
2975
|
}
|
|
2976
|
} elsif ($params{'path'} && $params{'url'} && $params{'name'} && defined $params{'size'}) {
|
|
2977
|
my $imagepath = $params{'path'};
|
|
2978
|
my $imagename = $params{'name'};
|
|
2979
|
my $imagesize = $params{'size'};
|
|
2980
|
my $imageurl = $params{'url'};
|
|
2981
|
if (-e "$imagepath.meta" && $imagepath =~ /\.master\.qcow2$/) { # This image is being downloaded by pressurecontrol
|
|
2982
|
$res .= qq|{"status": "OK", "name": "$imagename", "message": "Now downloading master", "path": "$imagepath"}|;
|
|
2983
|
} elsif (-e $imagepath) {
|
|
2984
|
$res .= qq|{"status": "ERROR", "message": "An image file with this name already exists on the server.", "name": "$imagename"}|;
|
|
2985
|
} elsif ($imagepath !~ /^$spools[0]->{'path'}\/$user\/.+/) {
|
|
2986
|
$res .= qq|{"status": "ERROR", "message": "Invalid path"}|;
|
|
2987
|
} elsif (overQuotas($virtualsize)) {
|
|
2988
|
$res .= qq|{"status": "ERROR", "message": "Over quota (". overQuotas($virtualsize) . ") uploading: $imagename"}|;
|
|
2989
|
} elsif (overStorage($imagesize, 0)) {
|
|
2990
|
$res .= qq|{"status": "ERROR", "message": "Out of storage in destination pool uploading: $imagename"}|;
|
|
2991
|
} elsif ($imagepath =~ /^$spools[0]->{'path'}.+\.(vmdk|img|vhd|vhdx|qcow|qcow2|vdi|iso)$/) {
|
|
2992
|
my $imagetype = $1;
|
|
2993
|
my $ug = new Data::UUID;
|
|
2994
|
my $newuuid = $ug->create_str();
|
|
2995
|
my $name = $imagename;
|
|
2996
|
$name = $1 if ($name =~ /(.+)\.(vmdk|img|vhd|vhdx|qcow|qcow2|vdi|iso)$/);
|
|
2997
|
$register{$imagepath} = {
|
|
2998
|
uuid => $newuuid,
|
|
2999
|
path => $imagepath,
|
|
3000
|
name => $name,
|
|
3001
|
user => $user,
|
|
3002
|
type => $imagetype,
|
|
3003
|
virtualsize => $imagesize,
|
|
3004
|
realsize => $imagesize,
|
|
3005
|
size => $imagesize,
|
|
3006
|
storagepool => 0,
|
|
3007
|
status => 'uploading'
|
|
3008
|
};
|
|
3009
|
`/bin/echo uploading > "$imagepath.meta"`;
|
|
3010
|
eval {
|
|
3011
|
my $daemon = Proc::Daemon->new(
|
|
3012
|
work_dir => '/usr/local/bin',
|
|
3013
|
exec_command => "perl -U steamExec $user urluploading unused \"$imagepath\" \"$imageurl\""
|
|
3014
|
) or do {$postreply .= "Status=ERROR $@\n";};
|
|
3015
|
my $pid = $daemon->Init();
|
|
3016
|
$main::syslogit->($user, "info", "urlupload $imageurl, $imagepath");
|
|
3017
|
1;
|
|
3018
|
} or do {$res .= qq|{"status": "ERROR", "message": "ERROR $@"}|;};
|
|
3019
|
$res .= qq|{"status": "OK", "name": "$imagename", "message": "Now uploading", "path": "$imagepath"}|;
|
|
3020
|
}
|
|
3021
|
} elsif ($params{'path'} && $params{'getsize'}) {
|
|
3022
|
my $imagepath = $params{'path'};
|
|
3023
|
if (!(-e $imagepath)) {
|
|
3024
|
$res .= qq|{"status": "ERROR", "message": "Image not found.", "path": "$imagepath"}|;
|
|
3025
|
} elsif ($imagepath !~ /^$spools[0]->{'path'}\/$user\/.+/ && $imagepath !~ /^$spools[0]->{'path'}\/common\/.+/) {
|
|
3026
|
$res .= qq|{"status": "ERROR", "message": "Invalid path"}|;
|
|
3027
|
} else {
|
|
3028
|
my @stat = stat($imagepath);
|
|
3029
|
my $imagesize = $stat[7];
|
|
3030
|
$res .= qq|{"status": "OK", "size": $imagesize, "path": "$imagepath"}|;
|
|
3031
|
}
|
|
3032
|
}
|
|
3033
|
return $res;
|
|
3034
|
}
|
|
3035
|
|
|
3036
|
sub do_upload {
|
|
3037
|
my ($img, $action) = @_;
|
|
3038
|
if ($help) {
|
|
3039
|
return <<END
|
|
3040
|
POST:image,path:
|
|
3041
|
END
|
|
3042
|
}
|
|
3043
|
my $res;
|
|
3044
|
$res .= header("text/html") unless ($console);
|
|
3045
|
|
|
3046
|
my $uname = $params{'name'};
|
|
3047
|
|
|
3048
|
my($name, $dirpath, $suffix) = fileparse($uname, (".vmdk", ".img", ".vhd", ".vhdx", ".qcow", ".qcow2", ".vdi", ".iso"));
|
|
3049
|
|
|
3050
|
$name = $1 if ($name =~ /^\.+(.*)/); # Don't allow hidden files
|
|
3051
|
# my $f = lc $name;
|
|
3052
|
my $f = $name;
|
|
3053
|
$f = $spools[0]->{'path'} . "/$user/$f$suffix";
|
|
3054
|
|
|
3055
|
my $chunk = int($params{'chunk'});
|
|
3056
|
my $chunks = int($params{'chunks'});
|
|
3057
|
|
|
3058
|
if ($chunk == 0 && -e $f) {
|
|
3059
|
$res .= qq|Error: File $f already exists $name|;
|
|
3060
|
} else {
|
|
3061
|
open (FILE, ">>$f");
|
|
3062
|
|
|
3063
|
if ($params{'file'}) {
|
|
3064
|
my $uh = $Stabile::q->upload("file");
|
|
3065
|
while ( <$uh> ) {
|
|
3066
|
print FILE;
|
|
3067
|
}
|
|
3068
|
close FILE;
|
|
3069
|
|
|
3070
|
if ($chunk == 0) {
|
|
3071
|
`/usr/local/bin/steamExec updateimagestatus "$f" uploading`;
|
|
3072
|
}
|
|
3073
|
if ($chunk >= ($chunks - 1) ) { # Done
|
|
3074
|
unlink("$f.meta");
|
|
3075
|
`/usr/local/bin/steamExec updateimagestatus "$f" unused`;
|
|
3076
|
} else {
|
|
3077
|
my $upload_meta_data = "status=uploading&chunk=$chunk&chunks=$chunks";
|
|
3078
|
`echo "$upload_meta_data" > "$f.meta"`;
|
|
3079
|
}
|
|
3080
|
$res .= qq|OK: Chunk $chunk uploaded of $name|;
|
|
3081
|
} else {
|
|
3082
|
$res .= qq|OK: No file $name.|;
|
|
3083
|
}
|
|
3084
|
}
|
|
3085
|
return $res;
|
|
3086
|
}
|
|
3087
|
|
|
3088
|
# .htaccess files are created hourly, giving the image user access
|
|
3089
|
# when download is clicked by another user (in @users, so with permission), this user is also given access until .htaccess is rewritten
|
|
3090
|
sub Download {
|
|
3091
|
my ($f, $action, $argref) = @_;
|
|
3092
|
# my ($name, $managementlink, $upgradelink, $terminallink, $version) = @{$argref};
|
|
3093
|
if ($help) {
|
|
3094
|
return <<END
|
|
3095
|
GET:image,console:
|
|
3096
|
Returns http redirection with URL to download image
|
|
3097
|
END
|
|
3098
|
}
|
|
3099
|
$baseurl = $argref->{baseurl} || $baseurl;
|
|
3100
|
my %uargs = %{$argref};
|
|
3101
|
$f = $uargs{'image'} unless ($f);
|
|
3102
|
$baseurl = $uargs{'baseurl'} || $baseurl;
|
|
3103
|
$console = $console || $uargs{'console'};
|
|
3104
|
my $res;
|
|
3105
|
my $uf = URI::Escape::uri_unescape($f);
|
|
3106
|
if (! $f) {
|
|
3107
|
$res .= header('text/html', '500 Internal Server Error') unless ($console);
|
|
3108
|
$res .= "Status=ERROR You must specify an image.\n";
|
|
3109
|
}
|
|
3110
|
my $txt = <<EOT
|
|
3111
|
order deny,allow
|
|
3112
|
AuthName "Download"
|
|
3113
|
AuthType None
|
|
3114
|
TKTAuthLoginURL $baseurl/login/
|
|
3115
|
TKTAuthIgnoreIP on
|
|
3116
|
deny from all
|
|
3117
|
Satisfy any
|
|
3118
|
require user $user
|
|
3119
|
require user $tktuser
|
|
3120
|
Options -Indexes
|
|
3121
|
EOT
|
|
3122
|
;
|
|
3123
|
my $fid;
|
|
3124
|
my $fpath;
|
|
3125
|
foreach my $p (@spools) {
|
|
3126
|
foreach my $suser (@users) {
|
|
3127
|
my $dir = $p->{'path'};
|
|
3128
|
my $id = $p->{'id'};
|
|
3129
|
if (-d "$dir/$suser" && $uf =~ /\/$suser\//) {
|
|
3130
|
if ($uf =~ /$dir\/(.+)\/(.+)/) {
|
|
3131
|
my $filename = $2;
|
|
3132
|
utf8::encode($filename);
|
|
3133
|
utf8::decode($filename);
|
|
3134
|
$fpath = "$1/" . URI::Escape::uri_escape($filename);
|
|
3135
|
#$fpath = "$1/" . $filename;
|
|
3136
|
`chmod o+rw "$uf"`;
|
|
3137
|
`/bin/echo "$txt" > "$dir/$suser/.htaccess"`;
|
|
3138
|
`chmod 644 "$dir/$suser/.htaccess"`;
|
|
3139
|
`/bin/mkdir "$Stabile::basedir/download"` unless (-e "$Stabile::basedir/download");
|
|
3140
|
`/bin/ln -s "$dir" "$Stabile::basedir/download/$id"` unless (-e "$Stabile::basedir/download/$id");
|
|
3141
|
$fid = $id;
|
|
3142
|
last;
|
|
3143
|
}
|
|
3144
|
}
|
|
3145
|
}
|
|
3146
|
}
|
|
3147
|
if (($fid || $fid eq '0') && $fpath && -e "$f") {
|
|
3148
|
my $fileurl = "$baseurl/download/$fid/$fpath";
|
|
3149
|
if ($console) {
|
|
3150
|
$res .= header(). $fileurl;
|
|
3151
|
} else {
|
|
3152
|
$res .= "Status: 302 Moved\nLocation: $fileurl\n\n";
|
|
3153
|
$res .= "$fileurl\n";
|
|
3154
|
}
|
|
3155
|
} else {
|
|
3156
|
$res .= header('text/html', '500 Internal Server Error') unless ($console);
|
|
3157
|
$res .= "Status=ERROR File not found $f, $fid, $fpath, $uargs{image}\n";
|
|
3158
|
}
|
|
3159
|
return $res;
|
|
3160
|
}
|
|
3161
|
|
|
3162
|
|
|
3163
|
sub Liststoragedevices {
|
|
3164
|
my ($image, $action, $obj) = @_;
|
|
3165
|
if ($help) {
|
|
3166
|
return <<END
|
|
3167
|
GET::
|
|
3168
|
Returns available physical disks and partitions.
|
|
3169
|
Partitions currently used for holding backup and primary images directories are marked as such.
|
|
3170
|
May also be called as 'getimagesdevice', 'getbackupdevice', 'listimagesdevices' or 'listbackupdevices'.
|
|
3171
|
END
|
|
3172
|
}
|
|
3173
|
unless ($isadmin || ($user eq $engineuser)) {
|
|
3174
|
return '' if ($action eq 'getimagesdevice' || $action eq 'getbackupdevice');
|
|
3175
|
return qq|[]|;
|
|
3176
|
}
|
|
3177
|
my %devs;
|
|
3178
|
# Check if we have unmounted ZFS file systems
|
|
3179
|
# if (`grep "stabile-images" /etc/stabile/config.cfg` && !(`df` =~ /stabile-images/)) {
|
|
3180
|
if (!(`df` =~ /stabile-images/)) {
|
|
3181
|
`zpool import stabile-images`;
|
|
3182
|
`zfs mount stabile-images`;
|
|
3183
|
`zfs mount stabile-images/images`;
|
|
3184
|
}
|
|
3185
|
if (!(`df` =~ /stabile-backup/)) {
|
|
3186
|
`zpool import stabile-backup`;
|
|
3187
|
`zfs mount stabile-backup`;
|
|
3188
|
`zfs mount stabile-backup/images`;
|
|
3189
|
`zfs mount stabile-backup/backup`;
|
|
3190
|
}
|
|
3191
|
# Add active and mounted filesystems
|
|
3192
|
my %filesystems;
|
|
3193
|
$cmd = q/LANG=en df -hT | tr -s ' ' ',' | jq -nR '[( input | split(",") ) as $keys | ( inputs | split(",") ) as $vals | [ [$keys, $vals] | transpose[] | {key:.[0],value:.[1]} ] | from_entries ]'/;
|
|
3194
|
my $json = `$cmd`;
|
|
3195
|
my $jobj = JSON::from_json($json);
|
|
3196
|
my $rootdev;
|
|
3197
|
my $backupdev;
|
|
3198
|
my $imagesdev;
|
|
3199
|
foreach my $fs (sort {$a->{'Filesystem'} cmp $b->{'Filesystem'}} @{$jobj}) {
|
|
3200
|
# Note that physical disk devicess in general may be either disks, partitions with regular file systems (like ext4) or zfs pools, which may contain many file systems
|
|
3201
|
if ($fs->{Filesystem} =~ /\/dev\/(.+)/) {
|
|
3202
|
next if ($fs->{Type} eq 'squashfs');
|
|
3203
|
next if ($fs->{Filesystem} =~ /\/dev\/loop/);
|
|
3204
|
my $name = $1;
|
|
3205
|
if ($name =~ /mapper\/(\w+-)(.+)/) {
|
|
3206
|
$name = "$1$2";
|
|
3207
|
}
|
|
3208
|
$fs->{Name} = $name;
|
|
3209
|
delete $fs->{on};
|
|
3210
|
my $mp = $fs->{Mounted};
|
|
3211
|
if ($fs->{Mounted} eq '/') {
|
|
3212
|
$rootdev = $name;
|
|
3213
|
} else {
|
|
3214
|
if ($backupdir =~ /^$fs->{Mounted}/) {
|
|
3215
|
next if ($action eq 'listimagesdevices'); # Current backup dev is not available as images dev
|
|
3216
|
$fs->{isbackupdev} = 1;
|
|
3217
|
$backupdev = $name;
|
|
3218
|
return $name if ($action eq 'getbackupdevice');
|
|
3219
|
}
|
|
3220
|
if ($tenderpathslist[0] =~ /^$fs->{Mounted}/) {
|
|
3221
|
next if ($action eq 'listbackupdevices'); # Current images dev is not available as backup dev
|
|
3222
|
$fs->{isimagesdev} = 1;
|
|
3223
|
$imagesdev = $name;
|
|
3224
|
return $name if ($action eq 'getimagesdevice');
|
|
3225
|
}
|
|
3226
|
}
|
|
3227
|
$fs->{dev} = $name;
|
|
3228
|
$fs->{nametype} = "$name ($fs->{Type} - " . ($mp?$mp:"not mounted") . " $fs->{Size})";
|
|
3229
|
$filesystems{$name} = $fs;
|
|
3230
|
} elsif ( $fs->{Type} eq 'zfs') {
|
|
3231
|
my $name = $fs->{Filesystem};
|
|
3232
|
# only include zfs pools but look for use as backup and images, exclude shapshots
|
|
3233
|
if ($name =~ /(.+)\/(.+)/
|
|
3234
|
&& !($name =~ /SNAPSHOT/)
|
|
3235
|
&& !($name =~ /stabile-backup\/images/)
|
|
3236
|
&& !($name =~ /stabile-backup\/node/)
|
|
3237
|
) {
|
|
3238
|
$name = $1;
|
|
3239
|
if ($fs->{Mounted} eq $backupdir) {
|
|
3240
|
if ($action eq 'listimagesdevices') {
|
|
3241
|
delete $filesystems{$name}; # not available for images - used for backup
|
|
3242
|
} else {
|
|
3243
|
$filesystems{$name}->{isbackupdev} = 1;
|
|
3244
|
$fs->{isbackupdev} = 1;
|
|
3245
|
$backupdev = $name;
|
|
3246
|
}
|
|
3247
|
return $name if ($action eq 'getbackupdevice');
|
|
3248
|
} elsif ($fs->{Mounted} eq $tenderpathslist[0]) {
|
|
3249
|
if ($action eq 'listbackupdevices') {
|
|
3250
|
delete $filesystems{$name}; # not available for backup - used for images
|
|
3251
|
} else {
|
|
3252
|
$filesystems{$name}->{isimagesdev} = 1;
|
|
3253
|
$fs->{isimagesdev} = 1;
|
|
3254
|
$imagesdev = $name;
|
|
3255
|
}
|
|
3256
|
return $name if ($action eq 'getimagesdevice');
|
|
3257
|
}
|
|
3258
|
$fs->{Name} = $name;
|
|
3259
|
$fs->{nametype} = "$name ($fs->{Type} $fs->{Size})";
|
|
3260
|
delete $fs->{on};
|
|
3261
|
$filesystems{$name} = $fs;
|
|
3262
|
}
|
|
3263
|
}
|
|
3264
|
}
|
|
3265
|
if ($action eq 'getbackupdevice' || $action eq 'getimagesdevice') {
|
|
3266
|
return $rootdev;
|
|
3267
|
}
|
|
3268
|
$filesystems{$rootdev}->{isbackupdev} = 1 unless ($backupdev || $action eq 'listimagesdevices');
|
|
3269
|
$filesystems{$rootdev}->{isimagesdev} = 1 unless ($imagesdev || $action eq 'listbackupdevices');
|
|
3270
|
# Lowercase keys
|
|
3271
|
foreach my $k (keys %filesystems) {
|
|
3272
|
my %hash = %{$filesystems{$k}};
|
|
3273
|
%hash = map { lc $_ => $hash{$_} } keys %hash;
|
|
3274
|
$filesystems{$k} = \%hash;
|
|
3275
|
}
|
|
3276
|
# Identify physical devices used for zfs
|
|
3277
|
$cmd = "zpool list -vH";
|
|
3278
|
my $zpools = `$cmd`;
|
|
3279
|
my $zdev;
|
|
3280
|
my %zdevs;
|
|
3281
|
|
|
3282
|
# Now parse the rather strange output with every other line representing physical dev
|
|
3283
|
foreach my $line (split "\n", $zpools) {
|
|
3284
|
my ($zname, $zsize, $zalloc) = split "\t", $line;
|
|
3285
|
if (!$zdev) {
|
|
3286
|
if ($zname =~ /stabile-/) {
|
|
3287
|
$zdev = {
|
|
3288
|
name=>$zname,
|
|
3289
|
size=>$zsize,
|
|
3290
|
alloc=>$zalloc
|
|
3291
|
}
|
|
3292
|
}
|
|
3293
|
} else {
|
|
3294
|
my $dev = $zsize;
|
|
3295
|
$zdev->{dev} = $dev;
|
|
3296
|
if ( $filesystems{$zdev->{name}}) {
|
|
3297
|
if (
|
|
3298
|
($action eq 'listimagesdevices' && $zdev->{name} =~ /backup/) ||
|
|
3299
|
($action eq 'listbackupdevices' && $zdev->{name} =~ /images/)
|
|
3300
|
) {
|
|
3301
|
delete $filesystems{$zdev->{name}}; # Don't include backup devs in images listing and vice-versa
|
|
3302
|
} else {
|
|
3303
|
if ($filesystems{$zdev->{name}}->{dev}) {
|
|
3304
|
$filesystems{$zdev->{name}}->{dev} .= " $dev";
|
|
3305
|
} else {
|
|
3306
|
$filesystems{$zdev->{name}}->{dev} = $dev;
|
|
3307
|
}
|
|
3308
|
# $filesystems{$zdev->{name}}->{nametype} =~ s/zfs/zfs pool/;
|
|
3309
|
}
|
|
3310
|
}
|
|
3311
|
$zdevs{$dev} = $zdev->{name};
|
|
3312
|
# $zdev = '';
|
|
3313
|
}
|
|
3314
|
}
|
|
3315
|
|
|
3316
|
# Add blockdevices
|
|
3317
|
$cmd = q|lsblk --json|;
|
|
3318
|
my $json2 = `$cmd`;
|
|
3319
|
my $jobj2 = JSON::from_json($json2);
|
|
3320
|
foreach my $fs (@{$jobj2->{blockdevices}}) {
|
|
3321
|
my $rootdev = $1 if ($fs->{name} =~ /([A-Za-z]+)\d*/);
|
|
3322
|
if ($fs->{children}) {
|
|
3323
|
foreach my $fs2 (@{$fs->{children}}) {
|
|
3324
|
next if ($fs2->{type} eq 'loop');
|
|
3325
|
next if ($fs2->{type} eq 'squashfs');
|
|
3326
|
next if ($fs2->{size} =~ /K$/);
|
|
3327
|
if ($filesystems{$fs2->{name}}) {
|
|
3328
|
$filesystems{$fs2->{name}}->{blocksize} = $fs2->{size};
|
|
3329
|
} elsif (!$zdevs{$fs2->{name}} && !$zdevs{$rootdev}) { # Don't add partitions already used for ZFS
|
|
3330
|
next if (($action eq 'listimagesdevices' || $action eq 'listbackupdevices') && $fs2->{mountpoint} eq '/');
|
|
3331
|
my $mp = $fs2->{mountpoint};
|
|
3332
|
$filesystems{$fs2->{name}} = {
|
|
3333
|
name=>$fs2->{name},
|
|
3334
|
blocksize=>$fs2->{size},
|
|
3335
|
mountpoint=>$mp,
|
|
3336
|
type=>$fs2->{type},
|
|
3337
|
nametype=> "$fs2->{name} ($fs2->{type} - " . ($mp?$mp:"not mounted") . " $fs2->{size})",
|
|
3338
|
dev=>$fs2->{name}
|
|
3339
|
}
|
|
3340
|
}
|
|
3341
|
}
|
|
3342
|
} elsif (!$zdevs{$fs->{name}}) { # Don't add disks already used for ZFS
|
|
3343
|
next if ($fs->{type} eq 'loop');
|
|
3344
|
next if ($fs->{type} eq 'squashfs');
|
|
3345
|
my $mp = $fs->{mountpoint};
|
|
3346
|
next if ($fs->{type} eq 'rom');
|
|
3347
|
$filesystems{$fs->{name}} = {
|
|
3348
|
name=>$fs->{name},
|
|
3349
|
blocksize=>$fs->{size},
|
|
3350
|
mountpoint=>$fs->{mountpoint},
|
|
3351
|
type=>$fs->{type},
|
|
3352
|
nametype=> "$fs->{name} ($fs->{type} - " . ($mp?$mp:"not mounted") . " $fs->{size})",
|
|
3353
|
}
|
|
3354
|
}
|
|
3355
|
}
|
|
3356
|
|
|
3357
|
# Identify physical devices used for lvm
|
|
3358
|
$cmd = "pvdisplay -c";
|
|
3359
|
my $pvs = `$cmd`;
|
|
3360
|
my @backupdevs; my @imagesdevs;
|
|
3361
|
foreach my $line (split "\n", $pvs) {
|
|
3362
|
my ($pvdev, $vgname) = split ":", $line;
|
|
3363
|
$pvdev = $1 if ($pvdev =~ /\s+(\S+)/);
|
|
3364
|
$pvdev = $1 if ($pvdev =~ /\/dev\/(\S+)/);
|
|
3365
|
if ($filesystems{"$vgname-backupvol"}) {
|
|
3366
|
push @backupdevs, $pvdev unless ($action eq 'listimagesdevices');
|
|
3367
|
} elsif ($filesystems{"$vgname-imagesvol"}) {
|
|
3368
|
push @imagesdevs, $pvdev unless ($action eq 'listbackupdevices');
|
|
3369
|
}
|
|
3370
|
if (@backupdevs) {
|
|
3371
|
$filesystems{"$vgname-backupvol"}->{dev} = join(" ", @backupdevs);
|
|
3372
|
$filesystems{"$vgname-backupvol"}->{nametype} = $filesystems{"$vgname-backupvol"}->{name} . " (lvm with " . $filesystems{"$vgname-backupvol"}->{type} . " on " . join(" ", @backupdevs) . " " . $filesystems{"$vgname-backupvol"}->{size} . ")";
|
|
3373
|
}
|
|
3374
|
if (@imagesdevs) {
|
|
3375
|
$filesystems{"$vgname-imagesvol"}->{dev} = join(" ", @imagesdevs);
|
|
3376
|
$filesystems{"$vgname-imagesvol"}->{nametype} = $filesystems{"$vgname-imagesvol"}->{name} . " (lvm with " . $filesystems{"$vgname-imagesvol"}->{type} . " on " . join(" ", @imagesdevs) . " " . $filesystems{"$vgname-imagesvol"}->{size} . ")";
|
|
3377
|
}
|
|
3378
|
delete $filesystems{$pvdev} if ($filesystems{$pvdev}); # Don't also list as physical device
|
|
3379
|
}
|
|
3380
|
my $jsonreply;
|
|
3381
|
if ($action eq 'getbackupdevice' || $action eq 'getimagesdevice') {
|
|
3382
|
return ''; # We should not get here
|
|
3383
|
} elsif ($action eq 'getstoragedevices') {
|
|
3384
|
return \%filesystems;
|
|
3385
|
} elsif ($action eq 'listimagesdevices') {
|
|
3386
|
$jsonreply .= qq|{"identifier": "name", "label": "nametype", "action": "$action", "items": |;
|
|
3387
|
my @vals = sort {$b->{'isimagesdev'} cmp $a->{'isimagesdev'}} values %filesystems;
|
|
3388
|
$jsonreply .= JSON->new->canonical(1)->pretty(1)->encode(\@vals);
|
|
3389
|
$jsonreply .= "}";
|
|
3390
|
} elsif ($action eq 'listbackupdevices') {
|
|
3391
|
$jsonreply .= qq|{"identifier": "name", "label": "nametype", "action": "$action", "items": |;
|
|
3392
|
my @vals = sort {$b->{'isbackupdev'} cmp $a->{'isbackupdev'}} values %filesystems;
|
|
3393
|
$jsonreply .= JSON->new->canonical(1)->pretty(1)->encode(\@vals);
|
|
3394
|
$jsonreply .= "}";
|
|
3395
|
} else {
|
|
3396
|
$jsonreply .= JSON->new->canonical(1)->pretty(1)->encode(\%filesystems);
|
|
3397
|
}
|
|
3398
|
return $jsonreply;
|
|
3399
|
}
|
|
3400
|
|
|
3401
|
sub do_liststoragepools {
|
|
3402
|
my ($image, $action) = @_;
|
|
3403
|
if ($help) {
|
|
3404
|
return <<END
|
|
3405
|
GET:dojo:
|
|
3406
|
Returns available storage pools. If parameter dojo is set, JSON is padded for Dojo use.
|
|
3407
|
END
|
|
3408
|
}
|
|
3409
|
my %npool = (
|
|
3410
|
"hostpath", "node",
|
|
3411
|
"path", "--",
|
|
3412
|
"name", "On node",
|
|
3413
|
"rdiffenabled", 1,
|
|
3414
|
"id", "-1");
|
|
3415
|
my @p = @spools;
|
|
3416
|
# Present node storage pool if user has sufficient privileges
|
|
3417
|
if (index($privileges,"a")!=-1 || index($privileges,"n")!=-1) {
|
|
3418
|
@p = (\%npool);
|
|
3419
|
push @p, @spools;
|
|
3420
|
}
|
|
3421
|
|
|
3422
|
my $jsonreply;
|
|
3423
|
$jsonreply .= "{\"identifier\": \"id\", \"label\": \"name\", \"items\":" if ($params{'dojo'});
|
|
3424
|
$jsonreply .= to_json(\@p, {pretty=>1});
|
|
3425
|
$jsonreply .= "}" if ($params{'dojo'});
|
|
3426
|
return $jsonreply;
|
|
3427
|
}
|
|
3428
|
|
|
3429
|
# List images available for attaching to server
|
|
3430
|
sub do_listimages {
|
|
3431
|
my ($img, $action) = @_;
|
|
3432
|
if ($help) {
|
|
3433
|
return <<END
|
|
3434
|
GET:image,image1:
|
|
3435
|
List images available for attaching to server. This is different from [list] since images must be unused and e.g. master images cannot be attached to a server.
|
|
3436
|
An image may be passed as parameter. This image is assumed to be already attached to the server, so it is included, even though it is not unused.
|
|
3437
|
If image1 is passed, we assume user is selecting an optional second image for the server, and an empty entry is included in the response, in order for the user to select "no image".
|
|
3438
|
END
|
|
3439
|
}
|
|
3440
|
my $res;
|
|
3441
|
$res .= header('application/json') unless ($console);
|
|
3442
|
my $curimg1 = URI::Escape::uri_unescape($params{'image1'});
|
|
3443
|
my @filteredfiles;
|
|
3444
|
my @curusers = @users;
|
|
3445
|
# If an admin user is looking at a server not belonging to him, allow him to see the server
|
|
3446
|
# users images
|
|
3447
|
if ($isadmin && $img && $img ne '--' && $register{$img} && $register{$img}->{'user'} ne $user) {
|
|
3448
|
@curusers = ($register{$img}->{'user'}, "common");
|
|
3449
|
}
|
|
3450
|
|
|
3451
|
foreach my $u (@curusers) {
|
|
3452
|
my @regkeys = (tied %register)->select_where("user = '$u'");
|
|
3453
|
foreach my $k (@regkeys) {
|
|
3454
|
my $val = $register{$k};
|
|
3455
|
if ($val->{'user'} eq $u && (defined $spools[$val->{'storagepool'}]->{'id'} || $val->{'storagepool'}==-1)) {
|
|
3456
|
my $f = $val->{'path'};
|
|
3457
|
next if ($f =~ /\/images\/dummy.qcow2/);
|
|
3458
|
my $itype = $val->{'type'};
|
|
3459
|
if ($itype eq "vmdk" || $itype eq "img" || $itype eq "vhd" || $itype eq "vhdx" || $itype eq "qcow" || $itype eq "qcow2" || $itype eq "vdi") {
|
|
3460
|
my $hit = 0;
|
|
3461
|
if ($f =~ /(.+)\.master\.$itype/) {$hit = 1;} # don't list master images for user selections
|
|
3462
|
if ($f =~ /(.+)\/common\//) {$hit = 1;} # don't list common images for user selections
|
|
3463
|
my $dbstatus = $val->{'status'};
|
|
3464
|
if ($dbstatus ne "unused") {$hit = 1;} # Image is in a transitional state - do not use
|
|
3465
|
if ($hit == 0 || $img eq $f) {
|
|
3466
|
my $hypervisor = ($itype eq "vmdk" || $itype eq "vhd" || $itype eq "vhdx" || $itype eq "vdi")?"vbox":"kvm";
|
|
3467
|
my $notes = $val->{'notes'};
|
|
3468
|
$notes = "" if $notes eq "--";
|
|
3469
|
my %img = ("path", $f, "name", $val->{'name'}, "hypervisor", $hypervisor, "notes", $notes,
|
|
3470
|
"uuid", $val->{'uuid'}, "master", $val->{'master'}, "managementlink", $val->{'managementlink'}||"",
|
|
3471
|
"upgradelink", $val->{'upgradelink'}||"", "terminallink", $val->{'terminallink'}||"", "version", $val->{'version'}||"",
|
|
3472
|
"appid", $val->{'appid'}||"");
|
|
3473
|
push @filteredfiles, \%img;
|
|
3474
|
}
|
|
3475
|
}
|
|
3476
|
}
|
|
3477
|
}
|
|
3478
|
}
|
|
3479
|
my %img = ("path", "--", "name", "--", "hypervisor", "kvm,vbox");
|
|
3480
|
if ($curimg1) {
|
|
3481
|
push @filteredfiles, \%img;
|
|
3482
|
}
|
|
3483
|
my $json_text = to_json(\@filteredfiles, {pretty=>1});
|
|
3484
|
$res .= qq/{"identifier": "path", "label": "name", "items": $json_text }/;
|
|
3485
|
return $res;
|
|
3486
|
}
|
|
3487
|
|
|
3488
|
sub Listcdroms {
|
|
3489
|
my ($image, $action) = @_;
|
|
3490
|
if ($help) {
|
|
3491
|
return <<END
|
|
3492
|
GET::
|
|
3493
|
Lists the CD roms a user has access to.
|
|
3494
|
END
|
|
3495
|
}
|
|
3496
|
my $res;
|
|
3497
|
$res .= header('application/json') unless ($console);
|
|
3498
|
my @filteredfiles;
|
|
3499
|
foreach my $u (@users) {
|
|
3500
|
my @regkeys = (tied %register)->select_where("user = '$u'");
|
|
3501
|
foreach my $k (@regkeys) {
|
|
3502
|
my $val = $register{$k};
|
|
3503
|
my $f = $val->{'path'};
|
|
3504
|
if ($val->{'user'} eq $u && (defined $spools[$val->{'storagepool'}]->{'id'} || $val->{'storagepool'}==-1)) {
|
|
3505
|
my $itype = $val->{'type'};
|
|
3506
|
if ($itype eq "iso" || $itype eq "toast") {
|
|
3507
|
$notes = $val->{'notes'} || '';
|
|
3508
|
if ($u eq $user) {
|
|
3509
|
$installable = "true";
|
|
3510
|
# $notes = "This CD/DVD may work just fine, however it has not been tested to work with Irigo Servers.";
|
|
3511
|
} else {
|
|
3512
|
$installable = $val->{'installable'} || 'false';
|
|
3513
|
# $notes = "This CD/DVD has been tested to work with Irigo Servers." unless $notes;
|
|
3514
|
}
|
|
3515
|
my %img = ("path", $f, "name", $val->{'name'}, "installable", $installable, "notes", $notes);
|
|
3516
|
push @filteredfiles, \%img;
|
|
3517
|
}
|
|
3518
|
}
|
|
3519
|
}
|
|
3520
|
}
|
|
3521
|
my %ioimg = ("path", "virtio", "name", "-- VirtIO disk (dummy) --");
|
|
3522
|
push @filteredfiles, \%ioimg;
|
|
3523
|
my %dummyimg = ("path", "--", "name", "-- No CD --");
|
|
3524
|
push @filteredfiles, \%dummyimg;
|
|
3525
|
# @filteredfiles = (sort {$a->{'name'} cmp $b->{'name'}} @filteredfiles); # Sort by status
|
|
3526
|
my $json_text = to_json(\@filteredfiles, {pretty=>1});
|
|
3527
|
$res .= qq/{"identifier": "path", "label": "name", "items": $json_text }/;
|
|
3528
|
return $res;
|
|
3529
|
}
|
|
3530
|
|
|
3531
|
sub do_listmasterimages {
|
|
3532
|
my ($image, $action) = @_;
|
|
3533
|
if ($help) {
|
|
3534
|
return <<END
|
|
3535
|
GET::
|
|
3536
|
Lists master images available to the current user.
|
|
3537
|
END
|
|
3538
|
}
|
|
3539
|
my $res;
|
|
3540
|
$res .= header('application/json') unless ($console);
|
|
3541
|
|
|
3542
|
my @filteredfiles;
|
|
3543
|
my @busers = @users;
|
|
3544
|
push (@busers, $billto) if ($billto && $billto ne $user); # We include images from 'parent' user
|
|
3545
|
|
|
3546
|
foreach my $u (@busers) {
|
|
3547
|
my @regkeys = (tied %register)->select_where("user = '$u'");
|
|
3548
|
foreach my $k (@regkeys) {
|
|
3549
|
my $valref = $register{$k};
|
|
3550
|
my $f = $valref->{'path'};
|
|
3551
|
if ($valref->{'user'} eq $u && (defined $spools[$valref->{'storagepool'}]->{'id'} || $valref->{'storagepool'}==-1)) {
|
|
3552
|
# Only list installable master images from billto account
|
|
3553
|
next if ($billto && $u eq $billto && $valref->{'installable'} ne 'true');
|
|
3554
|
|
|
3555
|
my $itype = $valref->{'type'};
|
|
3556
|
if ($itype eq "qcow2" && $f =~ /(.+)\.master\.$itype/) {
|
|
3557
|
my $installable;
|
|
3558
|
my $status = $valref->{'status'};
|
|
3559
|
my $notes;
|
|
3560
|
if ($u eq $user) {
|
|
3561
|
$installable = "true";
|
|
3562
|
$notes = "This master image may work just fine, however it has not been tested to work with Stabile.";
|
|
3563
|
} else {
|
|
3564
|
$installable = $valref->{'installable'};
|
|
3565
|
$notes = $valref->{'notes'};
|
|
3566
|
$notes = "This master image has been tested to work with Irigo Servers." unless $notes;
|
|
3567
|
}
|
|
3568
|
my %img = (
|
|
3569
|
"path", $f,
|
|
3570
|
"name", $valref->{'name'},
|
|
3571
|
"installable", $installable,
|
|
3572
|
"notes", $notes,
|
|
3573
|
"managementlink", $valref->{'managementlink'}||"",
|
|
3574
|
"upgradelink", $valref->{'upgradelink'}||"",
|
|
3575
|
"terminallink", $valref->{'terminallink'}||"",
|
|
3576
|
"image2", $valref->{'image2'}||"",
|
|
3577
|
"version", $valref->{'version'}||"",
|
|
3578
|
"appid", $valref->{'appid'}||"",
|
|
3579
|
"status", $status,
|
|
3580
|
"user", $valref->{'user'}
|
|
3581
|
);
|
|
3582
|
push @filteredfiles, \%img;
|
|
3583
|
}
|
|
3584
|
}
|
|
3585
|
}
|
|
3586
|
}
|
|
3587
|
my %img = ("path", "--", "name", "--", "installable", "true", "status", "unused");
|
|
3588
|
push @filteredfiles, \%img;
|
|
3589
|
my $json_text = to_json(\@filteredfiles);
|
|
3590
|
$res .= qq/{"identifier": "path", "label": "name", "items": $json_text }/;
|
|
3591
|
return $res;
|
|
3592
|
}
|
|
3593
|
|
|
3594
|
sub Updatebtime {
|
|
3595
|
my ($img, $action, $obj) = @_;
|
|
3596
|
if ($help) {
|
|
3597
|
return <<END
|
|
3598
|
GET:image:
|
|
3599
|
END
|
|
3600
|
}
|
|
3601
|
my $res;
|
|
3602
|
$curimg = $curimg || $img;
|
|
3603
|
my $imguser = $register{$curimg}->{'user'};
|
|
3604
|
if ($isadmin || $imguser eq $user) {
|
|
3605
|
my $btime;
|
|
3606
|
$btime = getBtime($curimg, $imguser) if ($imguser);
|
|
3607
|
if ($btime) {
|
|
3608
|
$register{$curimg}->{'btime'} = $btime ;
|
|
3609
|
$res .= "Status=OK $curimg has btime: " . scalar localtime( $btime ) . "\n";
|
|
3610
|
} else {
|
|
3611
|
$register{$curimg}->{'btime'} = '' ;
|
|
3612
|
$res .= "Status=OK $curimg has no btime\n";
|
|
3613
|
}
|
|
3614
|
} else {
|
|
3615
|
$res .= "Status=Error no access to $curimg\n";
|
|
3616
|
}
|
|
3617
|
return $res;
|
|
3618
|
}
|
|
3619
|
|
|
3620
|
sub Updateallbtimes {
|
|
3621
|
my ($img, $action) = @_;
|
|
3622
|
if ($help) {
|
|
3623
|
return <<END
|
|
3624
|
GET::
|
|
3625
|
END
|
|
3626
|
}
|
|
3627
|
if ($isadmin) {
|
|
3628
|
foreach my $path (keys %register) {
|
|
3629
|
my $imguser = $register{$path}->{'user'};
|
|
3630
|
my $btime = getBtime($path, $imguser);
|
|
3631
|
if ($btime) {
|
|
3632
|
$register{$path}->{'btime'} = $btime ;
|
|
3633
|
$postreply .= "Status=OK $register{$path}->{'name'} ($path) has btime: " . scalar localtime( $btime ) . "\n";
|
|
3634
|
} else {
|
|
3635
|
$postreply .= "Status=OK $register{$path}->{'name'} ($path) has no btime\n";
|
|
3636
|
}
|
|
3637
|
}
|
|
3638
|
} else {
|
|
3639
|
$postreply .= "Status=ERROR you are not allowed to do this.\n";
|
|
3640
|
}
|
|
3641
|
return $postreply;
|
|
3642
|
}
|
|
3643
|
|
|
3644
|
# Activate image from fuel
|
|
3645
|
sub Activate {
|
|
3646
|
my ($curimg, $action, $argref) = @_;
|
|
3647
|
if ($help) {
|
|
3648
|
return <<END
|
|
3649
|
GET:image, name, managementlink, upgradelink, terminallink, force:
|
|
3650
|
Activate an image from fuel storage, making it available for regular use.
|
|
3651
|
END
|
|
3652
|
}
|
|
3653
|
my %uargs = %{$argref};
|
|
3654
|
my $name = URI::Escape::uri_unescape($uargs{'name'});
|
|
3655
|
my $managementlink = URI::Escape::uri_unescape($uargs{'managementlink'});
|
|
3656
|
my $upgradelink = URI::Escape::uri_unescape($uargs{'upgradelink'});
|
|
3657
|
my $terminallink = URI::Escape::uri_unescape($uargs{'terminallink'});
|
|
3658
|
my $version = URI::Escape::uri_unescape($uargs{'version'}) || '1.0b';
|
|
3659
|
my $image2 = URI::Escape::uri_unescape($uargs{'image2'});
|
|
3660
|
my $force = $uargs{'force'};
|
|
3661
|
|
|
3662
|
return "Status=ERROR image must be in fuel storage ($curimg)\n" unless ($curimg =~ /^\/mnt\/fuel\/pool(\d+)\/(.+)/);
|
|
3663
|
my $pool = $1;
|
|
3664
|
my $ipath = $2;
|
|
3665
|
return "Status=ERROR image is not a qcow2 image ($curimg, $ipath)\n" unless ($ipath =~ /(.+\.qcow2$)/);
|
|
3666
|
my $npath = $1;
|
|
3667
|
my $ppath = '';
|
|
3668
|
if ($npath =~ /(.*\/)(.+\.qcow2$)/) {
|
|
3669
|
$npath = $2;
|
|
3670
|
$ppath = $1;
|
|
3671
|
}
|
|
3672
|
my $imagepath = $tenderpathslist[$pool] . "/$user/fuel/$ipath";
|
|
3673
|
my $newpath = $tenderpathslist[$pool] . "/$user/$npath";
|
|
3674
|
return "Status=ERROR image not found ($imagepath)\n" unless (-e $imagepath);
|
|
3675
|
return "Status=ERROR image already exists in destination ($newpath)\n" if (-e $newpath && !$force);
|
|
3676
|
return "Status=ERROR image is in use ($newpath)\n" if (-e $newpath && $register{$newpath} && $register{$newpath}->{'status'} ne 'unused');
|
|
3677
|
|
|
3678
|
my $virtualsize = `qemu-img info --force-share "$imagepath" | sed -n -e 's/^virtual size: .*(//p' | sed -n -e 's/ bytes)//p'`;
|
|
3679
|
chomp $virtualsize;
|
|
3680
|
# my $master = `qemu-img info --force-share "$imagepath" | sed -n -e 's/^backing file: //p' | sed -n -e 's/ (actual path:.*)\$//p'`;
|
|
3681
|
my $master = `qemu-img info --force-share "$imagepath" | sed -n -e 's/^backing file: //p'`;
|
|
3682
|
chomp $master;
|
|
3683
|
|
|
3684
|
# Now deal with image2
|
|
3685
|
my $newpath2 = '';
|
|
3686
|
if ($image2) {
|
|
3687
|
$image2 = "/mnt/fuel/pool$pool/$ppath$image2" unless ($image2 =~ /^\//);
|
|
3688
|
return "Status=ERROR image2 must be in fuel storage ($image2)\n" unless ($image2 =~ /^\/mnt\/fuel\/pool$pool\/(.+)/);
|
|
3689
|
$ipath = $1;
|
|
3690
|
return "Status=ERROR image is not a qcow2 image\n" unless ($ipath =~ /(.+\.qcow2$)/);
|
|
3691
|
$npath = $1;
|
|
3692
|
$npath = $1 if ($npath =~ /.*\/(.+\.qcow2$)/);
|
|
3693
|
my $image2path = $tenderpathslist[$pool] . "/$user/fuel/$ipath";
|
|
3694
|
$newpath2 = $tenderpathslist[$pool] . "/$user/$npath";
|
|
3695
|
return "Status=ERROR image2 not found ($image2path)\n" unless (-e $image2path);
|
|
3696
|
return "Status=ERROR image2 already exists in destination ($newpath2)\n" if (-e $newpath2 && !$force);
|
|
3697
|
return "Status=ERROR image2 is in use ($newpath2)\n" if (-e $newpath2 && $register{$newpath2} && $register{$newpath2}->{'status'} ne 'unused');
|
|
3698
|
|
|
3699
|
my $virtualsize2 = `qemu-img info --force-share "$image2path" | sed -n -e 's/^virtual size: .*(//p' | sed -n -e 's/ bytes)//p'`;
|
|
3700
|
chomp $virtualsize2;
|
|
3701
|
# my $master2 = `qemu-img info --force-share "$image2path" | sed -n -e 's/^backing file: //p' | sed -n -e 's/ (actual path:.*)\$//p'`;
|
|
3702
|
my $master2 = `qemu-img info --force-share "$image2path" | sed -n -e 's/^backing file: //p'`;
|
|
3703
|
chomp $master2;
|
|
3704
|
if ($register{$master2}) {
|
|
3705
|
$register{$master2}->{'status'} = 'used';
|
|
3706
|
}
|
|
3707
|
`mv "$image2path" "$newpath2"`;
|
|
3708
|
if (-e $newpath2) {
|
|
3709
|
my $ug = new Data::UUID;
|
|
3710
|
my $newuuid = $ug->create_str();
|
|
3711
|
unless ($name) {
|
|
3712
|
$name = $npath if ($npath);
|
|
3713
|
$name = $1 if ($name =~ /(.+)\.(qcow2)$/);
|
|
3714
|
}
|
|
3715
|
$register{$newpath2} = {
|
|
3716
|
uuid => $newuuid,
|
|
3717
|
path => $newpath2,
|
|
3718
|
master => $master2,
|
|
3719
|
name => "$name (data)",
|
|
3720
|
user => $user,
|
|
3721
|
storagepool => $pool,
|
|
3722
|
type => 'qcow2',
|
|
3723
|
status => 'unused',
|
|
3724
|
version => $version,
|
|
3725
|
virtualsize => $virtualsize2
|
|
3726
|
};
|
|
3727
|
$postreply .= "Status=OK Activated data image $newpath2, $name (data), $newuuid\n";
|
|
3728
|
} else {
|
|
3729
|
$postreply .= "Status=ERROR Unable to activate $image2path, $newpath2\n";
|
|
3730
|
}
|
|
3731
|
}
|
|
3732
|
|
|
3733
|
# Finish up primary image
|
|
3734
|
if ($register{$master}) {
|
|
3735
|
$register{$master}->{'status'} = 'used';
|
|
3736
|
}
|
|
3737
|
`mv "$imagepath" "$newpath"`;
|
|
3738
|
if (-e $newpath) {
|
|
3739
|
my $ug = new Data::UUID;
|
|
3740
|
my $newuuid = $ug->create_str();
|
|
3741
|
unless ($name) {
|
|
3742
|
$name = $npath if ($npath);
|
|
3743
|
$name = $1 if ($name =~ /(.+)\.(qcow2)$/);
|
|
3744
|
}
|
|
3745
|
$register{$newpath} = {
|
|
3746
|
uuid => $newuuid,
|
|
3747
|
path => $newpath,
|
|
3748
|
master => $master,
|
|
3749
|
name => $name,
|
|
3750
|
user => $user,
|
|
3751
|
storagepool => $pool,
|
|
3752
|
image2 => $newpath2,
|
|
3753
|
type => 'qcow2',
|
|
3754
|
status => 'unused',
|
|
3755
|
installable => 'true',
|
|
3756
|
managementlink => $managementlink || '/stabile/pipe/http://{uuid}:10000/stabile/',
|
|
3757
|
upgradelink => $upgradelink,
|
|
3758
|
terminallink => $terminallink,
|
|
3759
|
version => $version,
|
|
3760
|
virtualsize => $virtualsize
|
|
3761
|
};
|
|
3762
|
$postreply .= "Status=OK Activated $newpath, $name, $newuuid\n";
|
|
3763
|
} else {
|
|
3764
|
$postreply .= "Status=ERROR Unable to activate $imagepath to $newpath\n";
|
|
3765
|
}
|
|
3766
|
return $postreply;
|
|
3767
|
}
|
|
3768
|
|
|
3769
|
sub Uploadtoregistry {
|
|
3770
|
my ($path, $action, $obj) = @_;
|
|
3771
|
if ($help) {
|
|
3772
|
return <<END
|
|
3773
|
GET:image, force:
|
|
3774
|
Upload an image to the registry. Set [force] if you want to force overwrite images in registry - use with caution.
|
|
3775
|
END
|
|
3776
|
}
|
|
3777
|
$force = $obj->{'force'};
|
|
3778
|
if (-e $path && ($register{$path}->{'user'} eq $user || $isadmin)) {
|
|
3779
|
$postreply .= $main::uploadToOrigo->($engineid, $path, $force);
|
|
3780
|
} else {
|
|
3781
|
$postreply .= "Status=Error Not allowed\n";
|
|
3782
|
}
|
|
3783
|
return $postreply;
|
|
3784
|
}
|
|
3785
|
|
|
3786
|
sub Publish {
|
|
3787
|
my ($uuid, $action, $parms) = @_;
|
|
3788
|
if ($help) {
|
|
3789
|
return <<END
|
|
3790
|
GET:image,appid,appstore,force:
|
|
3791
|
Publish a stack to registry. Set [force] if you want to force overwrite images in registry - use with caution.
|
|
3792
|
END
|
|
3793
|
}
|
|
3794
|
my $res;
|
|
3795
|
$uuid = $parms->{'uuid'} if ($uuid =~ /^\// || !$uuid);
|
|
3796
|
my $force = $parms->{'force'};
|
|
3797
|
my $freshen = $parms->{'freshen'};
|
|
3798
|
|
|
3799
|
if ($isreadonly) {
|
|
3800
|
$res .= "Status=ERROR Your account does not have the necessary privilege.s\n";
|
|
3801
|
} elsif (!$uuid || !$imagereg{$uuid}) {
|
|
3802
|
$res .= "Status=ERROR At least specify activated master image uuid [uuid or path] to publish.\n";
|
|
3803
|
} elsif ($imagereg{$uuid}->{'user'} ne $user && !$isadmin) {
|
|
3804
|
$res .= "Status=ERROR Your account does not have the necessary privileges.\n";
|
|
3805
|
} elsif ($imagereg{$uuid}->{'path'} =~ /.+\.master\.qcow2$/) {
|
|
3806
|
if ($engineid eq $valve001id) { # On valve001 - check if meta file exists
|
|
3807
|
if (-e $imagereg{$uuid}->{'path'} . ".meta") {
|
|
3808
|
$res .= "On valve001. Found meta file $imagereg{$uuid}->{'path'}.meta\n";
|
|
3809
|
my $appid = `cat $imagereg{$uuid}->{'path'}.meta | sed -n -e 's/^APPID=//p'`;
|
|
3810
|
chomp $appid;
|
|
3811
|
if ($appid) {
|
|
3812
|
$parms->{'appid'} = $appid;
|
|
3813
|
$register{$imagereg{$uuid}->{'path'}}->{'appid'} = $appid;
|
|
3814
|
tied(%register)->commit;
|
|
3815
|
}
|
|
3816
|
}
|
|
3817
|
# On valve001 - move image to stacks
|
|
3818
|
if ($imagereg{$uuid}->{'storagepool'} ne '0') {
|
|
3819
|
$res .= "Status=OK Moving image: " . Move($imagereg{$uuid}->{'path'}, $user, 0) . "\n";
|
|
3820
|
} else {
|
|
3821
|
$res .= "Status=OK Image is already available in registry\n";
|
|
3822
|
}
|
|
3823
|
} else {
|
|
3824
|
# $console = 1;
|
|
3825
|
# my $link = Download($imagereg{$uuid}->{'path'});
|
|
3826
|
# chomp $link;
|
|
3827
|
# $parms->{'downloadlink'} = $link; # We now upload instead
|
|
3828
|
# $res .= "Status=OK Asking registry to download $parms->{'APPID'} image: $link\n";
|
|
3829
|
if ($appstores) {
|
|
3830
|
$parms->{'appstore'} = $appstores;
|
|
3831
|
} elsif ($appstoreurl =~ /www\.(.+)\//) {
|
|
3832
|
$parms->{'appstore'} = $1;
|
|
3833
|
$res .= "Status=OK Adding registry: $1\n";
|
|
3834
|
}
|
|
3835
|
}
|
|
3836
|
# $parms->{'appstore'} = 1 if ($freshen);
|
|
3837
|
|
|
3838
|
my %imgref = %{$imagereg{$uuid}};
|
|
3839
|
$parms = Hash::Merge::merge($parms, \%imgref);
|
|
3840
|
my $postdata = to_json($parms);
|
|
3841
|
my $postres = $main::postToOrigo->($engineid, 'publishapp', $postdata);
|
|
3842
|
$res .= $postres;
|
|
3843
|
my $appid;
|
|
3844
|
$appid = $1 if ($postres =~ /appid: (\d+)/);
|
|
3845
|
my $path = $imagereg{$uuid}->{'path'};
|
|
3846
|
if ($freshen && $appid) {
|
|
3847
|
$res .= "Status=OK Freshened the stack description\n";
|
|
3848
|
} elsif ($appid) {
|
|
3849
|
$register{$path}->{'appid'} = $appid if ($register{$path});
|
|
3850
|
$res .= "Status=OK Received appid $appid for $path, uploading image to registry, hang on...\n";
|
|
3851
|
my $upres .= $main::uploadToOrigo->($engineid, $path, $force);
|
|
3852
|
$res .= $upres;
|
|
3853
|
my $image2 = $register{$path}->{'image2'} if ($register{$path});
|
|
3854
|
if ($upres =~ /Status=OK/ && $image2 && $image2 ne '--') { # Stack has a data image
|
|
3855
|
$res .= $main::uploadToOrigo->($engineid, $image2, $force);
|
|
3856
|
}
|
|
3857
|
} else {
|
|
3858
|
$res .= "Status=Error Did not get an appid\n";
|
|
3859
|
}
|
|
3860
|
} else {
|
|
3861
|
$res .= "Status=ERROR You can only publish a master image.\n";
|
|
3862
|
}
|
|
3863
|
return $res;
|
|
3864
|
}
|
|
3865
|
|
|
3866
|
sub Release {
|
|
3867
|
my ($uuid, $action, $parms) = @_;
|
|
3868
|
if ($help) {
|
|
3869
|
return <<END
|
|
3870
|
GET:image,appid,appstore,force,unrelease:
|
|
3871
|
Releases a stack in the registry, i.e. moves it from being a private stack only owner and owner's users can see and use to being a public stack, everyone can use. Set [force] if you want to force overwrite images in registry - use with caution.
|
|
3872
|
END
|
|
3873
|
}
|
|
3874
|
my $res;
|
|
3875
|
$uuid = $parms->{'uuid'} if ($uuid =~ /^\// || !$uuid);
|
|
3876
|
my $force = $parms->{'force'};
|
|
3877
|
my $unrelease = $parms->{'unrelease'};
|
|
3878
|
|
|
3879
|
if (!$uuid || !$imagereg{$uuid}) {
|
|
3880
|
$res .= "Status=ERROR At least specify master image uuid [uuid or path] to release.\n";
|
|
3881
|
} elsif (!$isadmin) {
|
|
3882
|
$res .= "Status=ERROR Your account does not have the necessary privileges.\n";
|
|
3883
|
} elsif ($imagereg{$uuid}->{'path'} =~ /.+\.master\.qcow2$/ && $imagereg{$uuid}->{'appid'}) {
|
|
3884
|
my $action = 'release';
|
|
3885
|
my $targetuser = 'common';
|
|
3886
|
if ($unrelease) {
|
|
3887
|
$action = 'unrelease';
|
|
3888
|
$targetuser = $user;
|
|
3889
|
}
|
|
3890
|
if ($appstores) {
|
|
3891
|
$parms->{'appstore'} = $appstores;
|
|
3892
|
} elsif ($appstoreurl =~ /www\.(.+)\//) {
|
|
3893
|
$parms->{'appstore'} = $1;
|
|
3894
|
$res .= "Status=OK Adding registry: $1\n";
|
|
3895
|
}
|
|
3896
|
$parms->{'appid'} = $imagereg{$uuid}->{'appid'};
|
|
3897
|
$parms->{'force'} = $force if ($force);
|
|
3898
|
$parms->{'unrelease'} = $unrelease if ($unrelease);
|
|
3899
|
my $postdata = to_json($parms);
|
|
3900
|
my $postres = $main::postToOrigo->($engineid, 'releaseapp', $postdata);
|
|
3901
|
$res .= $postres;
|
|
3902
|
my $appid;
|
|
3903
|
$appid = $1 if ($postres =~ /Status=OK Moved (\d+)/);
|
|
3904
|
my $path = $imagereg{$uuid}->{'path'};
|
|
3905
|
if ($appid) {
|
|
3906
|
$res.= "Now moving local stack to $targetuser\n";
|
|
3907
|
# First move data image
|
|
3908
|
my $image2 = $register{$path}->{'image2'} if ($register{$path});
|
|
3909
|
my $newimage2 = $image2;
|
|
3910
|
if ($image2 && $image2 ne '--' && $register{$image2}) { # Stack has a data image
|
|
3911
|
if ($unrelease) {
|
|
3912
|
$newimage2 =~ s/common/$register{$image2}->{'user'}/;
|
|
3913
|
} else {
|
|
3914
|
$newimage2 =~ s/$register{$image2}->{'user'}/common/;
|
|
3915
|
}
|
|
3916
|
$register{$path}->{'image2'} = $newimage2;
|
|
3917
|
tied(%register)->commit;
|
|
3918
|
$res .= Move($image2, $targetuser, '', '', 1);
|
|
3919
|
}
|
|
3920
|
# Move image
|
|
3921
|
$res .= Move($path, $targetuser, '', '', 1);
|
|
3922
|
$res .= "Status=OK $action $appid\n";
|
|
3923
|
} else {
|
|
3924
|
$res .= "Status=Error $action failed\n";
|
|
3925
|
}
|
|
3926
|
} else {
|
|
3927
|
$res .= "Status=ERROR You can only $action a master image that has been published.\n";
|
|
3928
|
}
|
|
3929
|
return $res;
|
|
3930
|
}
|
|
3931
|
|
|
3932
|
sub do_unlinkmaster {
|
|
3933
|
my ($img, $action) = @_;
|
|
3934
|
if ($help) {
|
|
3935
|
return <<END
|
|
3936
|
GET:image,path:
|
|
3937
|
END
|
|
3938
|
}
|
|
3939
|
my $res;
|
|
3940
|
$res .= header('text/html') unless ($console);
|
|
3941
|
if ($isreadonly) {
|
|
3942
|
$res .= "Your account does not have the necessary privileges\n";
|
|
3943
|
} elsif ($curimg) {
|
|
3944
|
$res .= unlinkMaster($curimg) . "\n";
|
|
3945
|
} else {
|
|
3946
|
$res .= "Please specify master image to link\n";
|
|
3947
|
}
|
|
3948
|
return $res;
|
|
3949
|
}
|
|
3950
|
|
|
3951
|
# Simple action for unmounting all images
|
|
3952
|
sub do_unmountall {
|
|
3953
|
my ($img, $action) = @_;
|
|
3954
|
if ($help) {
|
|
3955
|
return <<END
|
|
3956
|
GET:image,path:
|
|
3957
|
END
|
|
3958
|
}
|
|
3959
|
return "Your account does not have the necessary privileges\n" if ($isreadonly);
|
|
3960
|
my $res;
|
|
3961
|
$res .= header('text/plain') unless ($console);
|
|
3962
|
$res .= "Unmounting all images for $user\n";
|
|
3963
|
unmountAll();
|
|
3964
|
$res .= "\n$postreply" if ($postreply);
|
|
3965
|
return $res;
|
|
3966
|
}
|
|
3967
|
|
|
3968
|
sub Updatedownloads {
|
|
3969
|
my ($img, $action) = @_;
|
|
3970
|
if ($help) {
|
|
3971
|
return <<END
|
|
3972
|
GET:image,path:
|
|
3973
|
END
|
|
3974
|
}
|
|
3975
|
my $res;
|
|
3976
|
$res .= header('text/html') unless ($console);
|
|
3977
|
my $txt1 = <<EOT
|
|
3978
|
Options -Indexes
|
|
3979
|
EOT
|
|
3980
|
;
|
|
3981
|
`/bin/mkdir "$Stabile::basedir/download"` unless (-e "$Stabile::basedir/download");
|
|
3982
|
$res .= "Writing .htaccess: -> $Stabile::basedir/download/.htaccess\n";
|
|
3983
|
unlink("$Stabile::basedir/download/.htaccess");
|
|
3984
|
`chown www-data:www-data "$Stabile::basedir/download"`;
|
|
3985
|
`/bin/echo "$txt1" | sudo -u www-data tee "$Stabile::basedir/download/.htaccess"`; #This ugliness is needed because of ownership issues with Synology NFS
|
|
3986
|
`chmod 644 "$Stabile::basedir/download/.htaccess"`;
|
|
3987
|
foreach my $p (@spools) {
|
|
3988
|
my $dir = $p->{'path'};
|
|
3989
|
my $id = $p->{'id'};
|
|
3990
|
`/bin/rm "$Stabile::basedir/download/$id"; /bin/ln -s "$dir" "$Stabile::basedir/download/$id"`;
|
|
3991
|
$res .= "Writing .htaccess: $id -> $dir/.htaccess\n";
|
|
3992
|
unlink("$dir/.htaccess");
|
|
3993
|
`/bin/echo "$txt1" | tee "$dir/.htaccess"`;
|
|
3994
|
`chown www-data:www-data "$dir/.htaccess"`;
|
|
3995
|
`chmod 644 "$dir/.htaccess"`;
|
|
3996
|
}
|
|
3997
|
|
|
3998
|
unless ( tie(%userreg,'Tie::DBI', Hash::Merge::merge({table=>'users', key=>'username', CLOBBER=>1}, $Stabile::dbopts)) ) {return 0};
|
|
3999
|
|
|
4000
|
foreach my $username (keys %userreg) {
|
|
4001
|
my $require = '';
|
|
4002
|
my $txt = <<EOT
|
|
4003
|
order deny,allow
|
|
4004
|
AuthName "Download"
|
|
4005
|
AuthType None
|
|
4006
|
TKTAuthLoginURL $baseurl/auth/login.cgi
|
|
4007
|
TKTAuthIgnoreIP on
|
|
4008
|
deny from all
|
|
4009
|
Satisfy any
|
|
4010
|
require user $username
|
|
4011
|
Options -Indexes
|
|
4012
|
EOT
|
|
4013
|
;
|
|
4014
|
foreach my $p (@spools) {
|
|
4015
|
my $dir = $p->{'path'};
|
|
4016
|
my $id = $p->{'id'};
|
|
4017
|
if (-d "$dir/$username") {
|
|
4018
|
$res .= "Writing .htaccess: $id -> $dir/$username/.htaccess\n";
|
|
4019
|
unlink("$dir/$username/.htaccess");
|
|
4020
|
`/bin/echo "$txt1" | sudo -u www-data tee $dir/$username/.htaccess`;
|
|
4021
|
if ($tenderlist[$p->{'id'}] eq 'local') {
|
|
4022
|
if (!(-e "$dir/$username/fuel") && -e "$dir/$username") {
|
|
4023
|
`mkdir "$dir/$username/fuel"`;
|
|
4024
|
`chmod 777 "$dir/$username/fuel"`;
|
|
4025
|
}
|
|
4026
|
}
|
|
4027
|
}
|
|
4028
|
}
|
|
4029
|
}
|
|
4030
|
untie %userreg;
|
|
4031
|
return $res;
|
|
4032
|
}
|
|
4033
|
|
|
4034
|
sub do_listpackages($action) {
|
|
4035
|
my ($image, $action) = @_;
|
|
4036
|
if ($help) {
|
|
4037
|
return <<END
|
|
4038
|
GET:image:
|
|
4039
|
Tries to mount and list software packages installed on the operating system on an image. The image must be mountable and contain a valid operating system.
|
|
4040
|
END
|
|
4041
|
}
|
|
4042
|
my $res;
|
|
4043
|
$res .= header('text/plain') unless ($console);
|
|
4044
|
|
|
4045
|
my $mac = $register{$image}->{'mac'};
|
|
4046
|
my $macip;
|
|
4047
|
if ($mac && $mac ne '--') {
|
|
4048
|
unless ( tie(%nodereg,'Tie::DBI', Hash::Merge::merge({table=>'nodes', key=>'mac', CLOBBER=>1}, $Stabile::dbopts)) ) {return 0};
|
|
4049
|
$macip = $nodereg{$mac}->{'ip'};
|
|
4050
|
untie %nodereg;
|
|
4051
|
}
|
|
4052
|
$image =~ /(.+)/; $image = $1;
|
|
4053
|
my $apps;
|
|
4054
|
|
|
4055
|
if ($macip && $macip ne '--') {
|
|
4056
|
my $cmd = qq[eval \$(/usr/bin/guestfish --ro -a "$image" --i --listen); ]; # sets $GUESTFISH_PID shell var
|
|
4057
|
$cmd .= qq[root="\$(/usr/bin/guestfish --remote inspect-get-roots)"; ];
|
|
4058
|
$cmd .= qq[guestfish --remote inspect-list-applications "\$root"; ];
|
|
4059
|
$cmd .= qq[guestfish --remote inspect-get-product-name "\$root"; ];
|
|
4060
|
$cmd .= qq[guestfish --remote exit];
|
|
4061
|
$cmd = "$sshcmd $macip '$cmd'";
|
|
4062
|
$apps = `$cmd`;
|
|
4063
|
} else {
|
|
4064
|
my $cmd;
|
|
4065
|
# my $pid = open my $cmdpipe, "-|",qq[/usr/bin/guestfish --ro -a "$image" --i --listen];
|
|
4066
|
$cmd .= qq[eval \$(/usr/bin/guestfish --ro -a "$image" --i --listen); ];
|
|
4067
|
# Start listening guestfish
|
|
4068
|
my $daemon = Proc::Daemon->new(
|
|
4069
|
work_dir => '/usr/local/bin',
|
|
4070
|
setuid => 'www-data',
|
|
4071
|
exec_command => $cmd
|
|
4072
|
) or do {$postreply .= "Status=ERROR $@\n";};
|
|
4073
|
my $pid = $daemon->Init();
|
|
4074
|
while ($daemon->Status($pid)) {
|
|
4075
|
sleep 1;
|
|
4076
|
}
|
|
4077
|
# Find pid of the listening guestfish
|
|
4078
|
my $pid2;
|
|
4079
|
my $t = new Proc::ProcessTable;
|
|
4080
|
foreach $p ( @{$t->table} ){
|
|
4081
|
my $pcmd = $p->cmndline;
|
|
4082
|
if ($pcmd =~ /guestfish.+$image/) {
|
|
4083
|
$pid2 = $p->pid;
|
|
4084
|
last;
|
|
4085
|
}
|
|
4086
|
}
|
|
4087
|
|
|
4088
|
my $cmd2;
|
|
4089
|
if ($pid2) {
|
|
4090
|
$cmd2 .= qq[root="\$(/usr/bin/guestfish --remote=$pid2 inspect-get-roots)"; ];
|
|
4091
|
$cmd2 .= qq[guestfish --remote=$pid2 inspect-list-applications "\$root"; ];
|
|
4092
|
$cmd2 .= qq[guestfish --remote=$pid2 inspect-get-product-name "\$root"; ];
|
|
4093
|
$cmd2 .= qq[guestfish --remote=$pid2 exit];
|
|
4094
|
}
|
|
4095
|
$apps = `$cmd2`;
|
|
4096
|
}
|
|
4097
|
if ($console) {
|
|
4098
|
$res .= $apps;
|
|
4099
|
} else {
|
|
4100
|
my @packages;
|
|
4101
|
my @packages2;
|
|
4102
|
open my $fh, '<', \$apps or die $!;
|
|
4103
|
my $i;
|
|
4104
|
while (<$fh>) {
|
|
4105
|
if ($_ =~ /\[(\d+)\]/) {
|
|
4106
|
push @packages2, $packages[$i];
|
|
4107
|
$i = $1;
|
|
4108
|
} elsif ($_ =~ /(\S+): (.+)/ && $2) {
|
|
4109
|
$packages[$i]->{$1} = $2;
|
|
4110
|
}
|
|
4111
|
}
|
|
4112
|
close $fh or die $!;
|
|
4113
|
$res .= to_json(\@packages, {pretty => 1});
|
|
4114
|
}
|
|
4115
|
return $res;
|
|
4116
|
}
|
|
4117
|
|
|
4118
|
sub Inject {
|
|
4119
|
my ($image, $action, $obj) = @_;
|
|
4120
|
if ($help) {
|
|
4121
|
return <<END
|
|
4122
|
GET:image:
|
|
4123
|
Tries to inject drivers into a qcow2 image with a Windows OS installed on it. Image must not be in use.
|
|
4124
|
END
|
|
4125
|
}
|
|
4126
|
$uistatus = "injecting";
|
|
4127
|
my $path = $obj->{path} || $curimg;
|
|
4128
|
my $status = $obj->{status};
|
|
4129
|
my $esc_localpath = shell_esc_chars($path);
|
|
4130
|
|
|
4131
|
# Find out if we are dealing with a Windows image
|
|
4132
|
# my $xml = `bash -c '/usr/bin/virt-inspector -a $esc_localpath'`;
|
|
4133
|
my $xml = `bash -c '/usr/bin/virt-inspector -a $esc_localpath' 2>&1`;
|
|
4134
|
# $res .= $xml . "\n";
|
|
4135
|
my $xmlref;
|
|
4136
|
my $osname;
|
|
4137
|
$xmlref = XMLin($xml) if ($xml =~ /^<\?xml/);
|
|
4138
|
$osname = $xmlref->{operatingsystem}->{name} if ($xmlref);
|
|
4139
|
if ($xmlref && $osname eq 'windows') {
|
|
4140
|
# my $upath = $esc_localpath;
|
|
4141
|
my $upath = $path;
|
|
4142
|
# We need write privileges
|
|
4143
|
$res .= `chmod 666 "$upath"`;
|
|
4144
|
# First try to merge storage registry keys into Windows registry. If not a windows vm it simply fails.
|
|
4145
|
$res .= `bash -c 'cat /usr/share/stabile/mergeide.reg | /usr/bin/virt-win-reg --merge "$upath"' 2>&1`;
|
|
4146
|
# Then try to merge the critical device keys. This has been removed in win8 and 2012, so will simply fail for these.
|
|
4147
|
$res .= `bash -c 'cat /usr/share/stabile/mergeide-CDDB.reg | /usr/bin/virt-win-reg --merge "$upath"' 2>&1`;
|
|
4148
|
if ($res) { $main::syslogit->($user, "info", $res); $res = ''; }
|
|
4149
|
|
|
4150
|
# Try to copy viostor.sys into image
|
|
4151
|
my @winpaths = (
|
|
4152
|
'/Windows/System32/drivers',
|
|
4153
|
'/WINDOWS/system32/drivers',
|
|
4154
|
'/WINDOWS/System32/drivers',
|
|
4155
|
'/WINNT/system32/drivers'
|
|
4156
|
);
|
|
4157
|
foreach my $winpath (@winpaths) {
|
|
4158
|
my $lscmd = qq|bash -c 'virt-ls -a "$upath" "$winpath"'|;
|
|
4159
|
my $drivers = `$lscmd`;
|
|
4160
|
if ($drivers =~ /viostor/i) {
|
|
4161
|
$postreply .= "Status=$status viostor already installed in $winpath in $upath\n";
|
|
4162
|
$main::syslogit->($user, "info", "viostor already installed in $winpath in $upath");
|
|
4163
|
last;
|
|
4164
|
} elsif ($drivers) {
|
|
4165
|
`umount "$upath"`; # Unmount if mounted by browse operation or similar
|
|
4166
|
my $cmd = qq|bash -c 'guestfish --rw -i -a "$upath" upload /usr/share/stabile/VIOSTOR.SYS $winpath/viostor.sys' 2>&1|;
|
|
4167
|
my $error = `$cmd`;
|
|
4168
|
if ($error) {
|
|
4169
|
$postreply .= "$cmd\n";
|
|
4170
|
$postreply .= "Status=ERROR Problem injecting virtio drivers into $winpath on $upath: $error\n";
|
|
4171
|
$main::syslogit->($user, "info", "Error injecting virtio drivers into $upath: $error");
|
|
4172
|
} else {
|
|
4173
|
$postreply .= "Status=$status Injected virtio drivers into $upath\n";
|
|
4174
|
$main::syslogit->($user, "info", "Injected virtio drivers into $upath");
|
|
4175
|
}
|
|
4176
|
last;
|
|
4177
|
} else {
|
|
4178
|
$postreply .= "Status=ERROR No drivers found in $winpath\n";
|
|
4179
|
}
|
|
4180
|
}
|
|
4181
|
|
|
4182
|
} else {
|
|
4183
|
$postreply .= "Status=ERROR No Windows OS found in $osname image, not injecting drivers.\n";
|
|
4184
|
$main::syslogit->($user, "info", "No Windows OS found ($osname) in image, not injecting drivers.");
|
|
4185
|
}
|
|
4186
|
my $msg = $postreply;
|
|
4187
|
$msg = $1 if ($msg =~ /\w+=\w+ (.+)/);
|
|
4188
|
chomp $msg;
|
|
4189
|
$main::updateUI->({tab=>"images", user=>$user, type=>"update", uuid=>$obj->{'uuid'}, status=>$status, message=>$msg});
|
|
4190
|
$postreply .= "Status=$uistatus $obj->{type} image: $obj->{name}\n";
|
|
4191
|
$main::syslogit->($user, "info", "$uistatus $obj->{type} image: $obj->{name}: $uuid");
|
|
4192
|
return $postreply;
|
|
4193
|
}
|
|
4194
|
|
|
4195
|
sub Convert {
|
|
4196
|
my ($image, $action, $obj) = @_;
|
|
4197
|
if ($help) {
|
|
4198
|
return <<END
|
|
4199
|
GET:image:
|
|
4200
|
Converts an image to qcow2 format. Image must not be in use.
|
|
4201
|
END
|
|
4202
|
}
|
|
4203
|
my $path = $obj->{path};
|
|
4204
|
$uistatus = "converting";
|
|
4205
|
$uipath = $path;
|
|
4206
|
if ($obj->{status} ne "unused" && $obj->{status} ne "used" && $obj->{status} ne "paused") {
|
|
4207
|
$postreply .= "Status=ERROR Problem $uistatus $obj->{type} image: $obj->{name}\n";
|
|
4208
|
} elsif ($obj->{type} eq "img" || $obj->{type} eq "vmdk" || $obj->{type} eq "vhd" || $obj->{type} eq "vhdx") {
|
|
4209
|
my $oldpath = $path;
|
|
4210
|
my $newpath = "$path.qcow2";
|
|
4211
|
if ($obj->{mac} && $path =~ /\/mnt\/stabile\/node\//) {
|
|
4212
|
unless ( tie(%nodereg,'Tie::DBI', Hash::Merge::merge({table=>'nodes', key=>'mac', CLOBBER=>1}, $Stabile::dbopts)) ) {return 0};
|
|
4213
|
$macip = $nodereg{$obj->{mac}}->{'ip'};
|
|
4214
|
untie %nodereg;
|
|
4215
|
$oldpath = "$macip:$path";
|
|
4216
|
} else { # We are not on a node - check that image is not on a read-only filesystem
|
|
4217
|
my ($fname, $destfolder) = fileparse($path);
|
|
4218
|
my $ro = `touch "$destfolder/test.tmp" && { rm "$destfolder/test.tmp"; } || echo "read-only" 2>/dev/null`;
|
|
4219
|
if ($ro) { # Destinationfolder is not writable
|
|
4220
|
my $npath = "$spools[0]->{'path'}/$register{$path}->{'user'}/$fname.qcow2";
|
|
4221
|
$newpath = $npath;
|
|
4222
|
}
|
|
4223
|
if (-e $newpath) { # Don't overwrite existing file
|
|
4224
|
my $subpath = substr($newpath,0,-6);
|
|
4225
|
my $i = 1;
|
|
4226
|
if ($newpath =~ /(.+)\.(\d+)\.qcow2/) {
|
|
4227
|
$i = $2;
|
|
4228
|
$subpath = $1;
|
|
4229
|
}
|
|
4230
|
while (-e $newpath) {
|
|
4231
|
$newpath = $subpath . ".$i.qcow2";
|
|
4232
|
$i++;
|
|
4233
|
}
|
|
4234
|
}
|
|
4235
|
}
|
|
4236
|
eval {
|
|
4237
|
my $ug = new Data::UUID;
|
|
4238
|
my $newuuid = $ug->create_str();
|
|
4239
|
|
|
4240
|
$register{$newpath} = {
|
|
4241
|
uuid=>$newuuid,
|
|
4242
|
name=>"$obj->{name} (converted)",
|
|
4243
|
notes=>$obj->{notes},
|
|
4244
|
image2=>$obj->{image2},
|
|
4245
|
managementlink=>$obj->{managementlink},
|
|
4246
|
upgradelink=>$obj->{managementlink},
|
|
4247
|
terminallink=>$obj->{terminallink},
|
|
4248
|
storagepool=>$obj->{regstoragepool},
|
|
4249
|
status=>$uistatus,
|
|
4250
|
mac=>($obj->{regstoragepool} == -1)?$obj->{mac}:"",
|
|
4251
|
size=>0,
|
|
4252
|
realsize=>0,
|
|
4253
|
virtualsize=>$obj->{virtualsize},
|
|
4254
|
type=>"qcow2",
|
|
4255
|
user=>$user
|
|
4256
|
};
|
|
4257
|
$register{$path}->{'status'} = $uistatus;
|
|
4258
|
|
|
4259
|
my $daemon = Proc::Daemon->new(
|
|
4260
|
work_dir => '/usr/local/bin',
|
|
4261
|
exec_command => "perl -U steamExec $user $uistatus $obj->{status} \"$oldpath\" \"$newpath\""
|
|
4262
|
) or do {$postreply .= "Status=ERROR $@\n";};
|
|
4263
|
my $pid = $daemon->Init() or do {$postreply .= "Status=ERROR $@\n";};
|
|
4264
|
$postreply .= "Status=OK $uistatus $obj->{type} image: $obj->{name}\n";
|
|
4265
|
$main::syslogit->($user, "info", "$uistatus $obj->{type} image: $obj->{name}: $uuid");
|
|
4266
|
} or do {$postreply .= "Status=ERROR $@\n";};
|
|
4267
|
$main::updateUI->({tab=>"images", user=>$user, type=>"update"});
|
|
4268
|
} else {
|
|
4269
|
$postreply .= "Status=ERROR Only img and vmdk images can be converted\n";
|
|
4270
|
}
|
|
4271
|
return $postreply;
|
|
4272
|
}
|
|
4273
|
|
|
4274
|
sub Snapshot {
|
|
4275
|
my ($image, $action, $obj) = @_;
|
|
4276
|
if ($help) {
|
|
4277
|
return <<END
|
|
4278
|
GET:image:
|
|
4279
|
Adds a snapshot to a qcow2 image. Image can not be in use by a running server.
|
|
4280
|
END
|
|
4281
|
}
|
|
4282
|
my $status = $obj->{status};
|
|
4283
|
my $path = $obj->{path};
|
|
4284
|
my $macip;
|
|
4285
|
$uistatus = "snapshotting";
|
|
4286
|
$uiuuid = $obj->{uuid};
|
|
4287
|
if ($status ne "unused" && $status ne "used") {
|
|
4288
|
$postreply .= "Status=ERROR Problem $uistatus $obj->{type} image: $obj->{name}\n";
|
|
4289
|
} elsif ($obj->{type} eq "qcow2") {
|
|
4290
|
my $newpath = $path;
|
|
4291
|
my $hassnap;
|
|
4292
|
my $snaptime = time;
|
|
4293
|
if ($obj->{mac} && $path =~ /\/mnt\/stabile\/node\//) {
|
|
4294
|
unless ( tie(%nodereg,'Tie::DBI', Hash::Merge::merge({table=>'nodes', key=>'mac', CLOBBER=>1}, $Stabile::dbopts)) ) {return 0};
|
|
4295
|
$macip = $nodereg{$obj->{mac}}->{'ip'};
|
|
4296
|
untie %nodereg;
|
|
4297
|
$newpath = "$macip:$path";
|
|
4298
|
my $esc_path = $path;
|
|
4299
|
$esc_path =~ s/([ ])/\\$1/g;
|
|
4300
|
my $qinfo = `$sshcmd $macip "sudo /usr/bin/qemu-img snapshot -l $esc_path"`;
|
|
4301
|
$hassnap = ($qinfo =~ /snap1/g);
|
|
4302
|
$postreply .= `$sshcmd $macip "sudo /usr/bin/qemu-img snapshot -d snap1 $esc_path"` if ($hassnap);
|
|
4303
|
} else {
|
|
4304
|
my $qinfo = `/usr/bin/qemu-img snapshot -l "$path"`;
|
|
4305
|
$hassnap = ($qinfo =~ /snap1/g);
|
|
4306
|
$postreply .= `/usr/bin/qemu-img snapshot -d snap1 "$path\n"` if ($hassnap);
|
|
4307
|
}
|
|
4308
|
eval {
|
|
4309
|
if ($hassnap) {
|
|
4310
|
$postreply .= "Status=Error Only one snapshot per image is supported for $obj->{type} image: $obj->{name} ";
|
|
4311
|
} else {
|
|
4312
|
$register{$path}->{'status'} = $uistatus;
|
|
4313
|
$register{$path}->{'snap1'} = $snaptime;
|
|
4314
|
|
|
4315
|
if ($macip) {
|
|
4316
|
my $esc_localpath = shell_esc_chars($path);
|
|
4317
|
$res .= `$sshcmd $macip "sudo /usr/bin/qemu-img snapshot -c snap1 $esc_localpath"`;
|
|
4318
|
} else {
|
|
4319
|
$res .= `/usr/bin/qemu-img snapshot -c snap1 "$path"`;
|
|
4320
|
}
|
|
4321
|
$register{$path}->{'status'} = $status;
|
|
4322
|
$postreply .= "Status=$uistatus OK $uistatus $obj->{type} image: $obj->{name}\n";
|
|
4323
|
$main::syslogit->($user, "info", "$uistatus $obj->{type} image: $obj->{name}: $uuid");
|
|
4324
|
}
|
|
4325
|
1;
|
|
4326
|
} or do {$postreply .= "Status=ERROR $@\n";};
|
|
4327
|
$main::updateUI->({tab=>"images", user=>$user, type=>"update", uuid=>$obj->{'uuid'}, status=>$status, snap1=>$snaptime});
|
|
4328
|
} else {
|
|
4329
|
$postreply .= "Status=ERROR Only qcow2 images can be snapshotted\n";
|
|
4330
|
}
|
|
4331
|
return $postreply;
|
|
4332
|
}
|
|
4333
|
|
|
4334
|
sub Unsnap {
|
|
4335
|
my ($image, $action, $obj) = @_;
|
|
4336
|
if ($help) {
|
|
4337
|
return <<END
|
|
4338
|
GET:image:
|
|
4339
|
Removes a snapshot from a qcow2 image. Image can not be in use by a running server.
|
|
4340
|
END
|
|
4341
|
}
|
|
4342
|
my $status = $obj->{status};
|
|
4343
|
my $path = $obj->{path};
|
|
4344
|
$uistatus = "unsnapping";
|
|
4345
|
$uiuuid = $obj->{uuid};
|
|
4346
|
my $macip;
|
|
4347
|
|
|
4348
|
if ($status ne "unused" && $status ne "used") {
|
|
4349
|
$postreply .= "Status=ERROR Problem $uistatus $obj->{type} image: $obj->{name}\n";
|
|
4350
|
} elsif ($obj->{type} eq "qcow2") {
|
|
4351
|
my $newpath = $path;
|
|
4352
|
my $hassnap;
|
|
4353
|
my $qinfo;
|
|
4354
|
my $esc_path;
|
|
4355
|
if ($obj->{mac} && $path =~ /\/mnt\/stabile\/node\//) {
|
|
4356
|
unless ( tie(%nodereg,'Tie::DBI', Hash::Merge::merge({table=>'nodes', key=>'mac', CLOBBER=>1}, $Stabile::dbopts)) ) {return 0};
|
|
4357
|
$macip = $nodereg{$obj->{mac}}->{'ip'};
|
|
4358
|
untie %nodereg;
|
|
4359
|
$newpath = "$macip:$path";
|
|
4360
|
$esc_path = $path;
|
|
4361
|
$esc_path =~ s/([ ])/\\$1/g;
|
|
4362
|
$qinfo = `$sshcmd $macip "sudo /usr/bin/qemu-img snapshot -l $esc_path"`;
|
|
4363
|
$hassnap = ($qinfo =~ /snap1/g);
|
|
4364
|
} else {
|
|
4365
|
$qinfo = `/usr/bin/qemu-img snapshot -l "$path"`;
|
|
4366
|
$hassnap = ($qinfo =~ /snap1/g);
|
|
4367
|
}
|
|
4368
|
eval {
|
|
4369
|
my $snaptime = time;
|
|
4370
|
if ($hassnap) {
|
|
4371
|
delete $register{$path}->{'snap1'};
|
|
4372
|
$register{$path}->{'status'} = $uistatus;
|
|
4373
|
if ($macip) {
|
|
4374
|
my $esc_localpath = shell_esc_chars($path);
|
|
4375
|
$res .= `$sshcmd $macip "sudo /usr/bin/qemu-img snapshot -d snap1 $esc_localpath"`;
|
|
4376
|
} else {
|
|
4377
|
$res .= `/usr/bin/qemu-img snapshot -d snap1 "$path"`;
|
|
4378
|
}
|
|
4379
|
$register{$path}->{'status'} = $status;
|
|
4380
|
$postreply .= "Status=$uistatus OK $uistatus $obj->{type} image: $obj->{name}\n";
|
|
4381
|
$main::syslogit->($user, "info", "$uistatus $obj->{type} image: $obj->{name}: $uuid");
|
|
4382
|
} else {
|
|
4383
|
$postreply .= "Status=ERROR No snapshot found in $obj->{name}\n";
|
|
4384
|
delete $register{$path}->{'snap1'};
|
|
4385
|
$uistatus = $status;
|
|
4386
|
}
|
|
4387
|
1;
|
|
4388
|
} or do {$postreply .= "Status=ERROR $@\n";};
|
|
4389
|
$main::updateUI->({tab=>"images", user=>$user, type=>"update", uuid=>$obj->{'uuid'}, status=>$status, snap1=>'--'});
|
|
4390
|
} else {
|
|
4391
|
$postreply .= "Status=ERROR Only qcow2 images can be unsnapped\n";
|
|
4392
|
}
|
|
4393
|
return $postreply;
|
|
4394
|
}
|
|
4395
|
|
|
4396
|
sub Revert {
|
|
4397
|
my ($image, $action, $obj) = @_;
|
|
4398
|
if ($help) {
|
|
4399
|
return <<END
|
|
4400
|
GET:image:
|
|
4401
|
Applies a snapshot to a qcow2 image, i.e. the image is reverted to the state it was in when the snapshot was taken. Image can not be in use by a running server.
|
|
4402
|
END
|
|
4403
|
}
|
|
4404
|
my $status = $obj->{status};
|
|
4405
|
my $path = $obj->{path};
|
|
4406
|
$uistatus = "reverting";
|
|
4407
|
$uipath = $path;
|
|
4408
|
my $macip;
|
|
4409
|
if ($status ne "used" && $status ne "unused") {
|
|
4410
|
$postreply .= "Status=ERROR Please shut down or pause your virtual machine before reverting\n";
|
|
4411
|
} elsif ($obj->{type} eq "qcow2") {
|
|
4412
|
my $newpath = $path;
|
|
4413
|
my $hassnap;
|
|
4414
|
if ($obj->{mac} && $path =~ /\/mnt\/stabile\/node\//) {
|
|
4415
|
unless ( tie(%nodereg,'Tie::DBI', Hash::Merge::merge({table=>'nodes', key=>'mac', CLOBBER=>1}, $Stabile::dbopts)) ) {return 0};
|
|
4416
|
$macip = $nodereg{$obj->{mac}}->{'ip'};
|
|
4417
|
untie %nodereg;
|
|
4418
|
$newpath = "$macip:$path";
|
|
4419
|
my $esc_path = $path;
|
|
4420
|
$esc_path =~ s/([ ])/\\$1/g;
|
|
4421
|
my $qinfo = `ssh -l irigo -i /var/www/.ssh/id_rsa_www -o UserKnownHostsFile=/dev/null -o StrictHostKeyChecking=no $macip "/usr/bin/qemu-img snapshot -l $esc_path"`;
|
|
4422
|
$hassnap = ($qinfo =~ /snap1/g);
|
|
4423
|
} else {
|
|
4424
|
my $qinfo = `/usr/bin/qemu-img snapshot -l "$path"`;
|
|
4425
|
$hassnap = ($qinfo =~ /snap1/g);
|
|
4426
|
}
|
|
4427
|
eval {
|
|
4428
|
if ($hassnap) {
|
|
4429
|
$register{$path}->{'status'} = $uistatus;
|
|
4430
|
if ($macip) {
|
|
4431
|
my $esc_localpath = shell_esc_chars($path);
|
|
4432
|
$res .= `$sshcmd $macip "sudo /usr/bin/qemu-img snapshot -a snap1 $esc_localpath"`;
|
|
4433
|
} else {
|
|
4434
|
$res .= `/usr/bin/qemu-img snapshot -a snap1 "$path"`;
|
|
4435
|
}
|
|
4436
|
$register{$path}->{'status'} = $status;
|
|
4437
|
$postreply .= "Status=OK $uistatus $obj->{type} image: $obj->{name}\n";
|
|
4438
|
$main::syslogit->($user, "info", "$uistatus $obj->{type} image: $obj->{name}: $uuid");
|
|
4439
|
} else {
|
|
4440
|
$postreply .= "Status=ERROR no snapshot found\n";
|
|
4441
|
$uistatus = $status;
|
|
4442
|
}
|
|
4443
|
1;
|
|
4444
|
} or do {$postreply .= "Status=ERROR $@\n";};
|
|
4445
|
$main::updateUI->({tab=>"images", user=>$user, type=>"update", uuid=>$obj->{'uuid'}, status=>$status, snap1=>'--'});
|
|
4446
|
} else {
|
|
4447
|
$postreply .= "Status=ERROR Only qcow2 images can be reverted\n";
|
|
4448
|
}
|
|
4449
|
return;
|
|
4450
|
}
|
|
4451
|
|
|
4452
|
sub Zbackup {
|
|
4453
|
my ($image, $action, $obj) = @_;
|
|
4454
|
if ($help) {
|
|
4455
|
return <<END
|
|
4456
|
GET:mac, storagepool, synconly, snaponly, imageretention, backupretention:
|
|
4457
|
Backs all images on ZFS storage up by taking a storage snapshot. By default all shared storagepools are backed up.
|
|
4458
|
If storagepool -1 is specified, all ZFS node storages is backed up. If "mac" is specified, only specific node is backed up.
|
|
4459
|
If "synconly" is set, no new snapshots are taken - only syncing of snapshots is performed.
|
|
4460
|
If "snaponly" is set, only local active storage snapshot is taken - no sending to backup storage is done.
|
|
4461
|
"xretention" can be either simply number of snapshots to keep, or max age of snapshot to keep in seconds [s], hours [h] or days [d],
|
|
4462
|
e.g. "imageretention=10" will keep 10 image snapshots, "imageretention=600s" will purte image snapshots older than 600 seconds if possible, or "backretention=14d" will purge backup snapshots older than 14 days.
|
|
4463
|
END
|
|
4464
|
}
|
|
4465
|
if ($isadmin) {
|
|
4466
|
my $synconly = $obj->{'synconly'};
|
|
4467
|
my $snaponly = $obj->{'snaponly'};
|
|
4468
|
my $mac = $obj->{'mac'};
|
|
4469
|
my $storagepool = $obj->{'storagepool'};
|
|
4470
|
$storagepool = -1 if ($mac);
|
|
4471
|
my $imageretention = $obj->{'imageretention'} || $imageretention;
|
|
4472
|
my $backupretention = $obj->{'backupretention'} || $backupretention;
|
|
4473
|
|
|
4474
|
my $basepath = "stabile-backup";
|
|
4475
|
my $bpath = $basepath;
|
|
4476
|
my $mounts = `/bin/cat /proc/mounts`;
|
|
4477
|
my $zbackupavailable = (($mounts =~ /$bpath (\S+) zfs/)?$1:'');
|
|
4478
|
unless ($zbackupavailable) {$postreply .= "Status=OK ZFS backup not available, only doing local snapshots\n";}
|
|
4479
|
my $zfscmd = "zfs";
|
|
4480
|
my $macip;
|
|
4481
|
my $ipath = $spools[0]->{'zfs'} || 'stabile-images/images';
|
|
4482
|
my @nspools = @spools;
|
|
4483
|
if (!(defined $obj->{'storagepool'}) || $storagepool == -1) {
|
|
4484
|
@nspools = () if ($storagepool == -1); # Only do node backups
|
|
4485
|
unless ( tie(%nodereg,'Tie::DBI', Hash::Merge::merge({table=>'nodes', key=>'mac', CLOBBER=>1}, $Stabile::dbopts)) ) {return 0};
|
|
4486
|
# my $nipath = $ipath;
|
|
4487
|
# $nipath = "$1/node" if ($nipath =~ /(.+)\/(.+)/);
|
|
4488
|
my $nipath = 'stabile-node/node';
|
|
4489
|
foreach my $node (values %nodereg) {
|
|
4490
|
push @nspools, {
|
|
4491
|
mac=>$node->{'mac'},
|
|
4492
|
macip=>$node->{'ip'},
|
|
4493
|
zfs=>$nipath,
|
|
4494
|
id=>-1
|
|
4495
|
} if ($node->{'stor'} eq 'zfs' && (!$mac || $node->{'mac'} eq $mac))
|
|
4496
|
}
|
|
4497
|
untie %nodereg;
|
|
4498
|
}
|
|
4499
|
if (`pgrep zfs`) {
|
|
4500
|
$postreply .= "Status=ERROR Another ZFS backup is running. Please wait a minute...\n";
|
|
4501
|
$postmsg = "ERROR ERROR Another ZFS backup is running. Please wait a minute...";
|
|
4502
|
return $postreply;
|
|
4503
|
}
|
|
4504
|
$postreply .= "Status=OK Performing ZFS backup on " . (scalar @nspools) . " storage pools with image retention $imageretention, backup retention $backupretention\n";
|
|
4505
|
|
|
4506
|
foreach my $spool (@nspools) {
|
|
4507
|
$ipath = $spool->{'zfs'};
|
|
4508
|
if ($spool->{'id'} == -1) { # We're doing a node backup
|
|
4509
|
$mac = $spool->{'mac'};
|
|
4510
|
$macip = $spool->{'macip'};
|
|
4511
|
$bpath = "$basepath/node-$mac";
|
|
4512
|
} else {
|
|
4513
|
next unless ($ipath);
|
|
4514
|
next if (($storagepool || $storagepool eq '0') && $storagepool ne $spool->{'id'});
|
|
4515
|
$bpath = "$basepath/$1" if ($ipath =~ /.+\/(.+)/);
|
|
4516
|
$mac = '';
|
|
4517
|
$macip = '';
|
|
4518
|
}
|
|
4519
|
if ($macip) {$zfscmd = "$sshcmd $macip sudo zfs";}
|
|
4520
|
else {$zfscmd = "zfs";}
|
|
4521
|
|
|
4522
|
$postreply .= "Status=OK Commencing ZFS backup of $ipath $macip, storagepool=$storagepool, synconly=$synconly, snaponly=$snaponly\n";
|
|
4523
|
my $res;
|
|
4524
|
my $cmd;
|
|
4525
|
my @imagesnaps;
|
|
4526
|
my @backupsnaps;
|
|
4527
|
|
|
4528
|
# example: stabile-images/images@SNAPSHOT-20200524172901
|
|
4529
|
$cmd = qq/$zfscmd list -t snapshot | grep '$ipath'/;
|
|
4530
|
my $snaplist = `$cmd`;
|
|
4531
|
my @snaplines = split("\n", $snaplist);
|
|
4532
|
foreach my $snap (@snaplines) {
|
|
4533
|
push @imagesnaps, $2 if ($snap =~ /(.*)\@SNAPSHOT-(\d+)/);
|
|
4534
|
}
|
|
4535
|
if ($zbackupavailable) {
|
|
4536
|
$cmd = qq/zfs list -t snapshot | grep '$bpath'/;
|
|
4537
|
$snaplist = `$cmd`;
|
|
4538
|
@snaplines = split("\n", $snaplist);
|
|
4539
|
foreach my $snap (@snaplines) {
|
|
4540
|
push @backupsnaps, $2 if ($snap =~ /(.*)\@SNAPSHOT-(\d+)/);
|
|
4541
|
}
|
|
4542
|
}
|
|
4543
|
# Find matching snapshots
|
|
4544
|
my $matches=0;
|
|
4545
|
my $matchbase = 0;
|
|
4546
|
foreach my $bsnap (@backupsnaps) {
|
|
4547
|
if ($bsnap eq $imagesnaps[$matchbase + $matches]) { # matching snapshot found
|
|
4548
|
$matches++;
|
|
4549
|
} elsif ($matches) { # backup snapshots are ahead of image snapshots - correct manually, i.e. delete them.
|
|
4550
|
$postreply .= "Status=ERROR Snapshots are out of sync.\n";
|
|
4551
|
$postmsg = "ERROR Snapshots are out of sync";
|
|
4552
|
$main::syslogit->($user, 'info', "ERROR snapshots of $ipath and $bpath are out of sync.");
|
|
4553
|
return $postreply;
|
|
4554
|
} elsif (!$matchbase) { # Possibly there are image snapshots older than there are backup snapshots, find the match base i.e. first match in @imagesnaps
|
|
4555
|
my $mb=0;
|
|
4556
|
foreach my $isnap (@imagesnaps) {
|
|
4557
|
if ($bsnap eq $isnap) { # matching snapshot found
|
|
4558
|
$matchbase = $mb;
|
|
4559
|
$matches++;
|
|
4560
|
last;
|
|
4561
|
}
|
|
4562
|
$mb++;
|
|
4563
|
}
|
|
4564
|
}
|
|
4565
|
}
|
|
4566
|
|
|
4567
|
my $lastisnap = $imagesnaps[scalar @imagesnaps -1];
|
|
4568
|
my $lastisnaptime = timelocal($6,$5,$4,$3,$2-1,$1) if ($lastisnap =~ /(\d\d\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)/);
|
|
4569
|
my $td = ($current_time - $lastisnaptime);
|
|
4570
|
if ($td<=5) {
|
|
4571
|
$postreply .= "Status=ERROR Last backup was taken $td seconds ago. Please wait a minute...\n";
|
|
4572
|
$postmsg = "ERROR ERROR Last backup was taken $td seconds ago. Please wait a minute...";
|
|
4573
|
return $postreply;
|
|
4574
|
}
|
|
4575
|
my $ni = scalar @imagesnaps;
|
|
4576
|
my $nb = scalar @backupsnaps;
|
|
4577
|
# If there are unsynced image snaps - sync them
|
|
4578
|
if ($zbackupavailable && !$snaponly) {
|
|
4579
|
if (scalar @imagesnaps > $matches+$matchbase) {
|
|
4580
|
for (my $j=$matches+$matchbase; $j < scalar @imagesnaps; $j++) {
|
|
4581
|
if ($macip) {
|
|
4582
|
$cmd = qq[$zfscmd "send -i $ipath\@SNAPSHOT-$imagesnaps[$j-1] $ipath\@SNAPSHOT-$imagesnaps[$j] | ssh 10.0.0.1 sudo zfs receive $bpath"]; # -R
|
|
4583
|
} else {
|
|
4584
|
$cmd = qq[zfs send -i $ipath\@SNAPSHOT-$imagesnaps[$j-1] $ipath\@SNAPSHOT-$imagesnaps[$j] | zfs receive $bpath]; # -R
|
|
4585
|
}
|
|
4586
|
$res = `$cmd 2>&1`;
|
|
4587
|
unless (
|
|
4588
|
($res && !$macip) #ssh will warn about adding to list of known hosts
|
|
4589
|
|| $res =~ /cannot receive/
|
|
4590
|
) {
|
|
4591
|
$matches++;
|
|
4592
|
$nb++;
|
|
4593
|
$postreply .= "Status=OK Sending ZFS snapshot $j $imagesnaps[$j-1]->$imagesnaps[$j] of $macip $ipath to $bpath $res\n";
|
|
4594
|
$main::syslogit->($user, 'info', "OK Sending ZFS snapshot $imagesnaps[$j-1]->$imagesnaps[$j] of $macip $ipath to $bpath $res");
|
|
4595
|
} else {
|
|
4596
|
$postreply .= "Status=Error Problem sending ZFS snapshot $j $imagesnaps[$j-1]->$imagesnaps[$j] of $macip $ipath to $bpath $res\n";
|
|
4597
|
$main::syslogit->($user, 'info', "Error Problem sending ZFS snapshot $imagesnaps[$j-1]->$imagesnaps[$j] of $macip $ipath to $bpath $res");
|
|
4598
|
}
|
|
4599
|
}
|
|
4600
|
}
|
|
4601
|
}
|
|
4602
|
$res = '';
|
|
4603
|
|
|
4604
|
if ($matches && !$synconly) { # snapshots are in sync
|
|
4605
|
# Then perform the actual snapshot
|
|
4606
|
my $snap1 = sprintf "%4d%02d%02d%02d%02d%02d",$year,$mon+1,$mday,$hour,$min,$sec;
|
|
4607
|
my $oldsnap = $imagesnaps[$matches+$matchbase-1];
|
|
4608
|
$cmd = qq|$zfscmd snapshot -r $ipath\@SNAPSHOT-$snap1|;
|
|
4609
|
$postreply .= "Status=OK Performing ZFS snapshot with $matches matches and base $matchbase $res\n";
|
|
4610
|
$res = `$cmd 2>&1`;
|
|
4611
|
unless ($res && !$macip) {
|
|
4612
|
$ni++;
|
|
4613
|
push @imagesnaps, $snap1;
|
|
4614
|
}
|
|
4615
|
# Send it to backup if asked to
|
|
4616
|
unless ($snaponly || !$zbackupavailable) {
|
|
4617
|
if ($macip) {
|
|
4618
|
$cmd = qq[$zfscmd "send -i $ipath\@SNAPSHOT-$oldsnap $ipath\@SNAPSHOT-$snap1 | ssh 10.0.0.1 sudo zfs receive $bpath"];
|
|
4619
|
} else {
|
|
4620
|
$cmd = qq[zfs send -i $ipath\@SNAPSHOT-$oldsnap $ipath\@SNAPSHOT-$snap1 | zfs receive $bpath]; # -R
|
|
4621
|
}
|
|
4622
|
$res .= `$cmd 2>&1`;
|
|
4623
|
unless ($res && !$macip) {
|
|
4624
|
$matches++;
|
|
4625
|
$nb++;
|
|
4626
|
push @backupsnaps, $snap1;
|
|
4627
|
}
|
|
4628
|
$postreply .= "Status=OK Sending ZFS snapshot of $macip $ipath $oldsnap->$snap1 to $bpath $res\n";
|
|
4629
|
$main::syslogit->($user, 'info', "OK Sending ZFS snapshot of $macip $ipath $oldsnap->$snap1 to $bpath $res");
|
|
4630
|
}
|
|
4631
|
$postreply .= "Status=OK Synced $matches ZFS snapshots. There are now $ni image snapshots, $nb backup snapshots.\n";
|
|
4632
|
} elsif ($matches) {
|
|
4633
|
$postreply .= "Status=OK Synced $matches ZFS snapshots. There are $ni image snapshots, $nb backup snapshots.\n";
|
|
4634
|
# } elsif ($ni==0 && $nb==0) { # We start from a blank slate
|
|
4635
|
} elsif ($nb==0) { # We start from a blank slate
|
|
4636
|
my $snap1 = sprintf "%4d%02d%02d%02d%02d%02d",$year,$mon+1,$mday,$hour,$min,$sec;
|
|
4637
|
$cmd = qq|$zfscmd snapshot -r $ipath\@SNAPSHOT-$snap1|;
|
|
4638
|
$res = `$cmd 2>&1`;
|
|
4639
|
$postreply .= "Status=OK Performing ZFS snapshot from scratch $res $macip\n";
|
|
4640
|
# Send it to backup by creating new filesystem (created autotically)
|
|
4641
|
unless ($snaponly || !$zbackupavailable) {
|
|
4642
|
if ($macip) {
|
|
4643
|
$cmd = qq[$zfscmd "send $ipath\@SNAPSHOT-$snap1 | ssh 10.0.0.1 sudo zfs receive $bpath"];
|
|
4644
|
$res .= `$cmd 2>&1`;
|
|
4645
|
$cmd = qq|zfs set readonly=on $bpath|;
|
|
4646
|
$res .= `$cmd 2>&1`;
|
|
4647
|
$cmd = qq|zfs mount $bpath|;
|
|
4648
|
$res .= `$cmd 2>&1`;
|
|
4649
|
} else {
|
|
4650
|
$cmd = qq[zfs send -R $ipath\@SNAPSHOT-$snap1 | zfs receive $bpath];
|
|
4651
|
$res .= `$cmd 2>&1`;
|
|
4652
|
$cmd = qq|zfs set readonly=on $bpath|;
|
|
4653
|
$res .= `$cmd 2>&1`;
|
|
4654
|
}
|
|
4655
|
$postreply .= "Status=OK Sending complete ZFS snapshot of $macip:$ipath\@$snap1 to $bpath $res\n";
|
|
4656
|
$main::syslogit->($user, 'info', "OK Sending complete ZFS snapshot of $macip:$ipath\@$snap1 to $bpath $res");
|
|
4657
|
$matches++;
|
|
4658
|
$nb++;
|
|
4659
|
}
|
|
4660
|
$ni++;
|
|
4661
|
$postreply .= "Status=OK Synced 0 ZFS snapshots. There are $ni image snapshots, $nb backup snapshots.\n";
|
|
4662
|
} else {
|
|
4663
|
$postreply .= "Status=ERROR Unable to sync snapshots.\n";
|
|
4664
|
$postmsg = "ERROR Unable to sync snapshots";
|
|
4665
|
}
|
|
4666
|
my $i=0;
|
|
4667
|
# Purge image snapshots if asked to
|
|
4668
|
if ($imageretention && $matches>1) {
|
|
4669
|
my $rtime;
|
|
4670
|
if ($imageretention =~ /(\d+)(s|h|d)/) {
|
|
4671
|
$rtime = $1;
|
|
4672
|
$rtime = $1*60*60 if ($2 eq 'h');
|
|
4673
|
$rtime = $1*60*60*24 if ($2 eq 'd');
|
|
4674
|
$postreply .= "Status=OK Keeping image snapshots newer than $imageretention out of $ni.\n";
|
|
4675
|
} elsif ($imageretention =~ /(\d+)$/) {
|
|
4676
|
$postreply .= "Status=OK Keeping " . (($imageretention>$ni)?$ni:$imageretention) . " image snapshots out of $ni.\n";
|
|
4677
|
} else {
|
|
4678
|
$imageretention = 0;
|
|
4679
|
}
|
|
4680
|
if ($imageretention) {
|
|
4681
|
foreach my $isnap (@imagesnaps) {
|
|
4682
|
my $purge;
|
|
4683
|
if ($rtime) {
|
|
4684
|
my $snaptime = timelocal($6,$5,$4,$3,$2-1,$1) if ($isnap =~ /(\d\d\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)/);
|
|
4685
|
my $tdiff = ($current_time - $snaptime);
|
|
4686
|
if ( $matches>1 && $tdiff>$rtime )
|
|
4687
|
{$purge = 1;}
|
|
4688
|
else
|
|
4689
|
{last;}
|
|
4690
|
} else { # a simple number was specified
|
|
4691
|
# if ( $matches>1 && $matches+$matchbase>$imageretention )
|
|
4692
|
if ( $matches>1 && $ni>$imageretention )
|
|
4693
|
{$purge = 1;}
|
|
4694
|
else
|
|
4695
|
{last;}
|
|
4696
|
}
|
|
4697
|
if ($purge) {
|
|
4698
|
$cmd = qq|$zfscmd destroy $ipath\@SNAPSHOT-$isnap|;
|
|
4699
|
$res = `$cmd 2>&1`;
|
|
4700
|
$postreply .= "Status=OK Purging image snapshot $isnap from $ipath.\n";
|
|
4701
|
$main::syslogit->($user, 'info', "OK Purging image snapshot $isnap from $ipath");
|
|
4702
|
$matches-- if ($i>=$matchbase);
|
|
4703
|
$ni--;
|
|
4704
|
}
|
|
4705
|
$i++;
|
|
4706
|
}
|
|
4707
|
}
|
|
4708
|
}
|
|
4709
|
# Purge backup snapshots if asked to
|
|
4710
|
if ($backupretention && $matches) {
|
|
4711
|
my $rtime;
|
|
4712
|
if ($backupretention =~ /(\d+)(s|h|d)/) {
|
|
4713
|
$rtime = $1;
|
|
4714
|
$rtime = $1*60*60 if ($2 eq 'h');
|
|
4715
|
$rtime = $1*60*60*24 if ($2 eq 'd');
|
|
4716
|
$postreply .= "Status=OK Keeping backup snapshots newer than $backupretention out of $nb.\n";
|
|
4717
|
} elsif ($backupretention =~ /(\d+)$/) {
|
|
4718
|
$postreply .= "Status=OK Keeping " . (($backupretention>$nb)?$nb:$backupretention) . " backup snapshots out of $nb.\n";
|
|
4719
|
} else {
|
|
4720
|
$backupretention = 0;
|
|
4721
|
}
|
|
4722
|
if ($backupretention && $zbackupavailable) {
|
|
4723
|
foreach my $bsnap (@backupsnaps) {
|
|
4724
|
my $purge;
|
|
4725
|
if ($bsnap eq $imagesnaps[$matchbase+$matches-1]) { # We need to keep the last snapshot synced
|
|
4726
|
$postreply .= "Status=OK Not purging backup snapshot $matchbase $bsnap.\n";
|
|
4727
|
last;
|
|
4728
|
} else {
|
|
4729
|
if ($rtime) {
|
|
4730
|
my $snaptime = timelocal($6,$5,$4,$3,$2-1,$1) if ($bsnap =~ /(\d\d\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)/);
|
|
4731
|
my $tdiff = ($current_time - $snaptime);
|
|
4732
|
if ( $matches>1 && $tdiff>$rtime )
|
|
4733
|
{$purge = 1;}
|
|
4734
|
} else {
|
|
4735
|
if ( $nb>$backupretention )
|
|
4736
|
{$purge = 1;}
|
|
4737
|
}
|
|
4738
|
if ($purge) {
|
|
4739
|
$cmd = qq|zfs destroy $bpath\@SNAPSHOT-$bsnap|;
|
|
4740
|
$res = `$cmd 2>&1`;
|
|
4741
|
$postreply .= "Status=OK Purging backup snapshot $bsnap from $bpath.\n";
|
|
4742
|
$main::syslogit->($user, 'info', "OK Purging backup snapshot $bsnap from $bpath");
|
|
4743
|
$nb--;
|
|
4744
|
} else {
|
|
4745
|
last;
|
|
4746
|
}
|
|
4747
|
}
|
|
4748
|
}
|
|
4749
|
}
|
|
4750
|
}
|
|
4751
|
$postmsg .= "OK Performing ZFS backup of $bpath. There are $ni image snapshots and $nb backup snapshots. ";
|
|
4752
|
}
|
|
4753
|
$postreply .= "Status=OK Updating all btimes\n";
|
|
4754
|
Updateallbtimes();
|
|
4755
|
} else {
|
|
4756
|
$postreply .= "Status=ERROR Not allowed\n";
|
|
4757
|
$postmsg = "ERROR Not allowed";
|
|
4758
|
}
|
|
4759
|
$main::updateUI->({tab=>"images", user=>$user, type=>"message", message=>$postmsg});
|
|
4760
|
return $postreply;
|
|
4761
|
}
|
|
4762
|
|
|
4763
|
sub Backupfuel {
|
|
4764
|
my ($image, $action, $obj) = @_;
|
|
4765
|
if ($help) {
|
|
4766
|
return <<END
|
|
4767
|
GET:username, dozfs:
|
|
4768
|
Backs up a user's fuel storage. If [dozfs] is set, fuel on ZFS volumes is backed up, even if it should be handled by regular ZFS backups.
|
|
4769
|
END
|
|
4770
|
}
|
|
4771
|
my $username = $obj->{'username'} || $user;
|
|
4772
|
return "Status=Error Not allowed\n" unless ($isadmin || $username eq $user);
|
|
4773
|
|
|
4774
|
my $remolder = "14D";
|
|
4775
|
my $stordevs = Liststoragedevices('', 'getstoragedevices');
|
|
4776
|
my $backupdev = Getbackupdevice('', 'getbackupdevice');
|
|
4777
|
my $backupdevtype = $stordevs->{$backupdev}->{type};
|
|
4778
|
foreach my $spool (@spools) {
|
|
4779
|
my $ppath = $spool->{"path"};
|
|
4780
|
my $pid = $spool->{"id"};
|
|
4781
|
if (($spool->{"zfs"} && $backupdevtype eq 'zfs') && !$obj->{'dozfs'}) {
|
|
4782
|
$postreply .= "Status=OK Skipping fuel on ZFS storage: $ppath/$username/fuel\n";
|
|
4783
|
} elsif ($pid eq '-1') {
|
|
4784
|
;
|
|
4785
|
} elsif (!$backupdir || !(-d $backupdir)) {
|
|
4786
|
$postreply .= "Status=OK Backup dir $backupdir does not exist\n";
|
|
4787
|
} elsif (-d "$ppath/$username/fuel" && !is_folder_empty("$ppath/$username/fuel")) {
|
|
4788
|
my $srcdir = "$ppath/$username/fuel";
|
|
4789
|
my $destdir = "$backupdir/$username/fuel/$pid";
|
|
4790
|
|
|
4791
|
`mkdir -p "$destdir"` unless (-e "$destdir");
|
|
4792
|
# Do the backup
|
|
4793
|
my $cmd = qq|/usr/bin/rdiff-backup --print-statistics "$srcdir" "$destdir"|;
|
|
4794
|
my $res = `$cmd`;
|
|
4795
|
$cmd = qq|/usr/bin/rdiff-backup --print-statistics --force --remove-older-than $remolder "$destdir"|;
|
|
4796
|
$res .= `$cmd`;
|
|
4797
|
if ($res =~ /Errors 0/) {
|
|
4798
|
my $change = $1 if ($res =~ /TotalDestinationSizeChange \d+ \((.+)\)/);
|
|
4799
|
$postreply .= "Status=OK Backed up $change, $srcdir -> $destdir\n";
|
|
4800
|
$main::syslogit->($user, "info", "OK backed up $change, $srcdir -> $destdir") if ($change);
|
|
4801
|
} else {
|
|
4802
|
$res =~ s/\n/ /g;
|
|
4803
|
$postreply .= "Status=Error There was a problem backup up $srcdir -> $destdir: $res\n";
|
|
4804
|
$main::syslogit->($user, "there was a problem backup up $srcdir -> $destdir");
|
|
4805
|
}
|
|
4806
|
} else {
|
|
4807
|
$postreply .= "Status=OK Skipping empty fuel on: $ppath/$username/fuel\n";
|
|
4808
|
}
|
|
4809
|
}
|
|
4810
|
return $postreply;
|
|
4811
|
}
|
|
4812
|
|
|
4813
|
sub is_folder_empty {
|
|
4814
|
my $dirname = shift;
|
|
4815
|
opendir(my $dh, $dirname) or die "Not a directory";
|
|
4816
|
return scalar(grep { $_ ne "." && $_ ne ".." } readdir($dh)) == 0;
|
|
4817
|
}
|
|
4818
|
|
|
4819
|
sub Backup {
|
|
4820
|
my ($image, $action, $obj) = @_;
|
|
4821
|
if ($help) {
|
|
4822
|
return <<END
|
|
4823
|
GET:image, skipzfs:
|
|
4824
|
Backs an image up. Set [skipzfs] if ZFS backup is configured, and you do not want to skip images on ZFS storage.
|
|
4825
|
END
|
|
4826
|
}
|
|
4827
|
my $path = $obj->{path} || $image;
|
|
4828
|
my $status = $obj->{status};
|
|
4829
|
my $skipzfs = $obj->{skipzfs};
|
|
4830
|
$uistatus = "backingup";
|
|
4831
|
$uipath = $path;
|
|
4832
|
my $remolder;
|
|
4833
|
$remolder = "14D" if ($obj->{bschedule} eq "daily14");;
|
|
4834
|
$remolder = "7D" if ($obj->{bschedule} eq "daily7");
|
|
4835
|
|
|
4836
|
my $stordevs = Liststoragedevices('', 'getstoragedevices');
|
|
4837
|
my $backupdev = Getbackupdevice('', 'getbackupdevice');
|
|
4838
|
my $backupdevtype = $stordevs->{$backupdev}->{type};
|
|
4839
|
# Nodes are assumed to alwasy use ZFS
|
|
4840
|
if ($backupdevtype eq 'zfs' && $skipzfs && ($obj->{regstoragepool} == -1 || $spools[$obj->{regstoragepool}]->{'zfs'})) {
|
|
4841
|
return "Status=OK Skipping image on ZFS $path\n";
|
|
4842
|
}
|
|
4843
|
if ($status eq "snapshotting" || $status eq "unsnapping" || $status eq "reverting" || $status eq "cloning" ||
|
|
4844
|
$status eq "moving" || $status eq "converting") {
|
|
4845
|
$postreply .= "Status=ERROR Problem backing up $obj->{type} image: $obj->{name}\n";
|
|
4846
|
} elsif ($obj->{regstoragepool} == -1) {
|
|
4847
|
my $res = createNodeTask($obj->{mac}, "BACKUP $user $uistatus $status \"$path\" \"$backupdir\" $remolder", $status);
|
|
4848
|
if ($res) {
|
|
4849
|
$postreply .= "OK not backingup image: $obj->{name} (on node, $res)\n";
|
|
4850
|
} else {
|
|
4851
|
$register{$path}->{'status'} = $uistatus;
|
|
4852
|
$uistatus = "lbackingup" if ($status eq "active"); # Do lvm snapshot before backing up
|
|
4853
|
$main::syslogit->($user, "info", "$uistatus $obj->{type} image: $obj->{name}: $uuid");
|
|
4854
|
$postreply .= "Status=backingup OK backingup image: $obj->{name} (on node)\n";
|
|
4855
|
}
|
|
4856
|
} elsif (!$spools[$obj->{regstoragepool}]->{'rdiffenabled'}) {
|
|
4857
|
$postreply .= "Status=ERROR Rdiff-backup has not been enabled for this storagepool ($spools[$obj->{regstoragepool}]->{'name'})\n";
|
|
4858
|
} else {
|
|
4859
|
if ($spools[$obj->{regstoragepool}]->{'hostpath'} eq "local" && $status eq "active") {
|
|
4860
|
my $poolpath = $spools[$obj->{regstoragepool}]->{'path'};
|
|
4861
|
# We only need to worry about taking an LVM snapshot if the image is in active use
|
|
4862
|
# We also check if the images is actually on an LVM partition
|
|
4863
|
my $qi = `/bin/cat /proc/mounts | grep "$poolpath"`; # Find the lvm volume mounted on /mnt/images
|
|
4864
|
($qi =~ m/\/dev\/mapper\/(\S+)-(\S+) $pool.+/g)[-1]; # Select last match
|
|
4865
|
my $lvolgroup = $1;
|
|
4866
|
my $lvol = $2;
|
|
4867
|
if ($lvolgroup && $lvol) {
|
|
4868
|
$uistatus = "lbackingup";
|
|
4869
|
}
|
|
4870
|
}
|
|
4871
|
if ($uistatus ne "lbackingup" && $status eq "active") {
|
|
4872
|
$postreply .= "Status=ERROR Image is not on an LVM partition - suspend before backing up.\n";
|
|
4873
|
$main::updateUI->({tab=>"images", user=>$user, type=>"update", path=>$path, status=>$uistatus, message=>"Image is not on an LVM partition - suspend before backing up"});
|
|
4874
|
} else {
|
|
4875
|
my $buser;
|
|
4876
|
my $bname;
|
|
4877
|
if ($path =~ /.*\/(common|$user)\/(.+)/) {
|
|
4878
|
$buser = $1;
|
|
4879
|
$bname = $2;
|
|
4880
|
}
|
|
4881
|
if ($buser && $bname) {
|
|
4882
|
my $dirpath = $spools[$obj->{regstoragepool}]->{'path'};
|
|
4883
|
#chop $dirpath; # Remove last /
|
|
4884
|
eval {
|
|
4885
|
$register{$path}->{'status'} = $uistatus;
|
|
4886
|
my $daemon = Proc::Daemon->new(
|
|
4887
|
work_dir => '/usr/local/bin',
|
|
4888
|
exec_command => "perl -U steamExec $buser $uistatus $status \"$bname\" \"$dirpath\" \"$backupdir\" $remolder"
|
|
4889
|
) or do {$postreply .= "Status=ERROR $@\n";};
|
|
4890
|
my $pid = $daemon->Init();
|
|
4891
|
$postreply .= "Status=backingup OK backingup image: $obj->{name}\n";
|
|
4892
|
$main::syslogit->($user, "info", "$uistatus $obj->{type} image: $obj->{name}: $bname");
|
|
4893
|
1;
|
|
4894
|
} or do {$postreply .= "Status=ERROR $@\n";}
|
|
4895
|
} else {
|
|
4896
|
$postreply .= "Status=ERROR Problem backing up $path\n";
|
|
4897
|
}
|
|
4898
|
}
|
|
4899
|
}
|
|
4900
|
return $postreply;
|
|
4901
|
}
|
|
4902
|
|
|
4903
|
sub Restore {
|
|
4904
|
my ($image, $action, $obj) = @_;
|
|
4905
|
if ($help) {
|
|
4906
|
return <<END
|
|
4907
|
GET:image:
|
|
4908
|
Backs an image up.
|
|
4909
|
END
|
|
4910
|
}
|
|
4911
|
my $path = $obj->{path};
|
|
4912
|
my $status = $obj->{status};
|
|
4913
|
$uistatus = "restoring";
|
|
4914
|
my($bname, $dirpath, $suffix) = fileparse($path, (".vmdk", ".img", ".vhd", ".vhdx", ".qcow", ".qcow2", ".vdi", ".iso"));
|
|
4915
|
my $backup = $params{"backup"} || $obj->{backup};
|
|
4916
|
my $pool = $register{$path}->{'storagepool'};
|
|
4917
|
$pool = "0" if ($pool == -1);
|
|
4918
|
my $poolpath = $spools[$pool]->{'path'};
|
|
4919
|
my $restorefromdir = $backupdir;
|
|
4920
|
my $inc = $backup;
|
|
4921
|
my $subdir; # 1 level of subdirs supported
|
|
4922
|
$subdir = $1 if ($dirpath =~ /.+\/$obj->{user}(\/.+)?\//);
|
|
4923
|
|
|
4924
|
if ($backup =~ /^SNAPSHOT-(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})$/) { # We are dealing with a zfs restore
|
|
4925
|
$inc = "$1-$2-$3-$4-$5-$6";
|
|
4926
|
foreach my $spool (@spools) {
|
|
4927
|
my $ppath = $spool->{"path"};
|
|
4928
|
if (-e "$ppath/.zfs/snapshot/$backup/$obj->{user}$subdir/$bname$suffix") {
|
|
4929
|
$restorefromdir = "$ppath/.zfs/snapshot/$backup";
|
|
4930
|
last;
|
|
4931
|
}
|
|
4932
|
}
|
|
4933
|
} else {
|
|
4934
|
if ($backup eq "mirror") {
|
|
4935
|
my $mir = `/bin/ls "$backupdir/$obj->{user}/$bname$suffix/rdiff-backup-data" | grep current_mirror`;
|
|
4936
|
if ($mir =~ /current_mirror\.(\S+)\.data/) {
|
|
4937
|
$inc = $1;
|
|
4938
|
}
|
|
4939
|
}
|
|
4940
|
$inc =~ tr/:T/-/; # qemu-img does not like colons in file names - go figure...
|
|
4941
|
$inc = substr($inc,0,-6);
|
|
4942
|
}
|
|
4943
|
$uipath = "$poolpath/$obj->{user}$subdir/$bname.$inc$suffix";
|
|
4944
|
my $i;
|
|
4945
|
if (-e $uipath) {
|
|
4946
|
$i = 1;
|
|
4947
|
while (-e "$poolpath/$obj->{user}$subdir/$bname.$inc.$i$suffix") {$i++;}
|
|
4948
|
$uipath = "$poolpath/$obj->{user}$subdir/$bname.$inc.$i$suffix";
|
|
4949
|
}
|
|
4950
|
|
|
4951
|
if (-e $uipath) {
|
|
4952
|
$postreply .= "Status=ERROR This image is already being restored\n";
|
|
4953
|
} elsif ($obj->{user} ne $user && !$isadmin) {
|
|
4954
|
$postreply .= "Status=ERROR No restore privs\n";
|
|
4955
|
} elsif (!$backup || $backup eq "--") {
|
|
4956
|
$postreply .= "Status=ERROR No backup selected\n";
|
|
4957
|
} elsif (overQuotas($obj->{virtualsize})) {
|
|
4958
|
$postreply .= "Status=ERROR Over quota (". overQuotas($obj->{virtualsize}) . ") restoring: $obj->{name}\n";
|
|
4959
|
} elsif (overStorage($obj->{ksize}*1024, $pool+0)) {
|
|
4960
|
$postreply .= "Status=ERROR Out of storage in destination pool restoring: $obj->{name}\n";
|
|
4961
|
} else {
|
|
4962
|
my $ug = new Data::UUID;
|
|
4963
|
my $newuuid = $ug->create_str();
|
|
4964
|
$register{$uipath} = {
|
|
4965
|
uuid=>$newuuid,
|
|
4966
|
status=>"restoring",
|
|
4967
|
name=>"$obj->{name} ($inc)" . (($i)?" $i":''),
|
|
4968
|
notes=>$obj->{notes},
|
|
4969
|
image2=>$obj->{image2},
|
|
4970
|
managementlink=>$obj->{managementlink},
|
|
4971
|
upgradelink=>$obj->{upgradelink},
|
|
4972
|
terminallink=>$obj->{terminallink},
|
|
4973
|
size=>0,
|
|
4974
|
realsize=>0,
|
|
4975
|
virtualsize=>$obj->{virtualsize},
|
|
4976
|
type=>$obj->{type},
|
|
4977
|
user=>$user
|
|
4978
|
};
|
|
4979
|
eval {
|
|
4980
|
$register{$path}->{'status'} = $uistatus;
|
|
4981
|
my $daemon = Proc::Daemon->new(
|
|
4982
|
work_dir => '/usr/local/bin',
|
|
4983
|
exec_command => "perl -U steamExec $obj->{user} $uistatus $status \"$path\" \"$restorefromdir\" \"$backup\" \"$uipath\""
|
|
4984
|
) or do {$postreply .= "Status=ERROR $@\n";};
|
|
4985
|
my $pid = $daemon->Init();
|
|
4986
|
$postreply .= "Status=$uistatus OK $uistatus $obj->{type} image: $obj->{name} ($inc)". ($console?", $newuuid\n":"\n");
|
|
4987
|
$main::syslogit->($user, "info", "$uistatus $obj->{type} image: $obj->{name} ($inc), $uipath, $newuuid: $uuid");
|
|
4988
|
1;
|
|
4989
|
} or do {$postreply .= "Status=ERROR $@\n";};
|
|
4990
|
$main::updateUI->({tab=>"images", user=>$user, type=>"update"});
|
|
4991
|
}
|
|
4992
|
return $postreply;
|
|
4993
|
}
|
|
4994
|
|
|
4995
|
sub Master {
|
|
4996
|
my ($image, $action, $obj) = @_;
|
|
4997
|
if ($help) {
|
|
4998
|
return <<END
|
|
4999
|
GET:image:
|
|
5000
|
Converts an image to a master image. Image must not be in use.
|
|
5001
|
END
|
|
5002
|
}
|
|
5003
|
my $path = $obj->{path};
|
|
5004
|
my $status = $register{$path}->{status};
|
|
5005
|
$path =~ /(.+)\.$obj->{type}$/;
|
|
5006
|
my $namepath = $1;
|
|
5007
|
my $uiname;
|
|
5008
|
if (!$register{$path}) {
|
|
5009
|
$postreply .= "Status=ERROR Image $path not found\n";
|
|
5010
|
} elsif ($status ne "unused") {
|
|
5011
|
$postreply .= "Status=ERROR Only unused images may be mastered\n";
|
|
5012
|
# } elsif ($namepath =~ /(.+)\.master/ || $register{$path}->{'master'}) {
|
|
5013
|
# $postreply .= "Status=ERROR Only one level of mastering is supported\n";
|
|
5014
|
} elsif ($obj->{istoragepool} == -1 || $obj->{regstoragepool} == -1) {
|
|
5015
|
$postreply .= "Status=ERROR Unable to master $obj->{name} (master images are not supported on node storage)\n";
|
|
5016
|
} elsif ($obj->{type} eq "qcow2") {
|
|
5017
|
# Promoting a regular image to master
|
|
5018
|
# First find an unused path
|
|
5019
|
if (-e "$namepath.master.$obj->{type}") {
|
|
5020
|
my $i = 1;
|
|
5021
|
while ($register{"$namepath.$i.master.$obj->{type}"} || -e "$namepath.$i.master.$obj->{type}") {$i++;};
|
|
5022
|
$uinewpath = "$namepath.$i.master.$obj->{type}";
|
|
5023
|
} else {
|
|
5024
|
$uinewpath = "$namepath.master.$obj->{type}";
|
|
5025
|
}
|
|
5026
|
|
|
5027
|
$uipath = $path;
|
|
5028
|
$uiname = "$obj->{name}";
|
|
5029
|
eval {
|
|
5030
|
my $qinfo = `/bin/mv -iv "$path" "$uinewpath"`;
|
|
5031
|
$register{$path}->{'name'} = $uiname;
|
|
5032
|
$register{$uinewpath} = $register{$path};
|
|
5033
|
delete $register{$path};
|
|
5034
|
$postreply .= "Status=$status Mastered $obj->{type} image: $obj->{name}\n";
|
|
5035
|
chop $qinfo;
|
|
5036
|
$main::syslogit->($user, "info", $qinfo);
|
|
5037
|
1;
|
|
5038
|
} or do {$postreply .= "Status=ERROR $@\n";};
|
|
5039
|
sleep 1;
|
|
5040
|
$main::updateUI->({tab=>"images", user=>$user, type=>"update", uuid=>$obj->{'uuid'}, newpath=>$uinewpath, status=>$status, name=>$uiname});
|
|
5041
|
} else {
|
|
5042
|
$postreply .= "Status=ERROR Only qcow2 images may be mastered\n";
|
|
5043
|
}
|
|
5044
|
return $postreply;
|
|
5045
|
}
|
|
5046
|
|
|
5047
|
sub Unmaster {
|
|
5048
|
my ($image, $action, $obj) = @_;
|
|
5049
|
if ($help) {
|
|
5050
|
return <<END
|
|
5051
|
GET:image:
|
|
5052
|
Converts a master image to a regular image. Image must not be in use.
|
|
5053
|
END
|
|
5054
|
}
|
|
5055
|
my $path = $obj->{path};
|
|
5056
|
my $status = $register{$path}->{status};
|
|
5057
|
$path =~ /(.+)\.$obj->{type}$/;
|
|
5058
|
my $namepath = $1;
|
|
5059
|
my $haschildren = 0;
|
|
5060
|
my $child;
|
|
5061
|
my $uinewpath;
|
|
5062
|
my $iname;
|
|
5063
|
my @regvalues = values %register;
|
|
5064
|
foreach my $val (@regvalues) {
|
|
5065
|
if ($val->{'master'} eq $path) {
|
|
5066
|
$haschildren = 1;
|
|
5067
|
$child = $val->{'name'};
|
|
5068
|
last;
|
|
5069
|
}
|
|
5070
|
}
|
|
5071
|
if (!$register{$path}) {
|
|
5072
|
$postreply .= "Status=ERROR Image $path not found\n";
|
|
5073
|
} elsif ($haschildren) {
|
|
5074
|
$postreply .= "Status=Error Cannot unmaster image. This image is used as master by: $child\n";
|
|
5075
|
} elsif ($status ne "unused" && $status ne "used") {
|
|
5076
|
$postreply .= "Status=ERROR Only used and unused images may be unmastered\n";
|
|
5077
|
} elsif (!( ($namepath =~ /(.+)\.master/) || ($obj->{master} && $obj->{master} ne "--")) ) {
|
|
5078
|
$postreply .= "Status=ERROR You can only unmaster master or child images\n";
|
|
5079
|
} elsif (($obj->{istoragepool} == -1 || $obj->{regstoragepool} == -1) && $namepath =~ /(.+)\.master/) {
|
|
5080
|
$postreply .= "Status=ERROR Unable to unmaster $obj->{name} (master images are not supported on node storage)\n";
|
|
5081
|
} elsif ($obj->{type} eq "qcow2") {
|
|
5082
|
# Demoting a master to regular image
|
|
5083
|
if ($action eq 'unmaster' && $namepath =~ /(.+)\.master$/) {
|
|
5084
|
$namepath = $1;
|
|
5085
|
$uipath = $path;
|
|
5086
|
# First find an unused path
|
|
5087
|
if (-e "$namepath.$obj->{type}") {
|
|
5088
|
my $i = 1;
|
|
5089
|
while ($register{"$namepath.$i.$obj->{type}"} || -e "$namepath.$i.$obj->{type}") {$i++;};
|
|
5090
|
$uinewpath = "$namepath.$i.$obj->{type}";
|
|
5091
|
} else {
|
|
5092
|
$uinewpath = "$namepath.$obj->{type}";
|
|
5093
|
}
|
|
5094
|
|
|
5095
|
$iname = $obj->{name};
|
|
5096
|
$iname =~ /(.+)( \(master\))/;
|
|
5097
|
$iname = $1 if $2;
|
|
5098
|
eval {
|
|
5099
|
my $qinfo = `/bin/mv -iv "$path" "$uinewpath"`;
|
|
5100
|
$register{$path}->{'name'} = $iname;
|
|
5101
|
$register{$uinewpath} = $register{$path};
|
|
5102
|
delete $register{$path};
|
|
5103
|
$postreply .= "Status=$status Unmastered $obj->{type} image: $obj->{name}\n";
|
|
5104
|
chomp $qinfo;
|
|
5105
|
$main::syslogit->($user, "info", $qinfo);
|
|
5106
|
1;
|
|
5107
|
} or do {$postreply .= "Status=ERROR $@\n";}
|
|
5108
|
# Rebasing a child image
|
|
5109
|
} elsif ($action eq 'rebase' && $obj->{master} && $obj->{master} ne "--") {
|
|
5110
|
$uistatus = "rebasing";
|
|
5111
|
$uipath = $path;
|
|
5112
|
$iname = $obj->{name};
|
|
5113
|
$iname =~ /(.+)( \(child\d*\))/;
|
|
5114
|
$iname = $1 if $2;
|
|
5115
|
my $temppath = "$path.temp";
|
|
5116
|
$uipath = $path;
|
|
5117
|
$uimaster = "--";
|
|
5118
|
my $macip;
|
|
5119
|
|
|
5120
|
if ($obj->{mac} && $path =~ /\/mnt\/stabile\/node\//) {
|
|
5121
|
unless ( tie(%nodereg,'Tie::DBI', Hash::Merge::merge({table=>'nodes', key=>'mac', CLOBBER=>1}, $Stabile::dbopts)) ) {return 0};
|
|
5122
|
$macip = $nodereg{$obj->{mac}}->{'ip'};
|
|
5123
|
untie %nodereg;
|
|
5124
|
}
|
|
5125
|
eval {
|
|
5126
|
my $master = $register{$path}->{'master'};
|
|
5127
|
my $usedmaster = '';
|
|
5128
|
# @regvalues = values %register;
|
|
5129
|
if ($master && $master ne '--') {
|
|
5130
|
foreach my $valref (@regvalues) {
|
|
5131
|
$usedmaster = 1 if ($valref->{'master'} eq $master && $valref->{'path'} ne $path); # Check if another image is also using this master
|
|
5132
|
}
|
|
5133
|
}
|
|
5134
|
$main::updateUI->({tab=>"images", user=>$user, type=>"update", uuid=>$obj->{'uuid'}, status=>$uistatus});
|
|
5135
|
$register{$path} = {
|
|
5136
|
master=>"",
|
|
5137
|
name=>"$iname",
|
|
5138
|
notes=>$obj->{notes},
|
|
5139
|
status=>$uistatus,
|
|
5140
|
snap1=>$obj->{snap1},
|
|
5141
|
managementlink=>$obj->{managementlink},
|
|
5142
|
upgradelink=>$obj->{upgradelink},
|
|
5143
|
terminallink=>$obj->{terminallink},
|
|
5144
|
image2=>$obj->{image2},
|
|
5145
|
storagepool=>$obj->{istoragepool},
|
|
5146
|
status=>$uistatus
|
|
5147
|
};
|
|
5148
|
|
|
5149
|
if ($macip) {
|
|
5150
|
my $esc_localpath = shell_esc_chars($path);
|
|
5151
|
my $esc_localpath2 = shell_esc_chars($temppath);
|
|
5152
|
$res .= `$sshcmd $macip "/usr/bin/qemu-img convert $esc_localpath -O qcow2 $esc_localpath2"`;
|
|
5153
|
$res .= `$sshcmd $macip "if [ -f $esc_localpath2 ]; then /bin/mv -v $esc_localpath2 $esc_localpath; fi"`;
|
|
5154
|
} else {
|
|
5155
|
$res .= `/usr/bin/qemu-img convert -O qcow2 "$path" "$temppath"`;
|
|
5156
|
$res .= `if [ -f "$temppath" ]; then /bin/mv -v "$temppath" "$path"; fi`;
|
|
5157
|
}
|
|
5158
|
if ($master && !$usedmaster) {
|
|
5159
|
$register{$master}->{'status'} = 'unused';
|
|
5160
|
$main::syslogit->('info', "Freeing master $master");
|
|
5161
|
}
|
|
5162
|
$register{$path}->{'master'} = '';
|
|
5163
|
$register{$path}->{'status'} = $status;
|
|
5164
|
|
|
5165
|
$postreply .= "Status=OK $uistatus $obj->{type} image: $obj->{name}\n";
|
|
5166
|
$main::updateUI->({tab=>"images", user=>$user, type=>"update", uuid=>$obj->{'uuid'}, status=>$status});
|
|
5167
|
$main::syslogit->($user, "info", "$uistatus $obj->{type} image: $obj->{name}: $uuid");
|
|
5168
|
1;
|
|
5169
|
} or do {$postreply .= "Status=ERROR $@\n";}
|
|
5170
|
} else {
|
|
5171
|
$postreply .= "Status=ERROR Not a master, not a child \"$obj->{name}\"\n";
|
|
5172
|
}
|
|
5173
|
sleep 1;
|
|
5174
|
$main::updateUI->({tab=>"images", user=>$user, type=>"update", uuid=>$obj->{'uuid'}, newpath=>$uinewpath, name=>$iname, status=>$status});
|
|
5175
|
} else {
|
|
5176
|
$postreply .= "Status=ERROR Only qcow2 images may be unmastered\n";
|
|
5177
|
}
|
|
5178
|
return $postreply;
|
|
5179
|
}
|
|
5180
|
|
|
5181
|
# Save or create new image
|
|
5182
|
sub Save {
|
|
5183
|
my ($img, $action, $obj) = @_;
|
|
5184
|
if ($help) {
|
|
5185
|
return <<END
|
|
5186
|
POST:path, uuid, name, type, virtualsize, storagepool, user:
|
|
5187
|
To save a collection of images you either PUT or POST a JSON array to the main endpoint with objects representing the images with the changes you want.
|
|
5188
|
Depending on your privileges not all changes are permitted. If you save without specifying a uuid or path, a new image is created.
|
|
5189
|
END
|
|
5190
|
}
|
|
5191
|
my $path = $obj->{path};
|
|
5192
|
my $uuid = $obj->{uuid};
|
|
5193
|
my $status = $obj->{status};
|
|
5194
|
if ($status eq "new") {
|
|
5195
|
# Create new image
|
|
5196
|
my $ug = new Data::UUID;
|
|
5197
|
if (!$uuid || $uuid eq '--') {
|
|
5198
|
$uuid = $ug->create_str();
|
|
5199
|
} else { # Validate
|
|
5200
|
my $valuuid = $ug->from_string($uuid);
|
|
5201
|
if ($ug->to_string($valuuid) eq $uuid) {
|
|
5202
|
;
|
|
5203
|
} else {
|
|
5204
|
$uuid = $ug->create_str();
|
|
5205
|
}
|
|
5206
|
}
|
|
5207
|
my $newuuid = $uuid;
|
|
5208
|
my $pooldir = $spools[$obj->{storagepool}]->{'path'};
|
|
5209
|
my $cmd;
|
|
5210
|
my $name = $obj->{name};
|
|
5211
|
$name =~ s/\./_/g; # Remove unwanted chars
|
|
5212
|
$name =~ s/\//_/g;
|
|
5213
|
eval {
|
|
5214
|
my $ipath = "$pooldir/$user/$name.$obj->{type}";
|
|
5215
|
$obj->{type} = "qcow2" unless ($obj->{type});
|
|
5216
|
# Find an unused path
|
|
5217
|
if ($register{$ipath} || -e "$ipath") {
|
|
5218
|
my $i = 1;
|
|
5219
|
while ($register{"$pooldir/$user/$name.$i.$obj->{type}"} || -e "$pooldir/$user/$name.$i.$obj->{type}") {$i++;};
|
|
5220
|
$ipath = "$pooldir/$user/$name.$i.$obj->{type}";
|
|
5221
|
$name = "$name.$i";
|
|
5222
|
}
|
|
5223
|
|
|
5224
|
if ($obj->{type} eq 'qcow2' || $obj->{type} eq 'vmdk') {
|
|
5225
|
my $size = ($obj->{msize})."M";
|
|
5226
|
my $format = "qcow2";
|
|
5227
|
$format = "vmdk" if ($path1 =~ /\.vmdk$/);
|
|
5228
|
$cmd = qq|/usr/bin/qemu-img create -f $format "$ipath" "$size"|;
|
|
5229
|
} elsif ($obj->{type} eq 'img') {
|
|
5230
|
my $size = ($obj->{msize})."M";
|
|
5231
|
$cmd = qq|/usr/bin/qemu-img create -f raw "$ipath" "$size"|;
|
|
5232
|
} elsif ($obj->{type} eq 'vdi') {
|
|
5233
|
my $size = $obj->{msize};
|
|
5234
|
$cmd = qq|/usr/bin/VBoxManage createhd --filename "$ipath" --size "$size" --format VDI|;
|
|
5235
|
}
|
|
5236
|
$obj->{name} = 'New Image' if (!$obj->{name} || $obj->{name} eq '--' || $obj->{name} =~ /^\./ || $obj->{name} =~ /\//);
|
|
5237
|
if (-e $ipath) {
|
|
5238
|
$postreply .= "Status=ERROR Image already exists: \"$obj->{name}\" in \"$ipath\”\n";
|
|
5239
|
} elsif (overQuotas($obj->{ksize}*1024)) {
|
|
5240
|
$postreply .= "Status=ERROR Over quota (". overQuotas($obj->{ksize}*1024) . ") creating: $obj->{name}\n";
|
|
5241
|
$main::updateUI->({tab=>"images", user=>$user, type=>"update", message=>"Over quota in storage pool $obj->{storagepool}"});
|
|
5242
|
$main::syslogit->($user, "info", "Over quota in storage pool $obj->{storagepool}, not creating $obj->{type} image $obj->{name}");
|
|
5243
|
} elsif (overStorage($obj->{ksize}*1024, $obj->{storagepool}+0)) {
|
|
5244
|
$postreply .= "Status=ERROR Out of storage in destination pool creating: $obj->{name}\n";
|
|
5245
|
$main::updateUI->({tab=>"images", user=>$user, type=>"update", message=>"Out of storage in storage pool $obj->{storagepool}"});
|
|
5246
|
$main::syslogit->($user, "info", "Out of storage in storage pool $obj->{storagepool}, not creating $obj->{type} image $obj->{name}");
|
|
5247
|
} elsif ($obj->{virtualsize} > 10*1024*1024 && $obj->{name} && $obj->{name} ne '--') {
|
|
5248
|
$register{$ipath} = {
|
|
5249
|
uuid=>$newuuid,
|
|
5250
|
name=>$obj->{name},
|
|
5251
|
user=>$user,
|
|
5252
|
notes=>$obj->{notes},
|
|
5253
|
type=>$obj->{type},
|
|
5254
|
size=>0,
|
|
5255
|
realsize=>0,
|
|
5256
|
virtualsize=>$obj->{virtualsize},
|
|
5257
|
storagepool=>$spools[0]->{'id'},
|
|
5258
|
created=>$current_time,
|
|
5259
|
managementlink=>$obj->{managementlink},
|
|
5260
|
upgradelink=>$obj->{upgradelink},
|
|
5261
|
terminallink=>$obj->{terminallink},
|
|
5262
|
status=>"creating"
|
|
5263
|
};
|
|
5264
|
$uipath = $ipath;
|
|
5265
|
my $res = `$cmd`;
|
|
5266
|
$register{$ipath}->{'status'} = 'unused';
|
|
5267
|
|
|
5268
|
$postreply .= "Status=OK Created $obj->{type} image: $obj->{name}\n";
|
|
5269
|
$postreply .= "Status=OK uuid: $newuuid\n"; # if ($console || $api);
|
|
5270
|
$postreply .= "Status=OK path: $ipath\n"; # if ($console || $api);
|
|
5271
|
sleep 1; # Needed to give updateUI a chance to reload
|
|
5272
|
$main::updateUI->({tab=>"images", user=>$user, type=>"update"});
|
|
5273
|
# $main::updateUI->({tab=>"images", uuid=>$newuuid, user=>$user, type=>"update", name=>$obj->{name}, path=>$obj->{path}});
|
|
5274
|
$main::syslogit->($user, "info", "Created $obj->{type} image: $obj->{name}: $newuuid");
|
|
5275
|
updateBilling("New image: $obj->{name}");
|
|
5276
|
} else {
|
|
5277
|
$postreply .= "Status=ERROR Problem creating image: $obj->{name} of size $obj->{virtualsize}\n";
|
|
5278
|
}
|
|
5279
|
1;
|
|
5280
|
} or do {$postreply .= "Status=ERROR $@\n";}
|
|
5281
|
} else {
|
|
5282
|
# Moving images because of owner change or storagepool change
|
|
5283
|
if ($obj->{user} ne $obj->{reguser} || $obj->{storagepool} ne $obj->{regstoragepool}) {
|
|
5284
|
$uipath = Move($path, $obj->{user}, $obj->{storagepool}, $obj->{mac});
|
|
5285
|
# Resize a qcow2 image
|
|
5286
|
} elsif ($obj->{virtualsize} != $register{$path}->{'virtualsize'} &&
|
|
5287
|
($obj->{user} eq $obj->{reguser} || index($privileges,"a")!=-1)) {
|
|
5288
|
if ($status eq "active" || $status eq "paused") {
|
|
5289
|
$postreply .= "Status=ERROR Cannot resize active images $path, $status.\n";
|
|
5290
|
$main::updateUI->({tab=>"images", user=>$user, type=>"update", status=>'ERROR', message=>"ERROR Cannot resize active images"});
|
|
5291
|
} elsif ($obj->{type} eq "qcow2" || $obj->{type} eq "img") {
|
|
5292
|
if ($obj->{virtualsize} < $register{$path}->{'virtualsize'}) {
|
|
5293
|
$postreply .= "Status=ERROR Only growing of images supported.\n";
|
|
5294
|
} elsif (overQuotas($obj->{virtualsize}, ($register{$path}->{'storagepool'}==-1))) {
|
|
5295
|
$postreply .= "Status=ERROR Over quota (". overQuotas($obj->{virtualsize}, ($register{$path}->{'storagepool'}==-1)) . ") resizing: $obj->{name}\n";
|
|
5296
|
} elsif (overStorage(
|
|
5297
|
$obj->{virtualsize},
|
|
5298
|
$register{$path}->{'storagepool'},
|
|
5299
|
$register{$path}->{'mac'}
|
|
5300
|
)) {
|
|
5301
|
$postreply .= "Status=ERROR Not enough storage ($obj->{virtualsize}) in destination pool $obj->{storagepool} resizing: $obj->{name}\n";
|
|
5302
|
} else {
|
|
5303
|
$uistatus = "resizing";
|
|
5304
|
$uipath = $path;
|
|
5305
|
my $mpath = $path;
|
|
5306
|
if ($obj->{mac} && $obj->{mac} ne '--') {
|
|
5307
|
unless ( tie(%nodereg,'Tie::DBI', Hash::Merge::merge({table=>'nodes', key=>'mac', CLOBBER=>1}, $Stabile::dbopts)) ) {return 0};
|
|
5308
|
$macip = $nodereg{$obj->{mac}}->{'ip'};
|
|
5309
|
untie %nodereg;
|
|
5310
|
}
|
|
5311
|
$mpath = "$macip:$mpath" if ($macip && $macip ne '--');
|
|
5312
|
$register{$path}->{'status'} = $uistatus;
|
|
5313
|
$register{$path}->{'virtualsize'} = $obj->{virtualsize};
|
|
5314
|
my $cmd = qq|steamExec $user $uistatus $status "$mpath" "$obj->{ksize}"|;
|
|
5315
|
if ($action eq 'sync_save') { # We wait for result
|
|
5316
|
my $res = `$cmd`;
|
|
5317
|
$res =~ s/\n/ /g; $res = lc $res;
|
|
5318
|
$postreply .= "Status=OK $res\n";
|
|
5319
|
} else {
|
|
5320
|
my $daemon = Proc::Daemon->new(
|
|
5321
|
work_dir => '/usr/local/bin',
|
|
5322
|
exec_command => $cmd,
|
|
5323
|
# exec_command => "suidperl -U steamExec $user $uistatus $status \"$mpath\" \"$obj->{ksize}\""
|
|
5324
|
) or do {$postreply .= "Status=ERROR $@\n";};
|
|
5325
|
my $pid = $daemon->Init();
|
|
5326
|
}
|
|
5327
|
$postreply .= "Status=OK $uistatus $obj->{type} image: $obj->{name} ($obj->{ksize}k)\n";
|
|
5328
|
$main::syslogit->($user, "info", "$uistatus $obj->{type} image $obj->{name} $uuid $mpath ($obj->{virtualsize})");
|
|
5329
|
}
|
|
5330
|
} else {
|
|
5331
|
$postreply .= "Status=ERROR Can only resize .qcow2 and .img images.\n";
|
|
5332
|
}
|
|
5333
|
} else {
|
|
5334
|
# Regular save
|
|
5335
|
if ($obj->{user} eq $obj->{reguser} || $isadmin) {
|
|
5336
|
my $qinfo;
|
|
5337
|
my $e;
|
|
5338
|
$obj->{bschedule} = "" if ($obj->{bschedule} eq "--");
|
|
5339
|
if ($obj->{bschedule}) {
|
|
5340
|
# Remove backups
|
|
5341
|
if ($obj->{bschedule} eq "none") {
|
|
5342
|
if ($spools[$obj->{regstoragepool}]->{'rdiffenabled'}) {
|
|
5343
|
my($bname, $dirpath) = fileparse($path);
|
|
5344
|
if ($path =~ /\/($user|common)\/(.+)/) {
|
|
5345
|
my $buser = $1;
|
|
5346
|
if (-d "$backupdir/$buser/$bname" && $backupdir && $bname && $buser) {
|
|
5347
|
eval {
|
|
5348
|
$qinfo = `/bin/rm -rf "$backupdir/$buser/$bname"`;
|
|
5349
|
1;
|
|
5350
|
} or do {$postreply .= "Status=ERROR $@\n"; $e=1;};
|
|
5351
|
if (!$e) {
|
|
5352
|
$postreply .= "Status=OK Removed all rdiff backups of $obj->{name}\n";
|
|
5353
|
chomp $qinfo;
|
|
5354
|
$register{$path} = {backupsize=>0};
|
|
5355
|
$main::syslogit->($user, "info", "Removed all backups of $obj->{name}: $path: $qinfo");
|
|
5356
|
$main::updateUI->({
|
|
5357
|
user=>$user,
|
|
5358
|
message=>"Removed all backups of $obj->{name}",
|
|
5359
|
backup=>$path
|
|
5360
|
});
|
|
5361
|
updateBilling("no backup $path");
|
|
5362
|
delete $register{$path}->{'btime'};
|
|
5363
|
}
|
|
5364
|
}
|
|
5365
|
}
|
|
5366
|
}
|
|
5367
|
$obj->{bschedule} = "manually";
|
|
5368
|
$register{$path}->{'bschedule'} = $obj->{bschedule};
|
|
5369
|
}
|
|
5370
|
}
|
|
5371
|
|
|
5372
|
$register{$path} = {
|
|
5373
|
name=>$obj->{name},
|
|
5374
|
user=>$obj->{user},
|
|
5375
|
notes=>$obj->{notes},
|
|
5376
|
bschedule=>$obj->{bschedule},
|
|
5377
|
installable=>$obj->{installable},
|
|
5378
|
managementlink=>$obj->{managementlink},
|
|
5379
|
upgradelink=>$obj->{upgradelink},
|
|
5380
|
terminallink=>$obj->{terminallink},
|
|
5381
|
action=>""
|
|
5382
|
};
|
|
5383
|
my $domains = $register{$path}->{'domains'};
|
|
5384
|
if ($status eq 'downloading') {
|
|
5385
|
unless (`pgrep $obj->{name}`) { # Check if image is in fact being downloaded
|
|
5386
|
$status = 'unused';
|
|
5387
|
$register{$path}->{'status'} = $status;
|
|
5388
|
unlink ("$path.meta") if (-e "$path.meta");
|
|
5389
|
}
|
|
5390
|
}
|
|
5391
|
elsif ($status ne 'unused') {
|
|
5392
|
my $match;
|
|
5393
|
if ($path =~ /\.master\.qcow2$/) {
|
|
5394
|
my @regkeys = (tied %register)->select_where("master = '$path'");
|
|
5395
|
$match = 2 if (@regkeys);
|
|
5396
|
} else {
|
|
5397
|
if (!$domreg{$domains}) { # Referenced domain no longer exists
|
|
5398
|
;
|
|
5399
|
} else { # Verify if referenced domain still uses image
|
|
5400
|
my @imgkeys = ('image', 'image2', 'image3', 'image4');
|
|
5401
|
for (my $i=0; $i<4; $i++) {
|
|
5402
|
$match = 1 if ($domreg{$domains}->{$imgkeys[$i]} eq $path);
|
|
5403
|
}
|
|
5404
|
}
|
|
5405
|
}
|
|
5406
|
unless ($match) {
|
|
5407
|
$status = 'unused';
|
|
5408
|
$register{$path}->{'status'} = $status;
|
|
5409
|
}
|
|
5410
|
}
|
|
5411
|
if ($status eq 'unused') {
|
|
5412
|
delete $register{$path}->{'domains'};
|
|
5413
|
delete $register{$path}->{'domainnames'};
|
|
5414
|
}
|
|
5415
|
$uipath = $path;
|
|
5416
|
$postreply .= "Status=OK Saved $obj->{name} ($uuid)\n";
|
|
5417
|
} else {
|
|
5418
|
$postreply .= "Status=ERROR Unable to save $obj->{name}\n";
|
|
5419
|
}
|
|
5420
|
}
|
|
5421
|
}
|
|
5422
|
if ($postreply) {
|
|
5423
|
$postmsg = $postreply;
|
|
5424
|
} else {
|
|
5425
|
$postreply = to_json(\%{$register{$uipath}}, {pretty=>1}) if ($uipath && $register{$uipath});
|
|
5426
|
$postreply =~ s/""/"--"/g;
|
|
5427
|
$postreply =~ s/null/"--"/g;
|
|
5428
|
$postreply =~ s/"notes" {0,1}: {0,1}"--"/"notes":""/g;
|
|
5429
|
$postreply =~ s/"installable" {0,1}: {0,1}"(true|false)"/"installable":$1/g;
|
|
5430
|
}
|
|
5431
|
return $postreply || "Status=OK Saved $uipath\n";
|
|
5432
|
}
|
|
5433
|
|
|
5434
|
sub Setstoragedevice {
|
|
5435
|
my ($image, $action, $obj) = @_;
|
|
5436
|
if ($help) {
|
|
5437
|
return <<END
|
|
5438
|
GET:device,type:
|
|
5439
|
Changes the device - disk or partition, used for images or backup storage.
|
|
5440
|
[type] is either images or backup.
|
|
5441
|
END
|
|
5442
|
}
|
|
5443
|
my $dev = $obj->{device};
|
|
5444
|
my $force = $obj->{force};
|
|
5445
|
my $type = 'backup';
|
|
5446
|
$type = 'images' if ($obj->{type} eq 'images');
|
|
5447
|
return "Status=Error Not allowed\n" unless ($isadmin);
|
|
5448
|
my $backupdevice = Getbackupdevice('', 'getbackupdevice');
|
|
5449
|
my $imagesdevice = Getimagesdevice('', 'getimagesdevice');
|
|
5450
|
my $devices_obj = from_json(Liststoragedevices('', 'liststoragedevices'));
|
|
5451
|
my %devices = %$devices_obj;
|
|
5452
|
my $backupdev = $devices{$backupdevice}->{dev};
|
|
5453
|
my $imagesdev = $devices{$imagesdevice}->{dev};
|
|
5454
|
if (!$devices{$dev}) {
|
|
5455
|
$postreply = "Status=Error You must specify a valid device ($dev)\n";
|
|
5456
|
return $postreply;
|
|
5457
|
}
|
|
5458
|
if (!$force && (($backupdev =~ /$dev/) || ($imagesdev =~ /$dev/)) && $dev !~ /vda/ && $dev !~ /sda/) { # make exception to allow returning to default setup
|
|
5459
|
$postreply = "Status=Error $dev is already in use as images or backup device\n";
|
|
5460
|
return $postreply;
|
|
5461
|
}
|
|
5462
|
my $stordir = $tenderpathslist[0];
|
|
5463
|
my $stordevice = $imagesdevice;
|
|
5464
|
if ($type eq 'backup') {
|
|
5465
|
$stordir = $backupdir;
|
|
5466
|
$stordevice = $backupdevice;
|
|
5467
|
}
|
|
5468
|
return "Status=Error Storage device not found\n" unless ($stordevice);
|
|
5469
|
my $mp = $devices{$dev}->{mounted};
|
|
5470
|
my $newstordir;
|
|
5471
|
# my $oldstordir;
|
|
5472
|
if ($devices{$dev}->{type} eq 'zfs') {
|
|
5473
|
my $cmd = qq|zfs list stabile-$type/$type -Ho mountpoint|;
|
|
5474
|
my $zmp = `$cmd`;
|
|
5475
|
chomp $zmp;
|
|
5476
|
if ($zmp =~ /^\//) {
|
|
5477
|
`zfs mount stabile-$type/$type`;
|
|
5478
|
$mp = $zmp;
|
|
5479
|
$newstordir = $mp;
|
|
5480
|
} else {
|
|
5481
|
`zfs create stabile-$type/$type`;
|
|
5482
|
$mp = "/stabile-$type/$type";
|
|
5483
|
$newstordir = $mp;
|
|
5484
|
}
|
|
5485
|
} else {
|
|
5486
|
$newstordir = (($type eq 'images')?"$mp/images":"$mp/backups");
|
|
5487
|
$newstordir = $1 if ($newstordir =~ /(.+\/images)\/images$/);
|
|
5488
|
$newstordir = $1 if ($newstordir =~ /(.+\/backups)\/backups$/);
|
|
5489
|
}
|
|
5490
|
if ($mp eq '/') {
|
|
5491
|
$newstordir = (($type eq 'images')?"/mnt/stabile/images":"/mnt/stabile/backups");
|
|
5492
|
`umount "$newstordir"`; # in case it's mounted
|
|
5493
|
}
|
|
5494
|
`mkdir "$newstordir"` unless (-e $newstordir);
|
|
5495
|
`chmod 777 "$newstordir"`;
|
|
5496
|
|
|
5497
|
my $cfg = new Config::Simple("/etc/stabile/config.cfg");
|
|
5498
|
if ($type eq 'backup') {
|
|
5499
|
$cfg->param('STORAGE_BACKUPDIR', $newstordir);
|
|
5500
|
$cfg->save();
|
|
5501
|
} elsif ($type eq 'images') {
|
|
5502
|
|
|
5503
|
# Handle shared storage config
|
|
5504
|
# $oldstordir = $stordir;
|
|
5505
|
my $i = 0;
|
|
5506
|
for($i = 0; $i <= $#tenderpathslist; $i++) {
|
|
5507
|
my $dir = $tenderpathslist[$i];
|
|
5508
|
last if ($dir eq $newstordir);
|
|
5509
|
}
|
|
5510
|
# $tenderpathslist[0] = $newstordir;
|
|
5511
|
splice(@tenderpathslist, $i,1); # Remove existing entry
|
|
5512
|
unshift(@tenderpathslist, $newstordir); # Then add the new path
|
|
5513
|
$cfg->param('STORAGE_POOLS_LOCAL_PATHS', join(',', @tenderpathslist));
|
|
5514
|
|
|
5515
|
# $tenderlist[0] = 'local';
|
|
5516
|
splice(@tenderlist, $i,1);
|
|
5517
|
unshift(@tenderlist, 'local');
|
|
5518
|
$cfg->param('STORAGE_POOLS_ADDRESS_PATHS', join(',', @tenderlist));
|
|
5519
|
|
|
5520
|
# $tendernameslist[0] = 'Default';
|
|
5521
|
splice(@tendernameslist, $i,1);
|
|
5522
|
unshift(@tendernameslist, 'Default');
|
|
5523
|
|
|
5524
|
if ($i) { # We've actually changed storage device
|
|
5525
|
my $oldstorname = $tenderpathslist[1];
|
|
5526
|
$oldstorname = $1 if ($oldstorname =~ /.*\/(.+)/);
|
|
5527
|
$tendernameslist[1] = "$oldstorname on $imagesdevice"; # Give the previous default pool a fitting name
|
|
5528
|
|
|
5529
|
$storagepools = "$storagepools,$i" unless ($storagepools =~ /,\s*$i,?/ || $storagepools =~ /,\s*$i$/ || $storagepools =~ /^$i$/);
|
|
5530
|
$cfg->param('STORAGE_POOLS_DEFAULTS', $storagepools);
|
|
5531
|
}
|
|
5532
|
$cfg->param('STORAGE_POOLS_NAMES', join(',', @tendernameslist));
|
|
5533
|
|
|
5534
|
$cfg->save();
|
|
5535
|
|
|
5536
|
|
|
5537
|
# Handle node storage configs
|
|
5538
|
unless ( tie(%idreg,'Tie::DBI', Hash::Merge::merge({table=>'nodeidentities',key=>'identity',CLOBBER=>3}, $Stabile::dbopts)) ) {return "Unable to access id register"};
|
|
5539
|
# Build hash of known node config files
|
|
5540
|
my @nodeconfigs;
|
|
5541
|
push @nodeconfigs, "/etc/stabile/nodeconfig.cfg";
|
|
5542
|
foreach my $valref (values %idreg) {
|
|
5543
|
my $nodeconfigfile = $valref->{'path'} . "/casper/filesystem.dir/etc/stabile/nodeconfig.cfg";
|
|
5544
|
next if ($nodeconfigs{$nodeconfigfile}); # Node identities may share basedir and node config file
|
|
5545
|
if (-e $nodeconfigfile) {
|
|
5546
|
push @nodeconfigs, $nodeconfigfile;
|
|
5547
|
}
|
|
5548
|
}
|
|
5549
|
untie %idreg;
|
|
5550
|
foreach my $nodeconfig (@nodeconfigs) {
|
|
5551
|
my $nodecfg = new Config::Simple($nodeconfig);
|
|
5552
|
my @ltenderlist = $nodecfg->param('STORAGE_SERVERS_ADDRESS_PATHS');
|
|
5553
|
my $ltenders = join(", ", @ltenderlist);
|
|
5554
|
next if ($ltenders =~ /10\.0\.0\.1:$newstordir$/ || $ltenders =~ /10\.0\.0\.1:$newstordir,/); # This entry already exists
|
|
5555
|
#my @ltenderlist = split(/,\s*/, $ltenders);
|
|
5556
|
#$ltenderlist[0] = "10.0.0.1:$newstordir";
|
|
5557
|
unshift(@ltenderlist, "10.0.0.1:$newstordir");
|
|
5558
|
$nodecfg->param('STORAGE_SERVERS_ADDRESS_PATHS', join(',', @ltenderlist));
|
|
5559
|
my @ltenderpathslist = $nodecfg->param('STORAGE_SERVERS_LOCAL_PATHS');
|
|
5560
|
my $ltenderpaths = join(", ", @ltenderpathslist);
|
|
5561
|
#my @ltenderpathslist = split(/,\s*/, $ltenderpaths);
|
|
5562
|
#$ltenderpathslist[0] = $newstordir;
|
|
5563
|
unshift(@ltenderpathslist, $newstordir);
|
|
5564
|
$nodecfg->param('STORAGE_SERVERS_LOCAL_PATHS', join(',', @ltenderpathslist));
|
|
5565
|
$nodecfg->save();
|
|
5566
|
}
|
|
5567
|
unless (`grep "$newstordir 10" /etc/exports`) {
|
|
5568
|
`echo "$newstordir 10.0.0.0/255.255.255.0(sync,no_subtree_check,no_root_squash,rw)" >> /etc/exports`;
|
|
5569
|
`/usr/sbin/exportfs -r`; #Reexport nfs shares
|
|
5570
|
}
|
|
5571
|
# We no longer undefine storage pools - we add them
|
|
5572
|
# $oldstordir =~ s/\//\\\//g;
|
|
5573
|
# `perl -pi -e 's/$oldstordir 10.*\\\n//s;' /etc/exports` if ($oldstordir);
|
|
5574
|
|
|
5575
|
`mkdir "$newstordir/common"` unless (-e "$newstordir/common");
|
|
5576
|
`cp "$stordir/ejectcdrom.xml" "$newstordir/ejectcdrom.xml"` unless (-e "$newstordir/ejectcdrom.xml");
|
|
5577
|
`cp "$stordir/mountvirtio.xml" "$newstordir/mountvirtio.xml"` unless (-e "$newstordir/mountvirtio.xml");
|
|
5578
|
`cp "$stordir/dummy.qcow2" "$newstordir/dummy.qcow2"` unless (-e "$newstordir/dummy.qcow2");
|
|
5579
|
}
|
|
5580
|
Updatedownloads();
|
|
5581
|
|
|
5582
|
# Update /etc/stabile/cgconfig.conf
|
|
5583
|
my $devs = $devices{$dev}->{dev};
|
|
5584
|
my @pdevs = split(" ", $devs);
|
|
5585
|
my $majmins;
|
|
5586
|
foreach my $dev (@pdevs) {
|
|
5587
|
# It seems that cgroups cannot handle individual partitions for blkio
|
|
5588
|
my $physdev = $1 if ($dev =~ /(\w+)\d+/);
|
|
5589
|
if ($physdev && -d "/sys/fs/cgroup" ) {
|
|
5590
|
my $blkline = `lsblk -l /dev/$physdev`;
|
|
5591
|
my $majmin = '';
|
|
5592
|
$majmin = $1 if ($blkline =~ /$physdev +(\d+:\d+)/);
|
|
5593
|
$postreply .= "Status=OK Setting cgroups block device to $majmin\n";
|
|
5594
|
if ($majmin) {
|
|
5595
|
$majmins .= ($majmins)?" $majmin":$majmin;
|
|
5596
|
}
|
|
5597
|
}
|
|
5598
|
}
|
|
5599
|
setCgroupsBlkDevice($majmins) if ($majmins);
|
|
5600
|
|
|
5601
|
$Stabile::Nodes::console = 1;
|
|
5602
|
require "$Stabile::basedir/cgi/nodes.cgi";
|
|
5603
|
$postreply .= Stabile::Nodes::do_reloadall('','reloadall');
|
|
5604
|
|
|
5605
|
# Update config on stabile.io
|
|
5606
|
require "$Stabile::basedir/cgi/users.cgi";
|
|
5607
|
$Stabile::Users::console = 1;
|
|
5608
|
Stabile::Users::Updateengine('', 'updateengine');
|
|
5609
|
|
|
5610
|
my $msg = "OK Now using $newstordir for $type on $obj->{device}";
|
|
5611
|
$main::updateUI->({tab=>'home', user=>$user, type=>'update', message=>$msg});
|
|
5612
|
$postreply .= "Status=OK Now using $newstordir for $type on $dev\n";
|
|
5613
|
return $postreply;
|
|
5614
|
}
|
|
5615
|
|
|
5616
|
sub Initializestorage {
|
|
5617
|
my ($image, $action, $obj) = @_;
|
|
5618
|
if ($help) {
|
|
5619
|
return <<END
|
|
5620
|
GET:device,type,fs,activate,force:
|
|
5621
|
Initializes a local disk or partition, and optionally formats it with ZFS and creates a ZFS pool to use as image storage or backup storage.
|
|
5622
|
[device] is a local disk device in /dev like e.g. 'sdd'. [type] may be either 'images' (default) or 'backup'. [fs] may be 'lvm' (default) or 'zfs'.
|
|
5623
|
Set [activate] if you want to put the device into use immediately. Set [force] if you want to destroy existing ZFS pool and recreate (obviously use with care).
|
|
5624
|
END
|
|
5625
|
}
|
|
5626
|
my $fs = $obj->{fs} || 'zfs';
|
|
5627
|
my $dev = $obj->{device};
|
|
5628
|
my $force = $obj->{force};
|
|
5629
|
my $activate = $obj->{activate};
|
|
5630
|
my $type = 'backup';
|
|
5631
|
$type = 'images' if ($obj->{type} eq 'images');
|
|
5632
|
return "Status=Error Not allowed\n" unless ($isadmin);
|
|
5633
|
my $backupdevice = Getbackupdevice('', 'getbackupdevice');
|
|
5634
|
my $imagesdevice = Getimagesdevice('', 'getimagesdevice');
|
|
5635
|
my $devices_obj = from_json(Liststoragedevices('', 'liststoragedevices'));
|
|
5636
|
my %devices = %$devices_obj;
|
|
5637
|
my $backupdev = $devices{$backupdevice}->{dev};
|
|
5638
|
my $imagesdev = $devices{$imagesdevice}->{dev};
|
|
5639
|
if (!$dev || !(-e "/dev/$dev")) {
|
|
5640
|
$postreply = "Status=Error You must specify a valid device\n";
|
|
5641
|
return $postreply;
|
|
5642
|
}
|
|
5643
|
if (($backupdev =~ /$dev/) || ($imagesdev =~ /$dev/)) {
|
|
5644
|
$postreply = "Status=Error $dev is already in use as images or backup device\n";
|
|
5645
|
return $postreply;
|
|
5646
|
}
|
|
5647
|
my $stordir = "/stabile-$type/$type";
|
|
5648
|
if ($fs eq 'lvm') {
|
|
5649
|
if ($type eq 'backup') {
|
|
5650
|
$stordir = "/mnt/stabile/backups";
|
|
5651
|
} else {
|
|
5652
|
$stordir = "/mnt/stabile/images";
|
|
5653
|
}
|
|
5654
|
}
|
|
5655
|
`chmod 666 /dev/zfs` if (-e '/dev/zfs'); # TODO: This should be removed once we upgrade to Bionic and zfs allow is supported
|
|
5656
|
|
|
5657
|
my $vol = $type . "vol";
|
|
5658
|
my $mounts = `cat /proc/mounts`;
|
|
5659
|
my $zpools = `zpool list -v`;
|
|
5660
|
my $pvs = `pvdisplay -c`;
|
|
5661
|
my $z;
|
|
5662
|
$postreply = '';
|
|
5663
|
# Unconfigure existing zfs or lvm if $force and zfs/lvm configured or device is in use by either
|
|
5664
|
if ($zpools =~ /stabile-$type/ || $mounts =~ /dev\/mapper\/stabile$type/ || $zpools =~ /$dev/ || $pvs =~ /$dev/) {
|
|
5665
|
if ($fs eq 'zfs' || $zpools =~ /$dev/) {
|
|
5666
|
if ($force) { # ZFS needs to be unconfigured
|
|
5667
|
my $umount = `LANG=en_US.UTF-8 umount -v "/stabile-$type/$type" 2>&1`;
|
|
5668
|
unless ($umount =~ /(unmounted|not mounted|no mount point)/) {
|
|
5669
|
$postreply .= "Status=Error Unable to unmount zfs $type storage on $dev - $umount\n";
|
|
5670
|
return $postreply;
|
|
5671
|
}
|
|
5672
|
`umount "/stabile-$type"`;
|
|
5673
|
my $res = `zpool destroy "stabile-$type" 2>&1`;
|
|
5674
|
chomp $res;
|
|
5675
|
$postreply .= "Status=OK Unconfigured zfs - $res\n";
|
|
5676
|
} else {
|
|
5677
|
$postreply .= "Status=Error ZFS is already configured for $type\n";
|
|
5678
|
$z = 1;
|
|
5679
|
# return $postreply;
|
|
5680
|
}
|
|
5681
|
}
|
|
5682
|
if ($fs eq 'lvm' || $pvs =~ /$dev/) {
|
|
5683
|
if ($force) {
|
|
5684
|
my $udir = (($type eq 'backup')?"/mnt/stabile/backups":"/mnt/stabile/images");
|
|
5685
|
my $umount = `umount -v "$udir" 2>&1`;
|
|
5686
|
unless ($umount =~ /unmounted|not mounted|no mount point/) {
|
|
5687
|
$postreply .= "Status=Error Unable to unmount lvm $type storage - $umount\n";
|
|
5688
|
return $postreply;
|
|
5689
|
}
|
|
5690
|
my $res = `lvremove --yes /dev/stabile$type/$vol 2>&1`;
|
|
5691
|
chomp $res;
|
|
5692
|
$res .= `vgremove -f stabile$type 2>&1`;
|
|
5693
|
chomp $res;
|
|
5694
|
my $pdev = "/dev/$dev";
|
|
5695
|
$pdev .= '1' unless ($pdev =~ /1$/);
|
|
5696
|
$res .= `pvremove $pdev 2>&1`;
|
|
5697
|
chomp $res;
|
|
5698
|
$postreply .= "Status=OK Unconfigured lvm - $res\n";
|
|
5699
|
} else {
|
|
5700
|
$postreply .= "Status=Error LVM is already configured for $type\n";
|
|
5701
|
return $postreply;
|
|
5702
|
}
|
|
5703
|
}
|
|
5704
|
}
|
|
5705
|
# Check if $dev is still in use
|
|
5706
|
$mounts = `cat /proc/mounts`;
|
|
5707
|
$zpools = `zpool list -v`;
|
|
5708
|
$pvs = `pvdisplay -c`;
|
|
5709
|
if ($mounts =~ /\/dev\/$dev/ || $pvs =~ /$dev/ || $zpools =~ /$dev/) {
|
|
5710
|
$postreply .= "Status=Error $dev is already in use - use force.\n";
|
|
5711
|
return $postreply;
|
|
5712
|
}
|
|
5713
|
# Now format
|
|
5714
|
my $ispart = 1 if ($dev =~ /[a-zA-Z]+\d+/);
|
|
5715
|
if ($fs eq 'zfs') { # ZFS was specified
|
|
5716
|
$postreply = "Status=OK Initializing $dev disk with ZFS for $type...\n";
|
|
5717
|
if (!$ispart) {
|
|
5718
|
my $fres = `parted -s /dev/$dev mklabel GPT 2>&1`;
|
|
5719
|
$postreply .= "Status=OK partitioned $dev: $fres\n";
|
|
5720
|
}
|
|
5721
|
if ($z) { # zpool already created
|
|
5722
|
`zpool add stabile-$type /dev/$dev`;
|
|
5723
|
} else {
|
|
5724
|
`zpool create stabile-$type /dev/$dev`;
|
|
5725
|
`zfs create stabile-$type/$type`;
|
|
5726
|
`zfs set atime=off stabile-$type/$type`;
|
|
5727
|
}
|
|
5728
|
# if ($force) {
|
|
5729
|
# $postreply .= "Status=OK Forcibly removing all files in $stordir to allow ZFS mount\n";
|
|
5730
|
# `rm -r $stordir/*`;
|
|
5731
|
# }
|
|
5732
|
# `zfs set mountpoint=$stordir stabile-$type/$type`;
|
|
5733
|
$stordir = "/stabile-$type/$type" if (`zfs mount stabile-$type/$type`);
|
|
5734
|
`/bin/chmod 777 $stordir`;
|
|
5735
|
$postreply .= "Status=OK Mounted stabile-$type/$type as $type storage on $stordir.\n";
|
|
5736
|
if ($activate) {
|
|
5737
|
$postreply .= "Status=OK Setting $type storage device to $dev.\n";
|
|
5738
|
Setstoragedevice('', 'setstoragedevice', {device=>"stabile-$type", type=>$type});
|
|
5739
|
}
|
|
5740
|
} else { # Assume LVM
|
|
5741
|
$postreply = "Status=OK Initializing $dev with LVM for $type...\n";
|
|
5742
|
my $part = $dev;
|
|
5743
|
if (!$ispart) {
|
|
5744
|
$part = $dev.'1';
|
|
5745
|
`/sbin/sfdisk -d /dev/$dev > /root/$dev-partition-sectors.save`;
|
|
5746
|
my $fres = `sfdisk /dev/$dev << EOF\n;\nEOF`;
|
|
5747
|
$postreply .= "Status=OK partitioned $dev: $fres\n";
|
|
5748
|
}
|
|
5749
|
`/sbin/vgcreate -f stabile$type /dev/$part`;
|
|
5750
|
`/sbin/vgchange -a y stabile$type`;
|
|
5751
|
my $totalpe =`/sbin/vgdisplay stabile$type | grep "Total PE"`;
|
|
5752
|
$totalpe =~ /Total PE\s+(\d+)/;
|
|
5753
|
my $size = $1 -2000;
|
|
5754
|
# my $size = "10000";
|
|
5755
|
if ($size <100) {
|
|
5756
|
$postreply .= "Status=Error Volume is too small to make sense...\n";
|
|
5757
|
return $postreply;
|
|
5758
|
}
|
|
5759
|
my $vol = $type . "vol";
|
|
5760
|
`/sbin/lvcreate --yes -l $size stabile$type -n $vol`;
|
|
5761
|
# `/sbin/mkfs.ext4 /dev/stabile$type/$vol`;
|
|
5762
|
`mkfs.btrfs /dev/stabile$type/$vol`;
|
|
5763
|
my $mounted = `mount -v /dev/stabile$type/$vol $stordir`;
|
|
5764
|
`chmod 777 $stordir`;
|
|
5765
|
if ($mounted) {
|
|
5766
|
$postreply .= "Status=OK Mounted /dev/stabile$type/$vol as $type storage on $stordir.\n";
|
|
5767
|
} else {
|
|
5768
|
$postreply .= "Status=Error Could not mount /dev/stabile$type/$vol as $type storage on $stordir.\n";
|
|
5769
|
}
|
|
5770
|
if ($activate){
|
|
5771
|
Setstoragedevice('', 'setstoragedevice', {device=>"stabile$type-$type".'vol', type=>$type});
|
|
5772
|
}
|
|
5773
|
}
|
|
5774
|
return $postreply;
|
|
5775
|
}
|
|
5776
|
|
|
5777
|
sub setCgroupsBlkDevice {
|
|
5778
|
my @majmins = split(" ", shift);
|
|
5779
|
my $file = "/etc/stabile/cgconfig.conf";
|
|
5780
|
my %options = (
|
|
5781
|
blkio.throttle.read_bps_device => $valve_readlimit,
|
|
5782
|
blkio.throttle.write_bps_device => $valve_writelimit,
|
|
5783
|
blkio.throttle.read_iops_device => $valve_iopsreadlimit,
|
|
5784
|
blkio.throttle.write_iops_device => $valve_iopswritelimit
|
|
5785
|
);
|
|
5786
|
my @groups = ('stabile', 'stabilevm');
|
|
5787
|
my @newlines;
|
|
5788
|
foreach my $majmin (@majmins) {
|
|
5789
|
foreach my $group (@groups) {
|
|
5790
|
my $mline = qq|group $group {|; push @newlines, $mline;
|
|
5791
|
my $mline = qq| blkio {|; push @newlines, $mline;
|
|
5792
|
foreach my $option (keys %options) {
|
|
5793
|
my $mline = qq| $option = "$majmin $options{$option}";|;
|
|
5794
|
push @newlines, $mline;
|
|
5795
|
}
|
|
5796
|
my $mline = qq| }|; push @newlines, $mline;
|
|
5797
|
my $mline = qq|}|; push @newlines, $mline;
|
|
5798
|
}
|
|
5799
|
}
|
|
5800
|
unless (open(FILE, "> $file")) {
|
|
5801
|
$postreply .= "Status=Error Problem opening $file\n";
|
|
5802
|
return $postreply;
|
|
5803
|
}
|
|
5804
|
print FILE join("\n", @newlines);
|
|
5805
|
close(FILE);
|
|
5806
|
return;
|
|
5807
|
}
|