modulemanager 8.8 KB

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