a94f4ce278
Former-commit-id: ee239bcbbb64fc271d052f3558e77610bd4a9542
279 lines
7.3 KiB
Perl
279 lines
7.3 KiB
Perl
#!/usr/bin/perl
|
||
|
||
#
|
||
# Setup
|
||
#
|
||
|
||
# Directives
|
||
use strict;
|
||
use warnings;
|
||
use File::Basename;
|
||
|
||
# Figure out the mode
|
||
my $mode = shift @ARGV;
|
||
|
||
my $framework_prefix = "/usr/lib/mono";
|
||
|
||
if (!defined $mode)
|
||
{
|
||
print STDERR "E: You must supply a mode\n";
|
||
print STDERR "E: Use: install-framework, install, remove-framework, remove, or name\n";
|
||
exit 1;
|
||
}
|
||
|
||
# Name is simply
|
||
if ($mode eq "name")
|
||
{
|
||
print "Mono\n";
|
||
exit 0;
|
||
}
|
||
|
||
# Get the base directory
|
||
my $basedir = "/usr/share/cli-common/packages.d/";
|
||
# Get the base file
|
||
my $basename = shift @ARGV;
|
||
|
||
# We're looking to install a framework
|
||
# The program gets the name of the package, then a list of
|
||
# the (framework version×10, full path) pairs
|
||
if ($mode eq "install-framework")
|
||
{
|
||
# TODO: We could detect this ourselves
|
||
my %runtime_versions = (20 => "$framework_prefix/2.0",
|
||
35 => "$framework_prefix/3.5",
|
||
40 => "$framework_prefix/4.0",
|
||
45 => "$framework_prefix/4.5");
|
||
|
||
my $uninstall = "$basedir/$basename.mono-framework";
|
||
|
||
open UNINSTALL, ">$uninstall"
|
||
or die "E: Cannot open uninstall: $uninstall";
|
||
|
||
while (@ARGV)
|
||
{
|
||
my $framework_ver = int(shift @ARGV);
|
||
my $dll = shift @ARGV;
|
||
|
||
if (! exists($runtime_versions{$framework_ver}))
|
||
{
|
||
printf STDERR "W: Attempted to install framework library for unsupported version $framework_ver";
|
||
next;
|
||
}
|
||
|
||
my $target = "$runtime_versions{$framework_ver}/" . basename($dll);
|
||
|
||
if (-f $target)
|
||
{
|
||
# Ensure we're idempotent
|
||
unlink $target;
|
||
}
|
||
|
||
symlink $dll, $target
|
||
or die "E: Unable to install $dll into framework path: $target\n";
|
||
print UNINSTALL "$target\n";
|
||
}
|
||
close UNINSTALL;
|
||
exit 0;
|
||
}
|
||
|
||
# Removing is also simple
|
||
if ($mode eq "remove-framework")
|
||
{
|
||
# Get the uninstall file
|
||
my $uninstall = "$basedir/$basename.mono-framework";
|
||
|
||
if (-f $uninstall)
|
||
{
|
||
# Go through the file
|
||
open UNINSTALL, "<$uninstall" or
|
||
die "E: Cannot open uninstall file ($!)";
|
||
|
||
while (<UNINSTALL>)
|
||
{
|
||
chomp;
|
||
unlink($_) or
|
||
printf STDERR "E: Unable to remove $_\n";
|
||
}
|
||
|
||
close UNINSTALL;
|
||
unlink($uninstall);
|
||
}
|
||
|
||
# We are good
|
||
exit 0;
|
||
}
|
||
|
||
# This program gets the name of a file (ending in .installcligac) and
|
||
# a list of assemblies to install, as full paths. The ones given are
|
||
# the only ones that passed the white/blacklisting.
|
||
|
||
my $cligac = "/usr/share/cli-common/packages.d/$basename.installcligac";
|
||
|
||
if (! -f $cligac)
|
||
{
|
||
print STDERR "E: File does not exist: $cligac\n";
|
||
exit 1;
|
||
}
|
||
|
||
# Removing is also simple
|
||
if ($mode eq "remove")
|
||
{
|
||
# Get the uninstall file
|
||
my $uninstall = "$basedir/$basename.mono";
|
||
|
||
if (-f $uninstall)
|
||
{
|
||
# Go through the file
|
||
open UNINSTALL, "<$uninstall" or
|
||
die "E: Cannot open uninstall file ($!)";
|
||
|
||
while (<UNINSTALL>)
|
||
{
|
||
my $assembly = $_;
|
||
chomp($assembly);
|
||
# The uninstall file can contain two formats - full paths to non-assembly entries
|
||
# (i.e. FSharp sigdata/optdata files), or assembly signature stuff in the format
|
||
# "name, Version=x.x.x.x, Culture=neutral, PublicKeyToken=yyyyyyyyyyyyy"
|
||
#
|
||
# We can switch behaviour, based on whether it is a path or not (if it is a path,
|
||
# it has a leading /)
|
||
#
|
||
# If it's not a path, pass the entry to gacutil to uninstall
|
||
if ($assembly !~ /^\//)
|
||
{
|
||
my $cmd = "/usr/bin/gacutil -u $assembly > /dev/null";
|
||
my $res = system($cmd);
|
||
if ($res > 0) {
|
||
print STDERR "W: removing assembly: $assembly failed!\n";
|
||
}
|
||
}
|
||
# If it is a path, unlink.
|
||
#
|
||
# This is often not actually needed - if a parent assembly is uninstalled
|
||
# from the GAC, the sigdata/optdata files are cleaned automatically
|
||
#
|
||
# We manually unlink if these files are specifically named anyway, in case
|
||
# we ever want to keep companion files in different packages (where they would
|
||
# not be uninstalled by the same GAC cleaning run)
|
||
else
|
||
{
|
||
# Definitely a link, unlink it please
|
||
if (-l "$assembly")
|
||
{
|
||
unlink $assembly;
|
||
}
|
||
# The file exists, but is not a link, which means we didn't put it
|
||
# there, so panic!
|
||
elsif (-f "$assembly")
|
||
{
|
||
print STDERR "W: removing non-assembly file: $assembly failed!\n";
|
||
}
|
||
# If the file doesn't exist, we do nothing - we don't WANT it to exist
|
||
}
|
||
}
|
||
|
||
close UNINSTALL;
|
||
|
||
# Unlike the file
|
||
unlink($uninstall);
|
||
}
|
||
|
||
# We are good
|
||
exit 0;
|
||
}
|
||
|
||
# The only thing left should be "install"
|
||
if ($mode ne "install")
|
||
{
|
||
print STDERR "E: Unknown mode: $mode\n";
|
||
print STDERR "E: Use: install-framework, install, remove-framework, remove or name\n";
|
||
exit 1;
|
||
}
|
||
|
||
|
||
# Open up our uninstall file
|
||
open UNINSTALL, ">$basedir/$basename.mono"
|
||
or die "E: Cannot open uninstall: $basedir/$basename.mono";
|
||
|
||
# Go through the file
|
||
open CLIGAC, "<$cligac" or die "E: Cannot open: $cligac ($!)";
|
||
|
||
while (@ARGV)
|
||
{
|
||
# Get the assembly name
|
||
my $dll = shift @ARGV;
|
||
|
||
# Make sure it is there
|
||
if (! -f $dll)
|
||
{
|
||
print STDERR "E: Assembly does not exist: $dll\n";
|
||
exit 1;
|
||
}
|
||
|
||
# Split the provided assembly path into its components - folder, basename, and suffix.
|
||
# All three are useful
|
||
my($assemblyfilename, $assemblypath, $assemblysuffix) = (fileparse($dll, qr/\.[^.]*/));
|
||
|
||
# If the suffix is .dll, assume this is a simple CLI assembly, and use gacutil for
|
||
# processing
|
||
if (( $assemblysuffix eq ".dll" ) || ( $assemblysuffix eq ".exe" ))
|
||
{
|
||
# Figure out the mono's precise name
|
||
my $fullname = get_full_name($dll);
|
||
|
||
# Write out the uninstall file
|
||
print UNINSTALL "$fullname\n";
|
||
|
||
# Install the file. We use the "../../../.." to make it a
|
||
# relative path to this program (since gacutil doesn't like
|
||
# absolute paths). There isn't a problem of doing too many
|
||
# since we typically run from the root context.
|
||
my $cmd = "(cd `dirname $dll` && "
|
||
. "/usr/bin/gacutil -i `basename $dll`"
|
||
. " > /dev/null)";
|
||
system($cmd) == 0 or die "E: installing Assembly $dll failed\n";
|
||
}
|
||
else
|
||
{
|
||
# If the extension is not .dll, this is some other file format (e.g. FSharp
|
||
# sigdata/optdata) and we cannot use gacutil.
|
||
#
|
||
# First, we determine the path of the assembly which accompanies this data file
|
||
my $parentassembly = "$assemblypath$assemblyfilename.dll";
|
||
# Then extract the assembly information from this "parent" assembly, such as the
|
||
# version and signing token
|
||
my $fullname = get_full_name($parentassembly);
|
||
my($parentname, $parentver, $parentculture, $parenttoken) = split(/, [a-zA-z]*=/, $fullname);
|
||
# And finally, we construct a path to where we know Mono will GAC-install the
|
||
# parent assembly, and put a symlink in there
|
||
my $targetpath = "$framework_prefix/gac/$parentname/$parentver\__$parenttoken/$assemblyfilename$assemblysuffix";
|
||
symlink($dll, $targetpath);
|
||
# And write the path to the symlink into the uninstall file
|
||
print UNINSTALL "$targetpath\n";
|
||
}
|
||
}
|
||
|
||
close CLIGAC;
|
||
close UNINSTALL;
|
||
|
||
# Finish up successfully
|
||
exit 0;
|
||
|
||
# Get the name of the assembly in a manner suitable for uninstall
|
||
# using gacutil.
|
||
sub get_full_name
|
||
{
|
||
# Get the name
|
||
my $dll = shift;
|
||
|
||
# Open a pipe to monop
|
||
my $cmd = "LANG=C /usr/bin/mono /usr/share/mono/MonoGetAssemblyName.exe $dll";
|
||
open PIPE, "$cmd |" or die "E: Cannot open pipe to assembly builder $dll";
|
||
|
||
# This generate a single line that produces the desired results
|
||
$_ = <PIPE>;
|
||
chomp;
|
||
# assembly1, Version=1.0.0.0, Culture=en, PublicKeyToken=0123456789abcdef
|
||
return $_;
|
||
}
|