Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
emulab
emulab-devel
Commits
0040bd2f
Commit
0040bd2f
authored
Feb 27, 2017
by
Leigh B Stoller
Browse files
Backend web support for deleting profile versions, and tracking/deleting
image versions at the clusters.
parent
019a2184
Changes
2
Hide whitespace changes
Inline
Side-by-side
apt/manage_images.in
0 → 100644
View file @
0040bd2f
#!/usr/bin/perl -w
#
# Copyright (c) 2000-2017 University of Utah and the Flux Group.
#
# {{{EMULAB-LICENSE
#
# This file is part of the Emulab network testbed software.
#
# This file is free software: you can redistribute it and/or modify it
# under the terms of the GNU Affero General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
#
# This file is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General Public
# License for more details.
#
# You should have received a copy of the GNU Affero General Public License
# along with this file. If not, see <http://www.gnu.org/licenses/>.
#
# }}}
#
use
English
;
use
strict
;
use
Getopt::
Std
;
use
Data::
Dumper
;
use
Date::
Parse
;
use
JSON
;
#
# Back-end script to manage APT profiles.
#
sub
usage
()
{
print
STDERR
"
Usage: manage_images [options --] list ...
\n
";
print
STDERR
"
Usage: manage_images [options --] delete <urn> ...
\n
";
exit
(
-
1
);
}
my
$optlist
=
"
dt:
";
my
$debug
=
0
;
my
$webtask_id
;
my
$webtask
;
# For development.
my
$usemydevtree
=
0
;
#
# Configure variables
#
my
$TB
=
"
@prefix
@
";
my
$TBOPS
=
"
@TBOPSEMAIL
@
";
my
$OURDOMAIN
=
"
@OURDOMAIN
@
";
my
$MYURN
=
"
urn:publicid:IDN+
${OURDOMAIN}
+authority+cm
";
my
$MANAGEPROFILE
=
"
$TB
/bin/manage_profile
";
#
# Untaint the path
#
$ENV
{'
PATH
'}
=
"
$TB
/bin:
$TB
/sbin:/bin:/usr/bin:/usr/bin:/usr/sbin
";
delete
@ENV
{'
IFS
',
'
CDPATH
',
'
ENV
',
'
BASH_ENV
'};
#
# Turn off line buffering on output
#
$|
=
1
;
#
# Load the Testbed support stuff.
#
use
lib
"
@prefix
@/lib
";
use
libtestbed
;
use
emdb
;
use
emutil
;
use
Project
;
use
User
;
use
WebTask
;
use
GeniResponse
;
use
GeniXML
;
use
GeniUser
;
use
APT_Geni
;
use
APT_Profile
;
# Protos
sub
fatal
($);
sub
DoListImages
();
sub
DoDeleteImage
();
#
# Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments.
#
my
%options
=
();
if
(
grep
{
$_
eq
"
--
"}
@ARGV
&&
!
getopts
(
$optlist
,
\
%options
))
{
usage
();
}
if
(
defined
(
$options
{"
d
"}))
{
$debug
=
1
;
}
if
(
defined
(
$options
{"
t
"}))
{
$webtask_id
=
$options
{"
t
"};
$webtask
=
WebTask
->
Lookup
(
$webtask_id
);
if
(
!
defined
(
$webtask
))
{
fatal
("
Could not get webtask object
");
}
$webtask
->
AutoStore
(
1
);
}
if
(
@ARGV
<
1
)
{
usage
();
}
my
$action
=
shift
(
@ARGV
);
# Need a real user.
my
$this_user
=
User
->
ThisUser
();
if
(
!
defined
(
$this_user
))
{
fatal
("
You (
$UID
) do not exist!
");
}
my
$geniuser
=
GeniUser
->
CreateFromLocal
(
$this_user
);
if
(
$action
eq
"
list
")
{
exit
(
DoListImages
());
}
elsif
(
$action
eq
"
delete
")
{
exit
(
DoDeleteImage
());
}
else
{
usage
();
}
exit
(
1
);
#
# List all images at the specified cluster,
#
sub
DoListImages
()
{
my
$usage
=
sub
{
print
STDERR
"
Usage: manage_images list [-a am_urn]
\n
";
exit
(
-
1
);
};
my
$optlist
=
"
a:p
";
my
$aggregate_urn
=
$MYURN
;
my
$withprofiles
=
0
;
my
$errmsg
;
my
%options
=
();
if
(
!
getopts
(
$optlist
,
\
%options
))
{
&$usage
();
}
if
(
defined
(
$options
{"
a
"}))
{
$aggregate_urn
=
$options
{"
a
"};
}
if
(
defined
(
$options
{"
p
"}))
{
$withprofiles
=
1
;
}
my
$context
=
APT_Geni::
GeniContext
();
if
(
!
defined
(
$context
))
{
fatal
("
Could not create context to talk to CM.
");
}
Genixmlrpc
->
SetContext
(
$context
);
# Shorten default timeout.
Genixmlrpc
->
SetTimeout
(
60
);
my
$authority
=
GeniAuthority
->
Lookup
(
$aggregate_urn
);
if
(
!
defined
(
$authority
))
{
fatal
("
No such aggregate
");
}
my
$cmurl
=
$authority
->
url
();
if
(
$usemydevtree
)
{
$cmurl
=~
s/protogeni/protogeni\/stoller/
;
}
my
(
$credential
,
$speaksfor
)
=
APT_Geni::
GenUserCredential
(
$geniuser
);
fatal
("
Could not generate credentials for user
")
if
(
!
defined
(
$credential
));
my
$credentials
=
[
$credential
->
asString
()];
if
(
defined
(
$speaksfor
))
{
$credentials
=
[
@$credentials
,
$speaksfor
->
asString
()];
}
my
$args
=
{
"
credentials
"
=>
$credentials
,
};
my
$response
=
Genixmlrpc::
CallMethod
(
$cmurl
,
undef
,
"
ListImages
",
$args
);
if
(
$response
->
code
()
!=
GENIRESPONSE_SUCCESS
)
{
if
(
$response
->
output
())
{
print
STDERR
$response
->
output
()
.
"
\n
";
if
(
defined
(
$webtask
))
{
$webtask
->
output
(
$response
->
output
());
}
}
else
{
print
STDERR
"
Operation failed, returned
"
.
$response
->
code
()
.
"
\n
";
if
(
defined
(
$webtask
))
{
$webtask
->
output
("
Operation failed
");
}
}
if
(
defined
(
$webtask
))
{
$webtask
->
Exited
(
$response
->
code
());
}
exit
(
$response
->
code
());
}
#
# We get back a flat list, which can include mulitple versions of
# each image. Lets reorganize into multilevel hash structure
# before giving it back to the web interface, so the web interface
# can just pass it off to the client browser. Also make sure
# projects map to local projects, and put the local project into
# the list if so.
#
my
%ilist
=
();
#
# First pass, bin them. The urn is without the versions, and then
# there is a list of version urns.
#
foreach
my
$image
(
@
{
$response
->
value
()
})
{
my
$urn
=
$image
->
{"
urn
"};
my
$hrn
=
GeniHRN
->
new
(
$urn
);
next
if
(
!
defined
(
$hrn
));
my
(
$auth
,
$ospid
,
$os
,
$osvers
)
=
$hrn
->
ParseImage
();
next
if
(
!
defined
(
$authority
));
# URN without the version.
$urn
=
GeniHRN::
GenerateImage
(
$auth
,
$ospid
,
$os
,
undef
);
# Default to version zero, for old sites not reporting version.
my
$vers
=
(
defined
(
$osvers
)
?
$osvers
:
0
);
# Put it into the object so that PHP/JS code can find it easy.
$image
->
{'
version
'}
=
$vers
;
# Try and set a local project, but use remote pid otherwise.
$image
->
{'
pid
'}
=
$ospid
;
if
(
!
exists
(
$ilist
{
$urn
}))
{
$ilist
{
$urn
}
=
[]
;
}
push
(
@
{
$ilist
{
$urn
}
},
$image
);
}
#
# Convert to a lexically ordered list.
#
my
@ordered
=
();
foreach
my
$urn
(
sort
keys
(
%ilist
))
{
push
(
@ordered
,
{"
urn
"
=>
$urn
,
"
versions
"
=>
$ilist
{
$urn
}});
}
#
# Find profiles using both the naked image and the version
# specific images. Also map the project urn to a local project.
#
foreach
my
$ref
(
@ordered
)
{
my
$urn
=
$ref
->
{'
urn
'};
my
@versions
=
@
{
$ref
->
{'
versions
'}};
my
$image0
=
$versions
[
0
];
#
# Use version zero of the image to map the local project.
#
if
(
exists
(
$image0
->
{'
project_urn
'}))
{
my
$projhrn
=
GeniHRN
->
new
(
$image0
->
{'
project_urn
'});
if
(
$projhrn
->
domain
()
eq
$OURDOMAIN
&&
defined
(
$projhrn
->
project
()))
{
my
$project
=
Project
->
Lookup
(
$projhrn
->
project
());
if
(
defined
(
$project
))
{
$ref
->
{'
pid
'}
=
$project
->
pid
();
$ref
->
{'
pid_idx
'}
=
$project
->
pid_idx
();
}
}
}
else
{
# Remote pid, set above
$ref
->
{'
pid
'}
=
$image0
->
{'
pid
'};
}
#
# Find profiles using the named image
#
$ref
->
{'
using
'}
=
[]
;
my
@nakedusing
=
();
next
if
(
APT_Profile::ImageInfo::
FindProfilesUsing
(
$urn
,
\
@nakedusing
));
#
# If no profiles using the naked image, mark it for delete, but
# if any versions are in use below, we will flip it to no.
#
$ref
->
{'
candelete
'}
=
(
@nakedusing
?
0
:
1
);
# How many of the children are inactive (can be deleted).
$ref
->
{'
inactive
'}
=
0
;
#
# List of profiles, with a list of versions of each.
#
my
%tmp
=
();
foreach
my
$profile
(
@nakedusing
)
{
my
$profile_uuid
=
$profile
->
profile_uuid
();
if
(
!
exists
(
$tmp
{
$profile_uuid
}))
{
$tmp
{
$profile_uuid
}
=
{
"
uuid
"
=>
$profile_uuid
,
"
name
"
=>
$profile
->
name
(),
"
creator
"
=>
$profile
->
creator
(),
"
project
"
=>
$profile
->
pid
(),
"
versions
"
=>
[]
,
};
}
push
(
@
{
$tmp
{
$profile_uuid
}
->
{'
versions
'}},
{"
uuid
"
=>
$profile
->
uuid
(),
"
version
"
=>
$profile
->
version
(),
"
created
"
=>
$profile
->
created
(),
});
}
$ref
->
{'
using
'}
=
[
values
(
%tmp
)
];
#
# And for each version of the image.
#
# The last version of the image is special; it gets any profile
# references for the naked image, since that is what a naked image
# means; use the most recent image. So if we have naked references,
# mark the last image for the loop below so we can extend the list
#
if
(
@nakedusing
)
{
$versions
[
scalar
(
@versions
)
-
1
]
->
{'
islast
'}
=
1
;
}
foreach
my
$image
(
@versions
)
{
my
$urn
=
$image
->
{'
urn
'};
my
@using
=
();
$image
->
{'
using
'}
=
[]
;
$image
->
{'
candelete
'}
=
0
;
next
if
(
APT_Profile::ImageInfo::
FindProfilesUsing
(
$urn
,
\
@using
));
# Combine the lists.
if
(
$image
->
{'
islast
'})
{
foreach
my
$p
(
@nakedusing
)
{
push
(
@using
,
$p
)
if
(
!
grep
{
$_
->
profileid
()
==
$p
->
profileid
()}
@using
);
}
}
#
# No references *currently* means we can delete the image.
#
if
(
!
@using
)
{
$image
->
{'
candelete
'}
=
1
;
$ref
->
{'
inactive
'}
++
;
next
;
}
# Reset candelete to no for entire image. See above.
$ref
->
{'
candelete
'}
=
0
;
%tmp
=
();
foreach
my
$profile
(
@using
)
{
my
$profile_uuid
=
$profile
->
profile_uuid
();
if
(
!
exists
(
$tmp
{
$profile_uuid
}))
{
$tmp
{
$profile_uuid
}
=
{
"
uuid
"
=>
$profile_uuid
,
"
name
"
=>
$profile
->
name
(),
"
creator
"
=>
$profile
->
creator
(),
"
project
"
=>
$profile
->
pid
(),
"
versions
"
=>
[]
,
};
}
push
(
@
{
$tmp
{
$profile_uuid
}
->
{'
versions
'}},
{"
uuid
"
=>
$profile
->
uuid
(),
"
version
"
=>
$profile
->
version
(),
"
created
"
=>
$profile
->
created
(),
});
}
$image
->
{'
using
'}
=
[
values
(
%tmp
)
];
}
}
if
(
defined
(
$webtask
))
{
$webtask
->
value
(
\
@ordered
);
$webtask
->
Exited
(
0
);
}
else
{
print
Dumper
(
\
@ordered
);
}
exit
(
0
);
}
#
# Delete image at the specified cluster,
#
sub
DoDeleteImage
()
{
my
$usage
=
sub
{
print
STDERR
"
Usage: manage_images delete [-a am_urn] <image_urn>
\n
";
exit
(
-
1
);
};
my
$optlist
=
"
a:d:n
";
my
$aggregate_urn
=
$MYURN
;
my
$impotent
=
0
;
my
$profile
;
my
$errmsg
;
my
%options
=
();
if
(
!
getopts
(
$optlist
,
\
%options
))
{
&$usage
();
}
if
(
defined
(
$options
{"
a
"}))
{
$aggregate_urn
=
$options
{"
a
"};
}
if
(
defined
(
$options
{"
n
"}))
{
$impotent
=
1
;
}
&$usage
()
if
(
!
@ARGV
);
my
$image_urn
=
shift
(
@ARGV
);
if
(
defined
(
$options
{"
d
"}))
{
$profile
=
APT_Profile
->
Lookup
(
$options
{"
d
"});
if
(
!
defined
(
$profile
))
{
fatal
("
Profile does not exist
");
}
if
(
$profile
->
isLocked
())
{
fatal
("
Profile is locked down, cannot be deleted
");
}
#
# This argument says; delete any version of the specified
# profile, that reference the image being deleted. So we
# have to go through every version of the profile and check
# to see if its using this image. For any of those versions,
# we try to delete it.
#
my
@todelete
=
();
foreach
my
$version
(
$profile
->
AllVersions
())
{
my
$usingimage
=
0
;
my
$conflict
;
#
# Check image references for this version. We want to
# know if there are any other images associated with this
# version beside the one we are trying to delete. If so,
# we cannot delete the profile version since that will
# result in another image getting deleted.
#
my
%irefs
=
%
{
$version
->
images
()
};
foreach
my
$client_id
(
keys
(
%irefs
))
{
my
$imageinfo
=
$irefs
{
$client_id
};
#
# We do not ever care about system images.
#
next
if
(
$imageinfo
->
ospid
()
eq
"
emulab-ops
");
my
$snapname
=
$profile
->
name
()
.
"
.
"
.
$client_id
;
next
if
(
!
(
$imageinfo
->
os
()
eq
$profile
->
name
()
||
$imageinfo
->
os
()
eq
$snapname
));
if
(
$imageinfo
->
image
()
eq
$image_urn
)
{
$usingimage
=
1
;
}
else
{
$conflict
=
$imageinfo
->
image
();
}
}
if
(
$usingimage
&&
$conflict
)
{
fatal
("
Version
"
.
$version
->
version
()
.
"
of the
"
.
$version
->
name
()
.
"
profile has another
"
.
"
image that would be deleted as well:
$conflict
.
"
.
"
You will need to go to the profile page and delete
"
.
"
that profile version before you can delete this image.
");
}
if
(
$usingimage
&&
$version
->
isLocked
())
{
fatal
("
Version
"
.
$version
->
version
()
.
"
is locked
"
.
"
down, cannot delete it.
");
}
if
(
$usingimage
)
{
push
(
@todelete
,
$version
);
print
"
Would delete profile version
"
.
$version
->
version
()
.
"
\n
";
}
}
foreach
my
$version
(
@todelete
)
{
my
$vers
=
$version
->
version
();
my
$uuid
=
$version
->
uuid
();
print
"
Deleting version
$vers
\n
";
my
$opt
=
(
$impotent
?
"
-n
"
:
"");
my
$output
=
emutil::
ExecQuiet
("
$MANAGEPROFILE
delete -- -k
$opt
$uuid
");
print
$output
;
if
(
$?
)
{
fatal
("
Could not delete version
$vers
");
}
}
}
my
$context
=
APT_Geni::
GeniContext
();
if
(
!
defined
(
$context
))
{
fatal
("
Could not create context to talk to CM.
");
}
Genixmlrpc
->
SetContext
(
$context
);
# Shorten default timeout.
Genixmlrpc
->
SetTimeout
(
60
);
my
$authority
=
GeniAuthority
->
Lookup
(
$aggregate_urn
);
if
(
!
defined
(
$authority
))
{
fatal
("
No such aggregate
");
}
my
$cmurl
=
$authority
->
url
();
if
(
$usemydevtree
)
{
$cmurl
=~
s/protogeni/protogeni\/stoller/
;
}
my
(
$credential
,
$speaksfor
)
=
APT_Geni::
GenUserCredential
(
$geniuser
);
fatal
("
Could not generate credentials for user
")
if
(
!
defined
(
$credential
));
my
$credentials
=
[
$credential
->
asString
()];
if
(
defined
(
$speaksfor
))
{
$credentials
=
[
@$credentials
,
$speaksfor
->
asString
()];
}
my
$args
=
{
"
image_urn
"
=>
$image_urn
,
"
credentials
"
=>
$credentials
,
};
if
(
$impotent
)
{
$args
->
{"
impotent
"}
=
1
;
}
my
$response
=
Genixmlrpc::
CallMethod
(
$cmurl
,
undef
,
"
DeleteImage
",
$args
);
if
(
$response
->
code
()
!=
GENIRESPONSE_SUCCESS
&&
$response
->
code
()
!=
GENIRESPONSE_SEARCHFAILED
)
{
if
(
$response
->
output
())
{
print
STDERR
$response
->
output
()
.
"
\n
";
if
(
defined
(
$webtask
))
{
$webtask
->
output
(
$response
->
output
());
}
}
else
{
print
STDERR
"
Operation failed, returned
"
.
$response
->
code
()
.
"
\n
";
if
(
defined
(
$webtask
))
{
$webtask
->
output
("
Operation failed
");
}
}
if
(
defined
(
$webtask
))
{
$webtask
->
Exited
(
$response
->
code
());
}
exit
(
$response
->
code
());
}
if
(
defined
(
$webtask
))
{
$webtask
->
Exited
(
0
);
}
exit
(
0
);
}
sub
fatal
($)
{
my
(
$mesg
)
=
@_
;
if
(
defined
(
$webtask
))
{
$webtask
->
output
(
$mesg
);
$webtask
->
Exited
(
-
1
);
}
print
STDERR
"
$mesg
\n
";
# Exit with negative status so web interface treats it as system error.
exit
(
-
1
);
}
sub
escapeshellarg
($)
{
my
(
$str
)
=
@_
;
$str
=~
s/[^[:alnum:]]/\\$&/g
;
return
$str
;
}
apt/manage_profile.in
View file @
0040bd2f
...
...
@@ -30,6 +30,7 @@ use Data::Dumper;
use
CGI
;
use
POSIX
"
:sys_wait_h
";
use
POSIX
qw(setsid)
;
use
Carp
qw(cluck)
;
#
# Back-end script to manage APT profiles.
...
...
@@ -39,7 +40,9 @@ sub usage()
print
("
Usage: manage_profile create [-s uuid | -c uuid] <xmlfile>
\n
");
print
("
Usage: manage_profile update <profile> <xmlfile>
\n
");
print
("
Usage: manage_profile publish <profile>
\n
");
print
("
Usage: manage_profile delete <profile> [all]
\n
");
print
("
Usage: manage_profile delete -a <profile>
\n
");
print
("
Usage: manage_profile undelete pid,name:version
\n
");
print
("
Usage: manage_profile listimages <profile>
\n
");
exit
(
-
1
);
}
my
$optlist
=
"
ds:t:c:m
";
...
...
@@ -69,6 +72,7 @@ my $TBOPS = "@TBOPSEMAIL@";
my
$TBLOGS
=
"
@TBLOGSEMAIL
@
";
my
$MANAGEINSTANCE
=
"
$TB
/bin/manage_instance
";
my
$MANAGEGITREPO
=
"
$TB
/bin/manage_gitrepo
";
my
$MANAGEIMAGES
=
"
$TB
/bin/manage_images
";
my
$RUNGENILIB
=
"
$TB
/bin/rungenilib
";
#
...
...
@@ -95,6 +99,7 @@ use User;
use
Project
;
use
APT_Profile
;
use
APT_Instance
;
use
APT_Aggregate
;
use
GeniXML
;
use
GeniHRN
;
use
WebTask
;
...
...
@@ -103,9 +108,12 @@ use EmulabFeatures;
# Protos
sub
fatal
($);
sub
UserError
(
;
$
);
sub
DeleteProfile
($);
sub
CanDelete
($);
sub
DeleteProfile
();
sub
UnDeleteProfile
($);
sub
CanDelete
($$);
sub
PublishProfile
($);
sub
InsertImageRecords
($);
sub
ListImages
();
# Parse args below.