]> git.netwichtig.de Git - user/henk/code/inspircd.git/blobdiff - modulemanager
Sync helpop chmodes s and p with docs
[user/henk/code/inspircd.git] / modulemanager
index 0d5d1fd163c32b573fd439d319ca15400f5e7880..ffd315da51a7b2ea8d45c400c88979db0f684493 100755 (executable)
@@ -1,11 +1,45 @@
-#!/usr/bin/perl
+#!/usr/bin/env perl
+#
+# InspIRCd -- Internet Relay Chat Daemon
+#
+#   Copyright (C) 2012-2014, 2017-2021 Sadie Powell <sadie@witchery.services>
+#   Copyright (C) 2012 Robby <robby@chatbelgie.be>
+#   Copyright (C) 2010 Daniel De Graaf <danieldg@inspircd.org>
+#   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/>.
+#
+
+
+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
@@ -24,19 +58,25 @@ 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};
@@ -57,36 +97,55 @@ sub parse_url {
                        $mod->{description} = $1;
                } elsif (/^mask (.*)/) {
                        $mod->{mask} = $1;
-               } elsif (m#^source (http://\S+)#) {
+               } 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 (<SRC>) {
        next if /^\s*#/;
        parse_url($_);
 }
 close SRC;
 
-getmodules();
-
-`./src/version.sh` =~ /InspIRCd-([0-9.]+)/ or die "Cannot determine inspircd version";
-$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',
 };
 
-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};
@@ -102,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;
@@ -116,13 +183,13 @@ 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 if $l && ver_cmp($ver, $l) < 0;
-               return 0 if $h && 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 {
@@ -150,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
@@ -163,7 +230,7 @@ sub resolve_deps {
                                }
                        }
                        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.
@@ -184,10 +251,8 @@ 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}) {
@@ -201,7 +266,9 @@ if ($action eq 'install') {
                }
                $todo{$mod} = $ver;
        }
-} elsif ($action eq 'upgrade') {
+};
+
+command 'upgrade', 'Upgrade a third-party module', sub {
        my @installed = sort keys %installed;
        for my $mod (@installed) {
                next unless $mod =~ /^m_/;
@@ -211,7 +278,9 @@ if ($action eq 'install') {
                        %todo = %saved;
                }
        }
-} elsif ($action eq 'list') {
+};
+
+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}};
@@ -225,29 +294,24 @@ if ($action eq 'install') {
                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;
-}
+       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};
@@ -261,10 +325,22 @@ for my $mod (sort keys %todo) {
        } 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;
+       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";