OVERdrive-IRC patches for InspIRCd
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

modulemanager 9.5KB

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