X-Git-Url: https://git.netwichtig.de/gitweb/?a=blobdiff_plain;f=modulemanager;h=0d92f1f7d4979ca2ab6fdca14fbb027807e76e3b;hb=e94b673532f7833aaa4789f834e61d68e0b4fc56;hp=2f3d0a505a7ce71941119fef271050c949f1c2db;hpb=3e72c8cb7eb2daf7419d00a9ff50eda3cbb40db3;p=user%2Fhenk%2Fcode%2Finspircd.git diff --git a/modulemanager b/modulemanager index 2f3d0a505..0d92f1f7d 100755 --- a/modulemanager +++ b/modulemanager @@ -1,40 +1,82 @@ -#!/usr/bin/perl +#!/usr/bin/env perl +# +# InspIRCd -- Internet Relay Chat Daemon +# +# Copyright (C) 2012-2014, 2017-2021 Sadie Powell +# Copyright (C) 2012 Robby +# Copyright (C) 2010 Daniel De Graaf +# Copyright (C) 2008-2009 Robin Burchell +# +# 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 . +# + + +BEGIN { + unless (eval "use LWP::Simple; 1") { + die "Your system is missing the LWP::Simple Perl module!"; + } + unless (eval "use Crypt::SSLeay; 1" || eval "use IO::Socket::SSL; 1") { + die "Your system is missing the Crypt::SSLeay or IO::Socket::SSL Perl modules!"; + } +} + +use v5.10.0; use strict; use warnings FATAL => qw(all); -use LWP::Simple; -use make::configure; +use File::Basename qw(basename); +use FindBin qw($RealDir); -our @modlist; +use lib $RealDir; +use make::common; +use make::console; my %installed; # $installed{name} = $version my %modules; # $modules{$name}{$version} = { -# url => URL of this version (or INSECURE/DEPRECATED) +# 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 { - my $src = shift; + chomp(my $src = shift); return if $url_seen{$src}; $url_seen{$src}++; - my $doc = get($src); - die "Could not retrieve $_" unless defined $doc; + my $ua = LWP::UserAgent->new; + my $response = $ua->get($src); + + unless ($response->is_success) { + my $err = $response->message; + die "Could not retrieve $src: $err"; + } my $mod; - for (split /\n+/, $doc) { + for (split /\n+/, $response->content) { s/^\s+//; # ignore whitespace at start next if /^#/; - if (/^module (\S+) ([0-9.]+) (\S+)/) { + if (/^module (\S+) (\S+) (\S+)/) { my($name, $ver, $url) = ($1,$2,$3); if ($modules{$name}{$ver}) { my $origsrc = $modules{$name}{$ver}{from}; @@ -51,39 +93,60 @@ sub parse_url { push @{$mod->{depends}}, $1; } elsif (/^conflicts (.*)/) { push @{$mod->{conflicts}}, $1; - } elsif (m#^source (http://\S+)#) { + } elsif (/^description (.*)/) { + $mod->{description} = $1; + } elsif (/^mask (.*)/) { + $mod->{mask} = $1; + } elsif (/^source (\S+)/) { parse_url $1; - } else { - print "Unknown line in $src: $_\n"; } } } -open SRC, 'sources.list' or die "Could not open sources.list: $!"; +# hash of installed module versions from our mini-database, key (m_foobar) to version (00abacca..). +my %mod_versions = read_config_file "$RealDir/.modulemanager"; + +# useless helper stub +sub getmodversion { + my ($file) = @_; + return $mod_versions{$file}; +} + +# read in external URL sources +open SRC, "$RealDir/sources.list" or die "Could not open sources.list: $!"; while () { next if /^\s*#/; parse_url($_); } close SRC; -getmodules(); - -open my $verfile, 'src/version.sh' or die "Cannot determine inspircd version: $!"; -$_ = join '', <$verfile>; -die "Cannot determine inspircd version" unless /InspIRCd-([0-9.]+)/; -$installed{core} = $1; -$modules{core}{$1} = { +# determine core version +my %version = get_version(); +$installed{core} = "$version{MAJOR}.$version{MINOR}.$version{PATCH}"; +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}{$installed{core}} = { url => 'NONE', depends => [], conflicts => [], from => 'local file', }; -close $verfile; -for my $modname (@modlist) { - my $mod = "m_$modname"; - my $modfile = "src/modules/$mod.cpp"; - my $ver = getmodversion($modfile) || '0.0'; +# set up core module list +for my $modname (<$RealDir/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} = { @@ -98,10 +161,18 @@ 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, 0 while $#b < $#a; + push @b, ($_[2] || 0) while $#b < $#a; for my $i (0..$#a) { my $d = $a[$i] <=> $b[$i]; return $d if $d; @@ -112,26 +183,28 @@ sub ver_cmp { sub ver_in_range { my($ver, $range) = @_; return 1 unless defined $range; + my($l,$h) = ($range, $range); if ($range =~ /(.*)-(.*)/) { - my($l,$h) = ($1,$2); - return 0 unless ver_cmp($ver, $l) >= 0; - return 0 unless ver_cmp($ver, $h) <= 0; - return 1; + ($l,$h) = ($1,$2); } - return !ver_cmp($ver, $range); + 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) = @_; + my($mod, $vers, $force) = @_; my @versions = keys %{$modules{$mod}}; - @versions = sort { ver_cmp() } @versions; - for my $ver (reverse @versions) { + @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; @@ -144,7 +217,7 @@ sub resolve_deps { my $ver = $todo{$mod}; my $info = $modules{$mod}{$ver} or die "no dependency information on $mod $ver"; for my $dep (@{$info->{depends}}) { - $dep =~ /^(\S+)(?: ([-0-9.]+))?/ or die "Bad dependency $dep from $info->{from}"; + $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 @@ -153,18 +226,21 @@ sub resolve_deps { $todo{$depmod} = $depver; $changes .= " $mod-$ver->$depmod-$depver"; } else { - $fail ||= "Could not find module $depmod $depver required by $mod $ver"; + $fail ||= "Could not find module $depmod $depvers required by $mod $ver"; } } for my $dep (@{$info->{conflicts}}) { - $dep =~ /^(\S+)(?: ([-0-9.]+))?/ or die "Bad dependency $dep from $info->{from}"; + $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 versions $depmod version $todo{depmod}"; + $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; @@ -175,62 +251,96 @@ sub resolve_deps { } } -my $action = lc shift @ARGV; - -if ($action eq 'install') { - for my $mod (@ARGV) { +command 'install', 'Install a third-party module', sub { + for my $mod (@_) { 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); + 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') { - for my $mod (keys %installed) { +}; + +command 'upgrade', 'Upgrade a third-party module', sub { + 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; + } } -} else { - die "Unknown action $action" -} +}; -resolve_deps(); +command 'list', 'List available third-party modules', sub { + 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"; + } + exit 0; +}; + +execute_command @ARGV; + +resolve_deps(0); $| = 1; # immediate print of lines without \n +print "Processing changes...\n"; for my $mod (keys %installed) { next if $todo{$mod}; print "Uninstalling $mod $installed{$mod}\n"; - unlink "src/modules/$mod.cpp"; + unlink "$RealDir/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}; - my $url = $modules{$mod}{$ver}{url}; - if ($url eq 'INSECURE') { - print "WARNING: Version $ver of $mod is insecure!\n"; - next; - } elsif ($url eq 'DEPRECATED') { - print "Note: version $ver of $mod is deprecated\n"; - next; + 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"; } - my $stat = getstore($url, "src/modules/$mod.cpp"); - if ($stat == 200) { + $mod_versions{$mod} = $ver; + + my $ua = LWP::UserAgent->new(ssl_opts => { verify_hostname => 0 }); + my $response = $ua->get($url); + + if ($response->is_success) { + open(MF, '>', "$RealDir/src/modules/$mod.cpp") or die "\nFilesystem not writable: $!"; + print MF $response->content; + close(MF); print " - done\n"; } else { - print " - HTTP $stat\n"; + printf "\nHTTP %s: %s\n", $response->code, $response->message; } } + +# write database of installed versions +write_config_file "$RealDir/.modulemanager", %mod_versions; + +print "Finished!\n";