modulemanager

   1 #!/usr/bin/env perl
   2
   3 #
   4 # InspIRCd -- Internet Relay Chat Daemon
   5 #
   6 #   Copyright (C) 2012-2014, 2017-2019 Sadie Powell <sadie@witchery.services>
   7 #   Copyright (C) 2012 Robby <robby@chatbelgie.be>
   8 #   Copyright (C) 2009-2010 Daniel De Graaf <danieldg@inspircd.org>
   9 #   Copyright (C) 2008-2009 Robin Burchell <robin+git@viroteck.net>
  10 #
  11 # This file is part of InspIRCd.  InspIRCd is free software: you can
  12 # redistribute it and/or modify it under the terms of the GNU General Public
  13 # License as published by the Free Software Foundation, version 2.
  14 #
  15 # This program is distributed in the hope that it will be useful, but WITHOUT
  16 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  17 # FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
  18 # details.
  19 #
  20 # You should have received a copy of the GNU General Public License
  21 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  22 #
  23
  24
  25 BEGIN {
  26         require 5.10.0;
  27         unless (eval "use LWP::Simple; 1") {
  28                 die "Your system is missing the LWP::Simple Perl module!";
  29         }
  30         unless (eval "use Crypt::SSLeay; 1" || eval "use IO::Socket::SSL; 1") {
  31                 die "Your system is missing the Crypt::SSLeay or IO::Socket::SSL Perl modules!";
  32         }
  33 }
  34
  35 use feature ':5.10';
  36 use strict;
  37 use warnings FATAL => qw(all);
  38
  39 use File::Basename qw(basename);
  40 use FindBin        qw($RealDir);
  41
  42 use lib $RealDir;
  43 use make::common;
  44 use make::console;
  45
  46 my %installed;
  47 # $installed{name} = $version
  48
  49 my %modules;
  50 # $modules{$name}{$version} = {
  51 #       url => URL of this version
  52 #       depends => [ 'm_foo 1.2.0-1.3.0', ... ]
  53 #       conflicts => [ ]
  54 #       from => URL of source document
  55 #       mask => Reason for not installing (INSECURE/DEPRECATED)
  56 #       description => some string
  57 # }
  58
  59 my %url_seen;
  60
  61 sub parse_url;
  62
  63 # retrieve and parse entries from sources.list
  64 sub parse_url {
  65         chomp(my $src = shift);
  66         return if $url_seen{$src};
  67         $url_seen{$src}++;
  68
  69         my $ua = LWP::UserAgent->new(ssl_opts => { verify_hostname => 0 });
  70         my $response = $ua->get($src);
  71
  72         unless ($response->is_success) {
  73                 my $err = $response->message;
  74                 die "Could not retrieve $src: $err";
  75         }
  76
  77         my $mod;
  78         for (split /\n+/, $response->content) {
  79                 s/^\s+//; # ignore whitespace at start
  80                 next if /^#/;
  81                 if (/^module (\S+) (\S+) (\S+)/) {
  82                         my($name, $ver, $url) = ($1,$2,$3);
  83                         if ($modules{$name}{$ver}) {
  84                                 my $origsrc = $modules{$name}{$ver}{from};
  85                                 warn "Overriding module $name $ver defined from $origsrc with one from $src";
  86                         }
  87                         $mod = {
  88                                 from => $src,
  89                                 url => $url,
  90                                 depends => [],
  91                                 conflicts => [],
  92                         };
  93                         $modules{$name}{$ver} = $mod;
  94                 } elsif (/^depends (.*)/) {
  95                         push @{$mod->{depends}}, $1;
  96                 } elsif (/^conflicts (.*)/) {
  97                         push @{$mod->{conflicts}}, $1;
  98                 } elsif (/^description (.*)/) {
  99                         $mod->{description} = $1;
 100                 } elsif (/^mask (.*)/) {
 101                         $mod->{mask} = $1;
 102                 } elsif (/^source (\S+)/) {
 103                         parse_url $1;
 104                 } else {
 105                         print "Unknown line in $src: $_\n";
 106                 }
 107         }
 108 }
 109
 110 # hash of installed module versions from our mini-database, key (m_foobar) to version (00abacca..).
 111 my %mod_versions = read_config_file '.modulemanager';
 112
 113 # useless helper stub
 114 sub getmodversion {
 115         my ($file) = @_;
 116         return $mod_versions{$file};
 117 }
 118
 119 # read in external URL sources
 120 open SRC, 'sources.list' or die "Could not open sources.list: $!";
 121 while (<SRC>) {
 122         next if /^\s*#/;
 123         parse_url($_);
 124 }
 125 close SRC;
 126
 127 # determine core version
 128 my %version = get_version();
 129 $installed{core} = "$version{MAJOR}.$version{MINOR}.$version{PATCH}";
 130 for my $mod (keys %modules) {
 131         MODVER: for my $mver (keys %{$modules{$mod}}) {
 132                 for my $dep (@{$modules{$mod}{$mver}{depends}}) {
 133                         next unless $dep =~ /^core (.*)/;
 134                         if (!ver_in_range($installed{core}, $1)) {
 135                                 delete $modules{$mod}{$mver};
 136                                 next MODVER;
 137                         }
 138                 }
 139         }
 140         delete $modules{$mod} unless %{$modules{$mod}};
 141 }
 142 $modules{core}{$installed{core}} = {
 143         url => 'NONE',
 144         depends => [],
 145         conflicts => [],
 146         from => 'local file',
 147 };
 148
 149 # set up core module list
 150 for my $modname (<src/modules/m_*.cpp>) {
 151         my $mod = basename($modname, '.cpp');
 152         my $ver = getmodversion($mod) || '0.0';
 153         $ver =~ s/\$Rev: (.*) \$/$1/; # for storing revision in SVN
 154         $installed{$mod} = $ver;
 155         next if $modules{$mod}{$ver};
 156         $modules{$mod}{$ver} = {
 157                 url => 'NONE',
 158                 depends => [],
 159                 conflicts => [],
 160                 from => 'local file',
 161         };
 162 }
 163
 164 my %todo = %installed;
 165
 166 sub ver_cmp {
 167         ($a,$b) = @_ if @_;
 168
 169         if ($a !~ /^[0-9.]+$/ or $b !~ /^[0-9.]+$/)
 170         {
 171                 # not a valid version number, don't try to sort
 172                 return $a ne $b;
 173         }
 174
 175         # else it's probably a numerical type version.. i.e. 1.0
 176         my @a = split /\./, $a;
 177         my @b = split /\./, $b;
 178         push @a, 0 while $#a < $#b;
 179         push @b, ($_[2] || 0) while $#b < $#a;
 180         for my $i (0..$#a) {
 181                 my $d = $a[$i] <=> $b[$i];
 182                 return $d if $d;
 183         }
 184         return 0;
 185 }
 186
 187 sub ver_in_range {
 188         my($ver, $range) = @_;
 189         return 1 unless defined $range;
 190         my($l,$h) = ($range, $range);
 191         if ($range =~ /(.*)-(.*)/) {
 192                 ($l,$h) = ($1,$2);
 193         }
 194         return 0 if $l && ver_cmp($ver, $l) < 0;
 195         return 0 if $h && ver_cmp($ver, $h, 9999) > 0;
 196         return 1;
 197 }
 198
 199 sub find_mod_in_range {
 200         my($mod, $vers, $force) = @_;
 201         my @versions = keys %{$modules{$mod}};
 202         @versions = sort { -ver_cmp() } @versions;
 203         for my $ver (@versions) {
 204                 next if $modules{$mod}{$ver}{mask} && !$force;
 205                 return $ver if ver_in_range($ver, $vers);
 206         }
 207         return undef;
 208 }
 209
 210 sub resolve_deps {
 211         my($trial) = @_;
 212         my $tries = 100;
 213         my $changes = 'INIT';
 214         my $fail = undef;
 215         while ($changes && $tries) {
 216                 $tries--;
 217                 $changes = '';
 218                 $fail = undef;
 219                 my @modsnow = sort keys %todo;
 220                 for my $mod (@modsnow) {
 221                         my $ver = $todo{$mod};
 222                         my $info = $modules{$mod}{$ver} or die "no dependency information on $mod $ver";
 223                         for my $dep (@{$info->{depends}}) {
 224                                 $dep =~ /^(\S+)(?: (\S+))?/ or die "Bad dependency $dep from $info->{from}";
 225                                 my($depmod, $depvers) = ($1,$2);
 226                                 next if $todo{$depmod} && ver_in_range($todo{$depmod}, $depvers);
 227                                 # need to install a dependency
 228                                 my $depver = find_mod_in_range($depmod, $depvers);
 229                                 if (defined $depver) {
 230                                         $todo{$depmod} = $depver;
 231                                         $changes .= " $mod-$ver->$depmod-$depver";
 232                                 } else {
 233                                         $fail ||= "Could not find module $depmod $depvers required by $mod $ver";
 234                                 }
 235                         }
 236                         for my $dep (@{$info->{conflicts}}) {
 237                                 $dep =~ /^(\S+)(?: (\S+))?/ or die "Bad dependency $dep from $info->{from}";
 238                                 my($depmod, $depvers) = ($1,$2);
 239                                 next unless $todo{$depmod} && ver_in_range($todo{$depmod}, $depvers);
 240                                 # if there are changes this round, maybe the conflict won't come up after they are resolved.
 241                                 $fail ||= "Cannot install: module $mod ($ver) conflicts with $depmod version $todo{$depmod}";
 242                         }
 243                 }
 244         }
 245         if ($trial) {
 246                 return !($changes || $fail);
 247         }
 248         if ($changes) {
 249                 print "Infinite dependency loop:$changes\n";
 250                 exit 1;
 251         }
 252         if ($fail) {
 253                 print "$fail\n";
 254                 exit 1;
 255         }
 256 }
 257
 258 command 'install', 'Install a third-party module', sub {
 259         for my $mod (@_) {
 260                 my $vers = $mod =~ s/=([-0-9.]+)// ? $1 : undef;
 261                 $mod = lc $mod;
 262                 unless ($modules{$mod}) {
 263                         print "Cannot find module $mod\n";
 264                         exit 1;
 265                 }
 266                 my $ver = find_mod_in_range($mod, $vers, $vers ? 1 : 0);
 267                 unless ($ver) {
 268                         print "Cannot find suitable version of $mod\n";
 269                         exit 1;
 270                 }
 271                 $todo{$mod} = $ver;
 272         }
 273 };
 274
 275 command 'upgrade', 'Upgrade a third-party module', sub {
 276         my @installed = sort keys %installed;
 277         for my $mod (@installed) {
 278                 next unless $mod =~ /^m_/;
 279                 my %saved = %todo;
 280                 $todo{$mod} = find_mod_in_range($mod);
 281                 if (!resolve_deps(1)) {
 282                         %todo = %saved;
 283                 }
 284         }
 285 };
 286
 287 command 'list', 'List available third-party modules', sub {
 288         my @all = sort keys %modules;
 289         for my $mod (@all) {
 290                 my @vers = sort { ver_cmp() } keys %{$modules{$mod}};
 291                 my $desc = '';
 292                 for my $ver (@vers) {
 293                         # latest defined description wins
 294                         $desc = $modules{$mod}{$ver}{description} || $desc;
 295                 }
 296                 next if @vers == 1 && $modules{$mod}{$vers[0]}{url} eq 'NONE';
 297                 my $instver = $installed{$mod} || '';
 298                 my $vers = join ' ', map { $_ eq $instver ? "\e[1m$_\e[m" : $_ } @vers;
 299                 print "$mod ($vers) - $desc\n";
 300         }
 301         exit 0;
 302 };
 303
 304 execute_command @ARGV;
 305
 306 resolve_deps(0);
 307
 308 $| = 1; # immediate print of lines without \n
 309
 310 print "Processing changes...\n";
 311 for my $mod (keys %installed) {
 312         next if $todo{$mod};
 313         print "Uninstalling $mod $installed{$mod}\n";
 314         unlink "src/modules/$mod.cpp";
 315 }
 316
 317 my $count = scalar keys %todo;
 318 print "Checking $count items...\n";
 319 for my $mod (sort keys %todo) {
 320         my $ver = $todo{$mod};
 321         my $oldver = $installed{$mod};
 322         if ($modules{$mod}{$ver}{mask}) {
 323                 print "Module $mod $ver is masked: $modules{$mod}{$ver}{mask}\n";
 324         }
 325         next if $oldver && $oldver eq $ver;
 326         my $url = $modules{$mod}{$ver}{url};
 327         if ($oldver) {
 328                 print "Upgrading $mod from $oldver to $ver using $url"
 329         } else {
 330                 print "Installing $mod $ver from $url";
 331         }
 332         $mod_versions{$mod} = $ver;
 333
 334         my $ua = LWP::UserAgent->new(ssl_opts => { verify_hostname => 0 });
 335         my $response = $ua->get($url);
 336
 337         if ($response->is_success) {
 338                 open(MF, ">src/modules/$mod.cpp") or die "\nFilesystem not writable: $!";
 339                 print MF $response->content;
 340                 close(MF);
 341                 print " - done\n";
 342         } else {
 343                 printf "\nHTTP %s: %s\n", $response->code, $response->message;
 344         }
 345 }
 346
 347 # write database of installed versions
 348 write_config_file '.modulemanager', %mod_versions;
 349
 350 print "Finished!\n";