mirror of
https://github.com/inspircd/inspircd.git
synced 2025-03-09 10:39:02 -04:00
7404ba8b66
The other code in that file will be removed very soon so it has been left alone to avoid merge conflicts. This will help prevent insp20 merge conflicts in the future.
365 lines
9.1 KiB
Perl
Executable File
365 lines
9.1 KiB
Perl
Executable File
#!/usr/bin/env perl
|
|
|
|
#
|
|
# InspIRCd -- Internet Relay Chat Daemon
|
|
#
|
|
# Copyright (C) 2008-2009 Robin Burchell <robin+git@viroteck.net>
|
|
#
|
|
# This file is part of InspIRCd. InspIRCd is free software: you can
|
|
# redistribute it and/or modify it under the terms of the GNU General Public
|
|
# License as published by the Free Software Foundation, version 2.
|
|
#
|
|
# This program 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 General Public License for more
|
|
# details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License
|
|
# along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
#
|
|
|
|
|
|
use strict;
|
|
use warnings FATAL => qw(all);
|
|
|
|
use make::common;
|
|
|
|
BEGIN {
|
|
unless (module_installed("LWP::Simple")) {
|
|
die "Your system is missing the LWP::Simple Perl module!";
|
|
}
|
|
unless (module_installed("Crypt::SSLeay") || module_installed("IO::Socket::SSL")) {
|
|
die "Your system is missing the Crypt::SSLeay or IO::Socket::SSL Perl modules!";
|
|
}
|
|
|
|
}
|
|
|
|
use File::Basename;
|
|
use LWP::Simple;
|
|
|
|
my %installed;
|
|
# $installed{name} = $version
|
|
|
|
my %modules;
|
|
# $modules{$name}{$version} = {
|
|
# url => URL of this version
|
|
# depends => [ 'm_foo 1.2.0-1.3.0', ... ]
|
|
# conflicts => [ ]
|
|
# from => URL of source document
|
|
# mask => Reason for not installing (INSECURE/DEPRECATED)
|
|
# description => some string
|
|
# }
|
|
|
|
my %url_seen;
|
|
|
|
sub parse_url;
|
|
|
|
# retrieve and parse entries from sources.list
|
|
sub parse_url {
|
|
chomp(my $src = shift);
|
|
return if $url_seen{$src};
|
|
$url_seen{$src}++;
|
|
|
|
my $ua = LWP::UserAgent->new(ssl_opts => { verify_hostname => 0 });
|
|
my $response = $ua->get($src);
|
|
|
|
unless ($response->is_success) {
|
|
my $err = $response->message;
|
|
die "Could not retrieve $src: $err";
|
|
}
|
|
|
|
my $mod;
|
|
for (split /\n+/, $response->decoded_content) {
|
|
s/^\s+//; # ignore whitespace at start
|
|
next if /^#/;
|
|
if (/^module (\S+) (\S+) (\S+)/) {
|
|
my($name, $ver, $url) = ($1,$2,$3);
|
|
if ($modules{$name}{$ver}) {
|
|
my $origsrc = $modules{$name}{$ver}{from};
|
|
warn "Overriding module $name $ver defined from $origsrc with one from $src";
|
|
}
|
|
$mod = {
|
|
from => $src,
|
|
url => $url,
|
|
depends => [],
|
|
conflicts => [],
|
|
};
|
|
$modules{$name}{$ver} = $mod;
|
|
} elsif (/^depends (.*)/) {
|
|
push @{$mod->{depends}}, $1;
|
|
} elsif (/^conflicts (.*)/) {
|
|
push @{$mod->{conflicts}}, $1;
|
|
} elsif (/^description (.*)/) {
|
|
$mod->{description} = $1;
|
|
} elsif (/^mask (.*)/) {
|
|
$mod->{mask} = $1;
|
|
} elsif (m#^source (http://\S+)#) {
|
|
parse_url $1;
|
|
} else {
|
|
print "Unknown line in $src: $_\n";
|
|
}
|
|
}
|
|
}
|
|
|
|
# hash of installed module versions from our mini-database, key (m_foobar) to version (00abacca..).
|
|
my %mod_versions;
|
|
|
|
# useless helper stub
|
|
sub getmodversion {
|
|
my ($file) = @_;
|
|
return $mod_versions{$file};
|
|
}
|
|
|
|
# read in installed versions
|
|
if (-e '.modulemanager')
|
|
{
|
|
open SRC, '.modulemanager' or die ".modulemanager exists but i can't read it: $!";
|
|
while (<SRC>)
|
|
{
|
|
s/\n//;
|
|
(my $mod, my $ver) = split(/ /, $_);
|
|
$mod_versions{$mod} = $ver;
|
|
}
|
|
close SRC;
|
|
}
|
|
|
|
# read in external URL sources
|
|
open SRC, 'sources.list' or die "Could not open sources.list: $!";
|
|
while (<SRC>) {
|
|
next if /^\s*#/;
|
|
parse_url($_);
|
|
}
|
|
close SRC;
|
|
|
|
# determine core version
|
|
`./src/version.sh` =~ /InspIRCd-([0-9.]+)/ or die "Cannot determine inspircd version";
|
|
$installed{core} = $1;
|
|
for my $mod (keys %modules) {
|
|
MODVER: for my $mver (keys %{$modules{$mod}}) {
|
|
for my $dep (@{$modules{$mod}{$mver}{depends}}) {
|
|
next unless $dep =~ /^core (.*)/;
|
|
if (!ver_in_range($installed{core}, $1)) {
|
|
delete $modules{$mod}{$mver};
|
|
next MODVER;
|
|
}
|
|
}
|
|
}
|
|
delete $modules{$mod} unless %{$modules{$mod}};
|
|
}
|
|
$modules{core}{$1} = {
|
|
url => 'NONE',
|
|
depends => [],
|
|
conflicts => [],
|
|
from => 'local file',
|
|
};
|
|
|
|
# set up core module list
|
|
for my $modname (<src/modules/m_*.cpp>) {
|
|
my $mod = basename($modname, '.cpp');
|
|
my $ver = getmodversion($mod) || '0.0';
|
|
$ver =~ s/\$Rev: (.*) \$/$1/; # for storing revision in SVN
|
|
$installed{$mod} = $ver;
|
|
next if $modules{$mod}{$ver};
|
|
$modules{$mod}{$ver} = {
|
|
url => 'NONE',
|
|
depends => [],
|
|
conflicts => [],
|
|
from => 'local file',
|
|
};
|
|
}
|
|
|
|
my %todo = %installed;
|
|
|
|
sub ver_cmp {
|
|
($a,$b) = @_ if @_;
|
|
|
|
if ($a !~ /^[0-9.]+$/ or $b !~ /^[0-9.]+$/)
|
|
{
|
|
# not a valid version number, don't try to sort
|
|
return $a ne $b;
|
|
}
|
|
|
|
# else it's probably a numerical type version.. i.e. 1.0
|
|
my @a = split /\./, $a;
|
|
my @b = split /\./, $b;
|
|
push @a, 0 while $#a < $#b;
|
|
push @b, ($_[2] || 0) while $#b < $#a;
|
|
for my $i (0..$#a) {
|
|
my $d = $a[$i] <=> $b[$i];
|
|
return $d if $d;
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
sub ver_in_range {
|
|
my($ver, $range) = @_;
|
|
return 1 unless defined $range;
|
|
my($l,$h) = ($range, $range);
|
|
if ($range =~ /(.*)-(.*)/) {
|
|
($l,$h) = ($1,$2);
|
|
}
|
|
return 0 if $l && ver_cmp($ver, $l) < 0;
|
|
return 0 if $h && ver_cmp($ver, $h, 9999) > 0;
|
|
return 1;
|
|
}
|
|
|
|
sub find_mod_in_range {
|
|
my($mod, $vers, $force) = @_;
|
|
my @versions = keys %{$modules{$mod}};
|
|
@versions = sort { -ver_cmp() } @versions;
|
|
for my $ver (@versions) {
|
|
next if $modules{$mod}{$ver}{mask} && !$force;
|
|
return $ver if ver_in_range($ver, $vers);
|
|
}
|
|
return undef;
|
|
}
|
|
|
|
sub resolve_deps {
|
|
my($trial) = @_;
|
|
my $tries = 100;
|
|
my $changes = 'INIT';
|
|
my $fail = undef;
|
|
while ($changes && $tries) {
|
|
$tries--;
|
|
$changes = '';
|
|
$fail = undef;
|
|
my @modsnow = sort keys %todo;
|
|
for my $mod (@modsnow) {
|
|
my $ver = $todo{$mod};
|
|
my $info = $modules{$mod}{$ver} or die "no dependency information on $mod $ver";
|
|
for my $dep (@{$info->{depends}}) {
|
|
$dep =~ /^(\S+)(?: (\S+))?/ or die "Bad dependency $dep from $info->{from}";
|
|
my($depmod, $depvers) = ($1,$2);
|
|
next if $todo{$depmod} && ver_in_range($todo{$depmod}, $depvers);
|
|
# need to install a dependency
|
|
my $depver = find_mod_in_range($depmod, $depvers);
|
|
if (defined $depver) {
|
|
$todo{$depmod} = $depver;
|
|
$changes .= " $mod-$ver->$depmod-$depver";
|
|
} else {
|
|
$fail ||= "Could not find module $depmod $depvers required by $mod $ver";
|
|
}
|
|
}
|
|
for my $dep (@{$info->{conflicts}}) {
|
|
$dep =~ /^(\S+)(?: (\S+))?/ or die "Bad dependency $dep from $info->{from}";
|
|
my($depmod, $depvers) = ($1,$2);
|
|
next unless $todo{$depmod} && ver_in_range($todo{$depmod}, $depvers);
|
|
# if there are changes this round, maybe the conflict won't come up after they are resolved.
|
|
$fail ||= "Cannot install: module $mod ($ver) conflicts with $depmod version $todo{$depmod}";
|
|
}
|
|
}
|
|
}
|
|
if ($trial) {
|
|
return !($changes || $fail);
|
|
}
|
|
if ($changes) {
|
|
print "Infinite dependency loop:$changes\n";
|
|
exit 1;
|
|
}
|
|
if ($fail) {
|
|
print "$fail\n";
|
|
exit 1;
|
|
}
|
|
}
|
|
|
|
my $action = $#ARGV >= 0 ? lc shift @ARGV : 'help';
|
|
|
|
if ($action eq 'install') {
|
|
for my $mod (@ARGV) {
|
|
my $vers = $mod =~ s/=([-0-9.]+)// ? $1 : undef;
|
|
$mod = lc $mod;
|
|
unless ($modules{$mod}) {
|
|
print "Cannot find module $mod\n";
|
|
exit 1;
|
|
}
|
|
my $ver = find_mod_in_range($mod, $vers, $vers ? 1 : 0);
|
|
unless ($ver) {
|
|
print "Cannot find suitable version of $mod\n";
|
|
exit 1;
|
|
}
|
|
$todo{$mod} = $ver;
|
|
}
|
|
} elsif ($action eq 'upgrade') {
|
|
my @installed = sort keys %installed;
|
|
for my $mod (@installed) {
|
|
next unless $mod =~ /^m_/;
|
|
my %saved = %todo;
|
|
$todo{$mod} = find_mod_in_range($mod);
|
|
if (!resolve_deps(1)) {
|
|
%todo = %saved;
|
|
}
|
|
}
|
|
} elsif ($action eq 'list') {
|
|
my @all = sort keys %modules;
|
|
for my $mod (@all) {
|
|
my @vers = sort { ver_cmp() } keys %{$modules{$mod}};
|
|
my $desc = '';
|
|
for my $ver (@vers) {
|
|
# latest defined description wins
|
|
$desc = $modules{$mod}{$ver}{description} || $desc;
|
|
}
|
|
next if @vers == 1 && $modules{$mod}{$vers[0]}{url} eq 'NONE';
|
|
my $instver = $installed{$mod} || '';
|
|
my $vers = join ' ', map { $_ eq $instver ? "\e[1m$_\e[m" : $_ } @vers;
|
|
print "$mod ($vers) - $desc\n";
|
|
}
|
|
} else {
|
|
print <<ENDUSAGE
|
|
Use: $0 <action> <args>
|
|
Action is one of the following
|
|
install install new modules
|
|
upgrade upgrade installed modules
|
|
list lists available modules
|
|
|
|
For installing a package, specify its name or name=version to force the
|
|
installation of a specific version.
|
|
ENDUSAGE
|
|
;exit 1;
|
|
}
|
|
|
|
resolve_deps(0);
|
|
|
|
$| = 1; # immediate print of lines without \n
|
|
|
|
print "Processing changes for $action...\n";
|
|
for my $mod (keys %installed) {
|
|
next if $todo{$mod};
|
|
print "Uninstalling $mod $installed{$mod}\n";
|
|
unlink "src/modules/$mod.cpp";
|
|
}
|
|
|
|
my $count = scalar keys %todo;
|
|
print "Checking $count items...\n";
|
|
for my $mod (sort keys %todo) {
|
|
my $ver = $todo{$mod};
|
|
my $oldver = $installed{$mod};
|
|
if ($modules{$mod}{$ver}{mask}) {
|
|
print "Module $mod $ver is masked: $modules{$mod}{$ver}{mask}\n";
|
|
}
|
|
next if $oldver && $oldver eq $ver;
|
|
my $url = $modules{$mod}{$ver}{url};
|
|
if ($oldver) {
|
|
print "Upgrading $mod from $oldver to $ver using $url"
|
|
} else {
|
|
print "Installing $mod $ver from $url";
|
|
}
|
|
$mod_versions{$mod} = $ver;
|
|
|
|
my $stat = getstore($url, "src/modules/$mod.cpp");
|
|
if ($stat == 200) {
|
|
print " - done\n";
|
|
} else {
|
|
print " - HTTP $stat\n";
|
|
}
|
|
}
|
|
|
|
# write database of installed versions
|
|
open SRC, '>.modulemanager' or die "can't write installed versions to .modulemanager, won't be able to track upgrades properly: $!";
|
|
foreach my $key (keys %mod_versions)
|
|
{
|
|
print SRC "$key $mod_versions{$key}\n";
|
|
}
|
|
close SRC;
|
|
|
|
print "Finished!\n";
|