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.
 
 
 

648 lines
16 KiB

  1. #!/usr/bin/perl
  2. # Debian task selector, mark II.
  3. # Copyright 2004-2011 by Joey Hess <joeyh@debian.org>.
  4. # Licensed under the GPL, version 2 or higher.
  5. use 5.014;
  6. use Locale::gettext;
  7. use Getopt::Long;
  8. use warnings;
  9. use strict;
  10. textdomain('tasksel');
  11. my $debconf_helper="/usr/lib/tasksel/tasksel-debconf";
  12. my $testdir="/usr/lib/tasksel/tests";
  13. my $packagesdir="/usr/lib/tasksel/packages";
  14. my $descdir="/usr/share/tasksel/descs";
  15. my $localdescdir="/usr/local/share/tasksel/descs";
  16. my $statusfile="/var/lib/dpkg/status";
  17. my $infodir="/usr/lib/tasksel/info";
  18. my $testmode=0;
  19. my $taskpackageprefix="task-";
  20. sub warning {
  21. print STDERR "tasksel: @_\n";
  22. }
  23. sub error {
  24. print STDERR "tasksel: @_\n";
  25. exit 1;
  26. }
  27. # Run a shell command except in test mode, and returns its exit code.
  28. # Prints the command in test mode. Parameters should be pre-split for
  29. # system.
  30. sub run {
  31. if ($testmode) {
  32. print join(" ", @_)."\n";
  33. return 0;
  34. }
  35. else {
  36. return system(@_) >> 8;
  37. }
  38. }
  39. # A list of all available task desc files.
  40. sub list_task_descs {
  41. return glob("$descdir/*.desc"), glob("$localdescdir/*.desc");
  42. }
  43. # Returns a list of hashes; hash values are arrays for multi-line fields.
  44. sub read_task_desc {
  45. my $desc=shift;
  46. my @ret;
  47. open (DESC, "<$desc") || die "read $desc\: $!";
  48. local $/="\n\n";
  49. while (<DESC>) {
  50. my %data;
  51. my @lines=split("\n");
  52. while (@lines) {
  53. my $line=shift(@lines);
  54. if ($line=~/^([^ ]+):(?: (.*))?/) {
  55. my ($key, $value)=($1, $2);
  56. $key=lc($key);
  57. if (@lines && $lines[0] =~ /^\s+/) {
  58. # multi-line field
  59. my @values;
  60. if (defined $value && length $value) {
  61. push @values, $value;
  62. }
  63. while (@lines && $lines[0] =~ /^\s+(.*)/) {
  64. push @values, $1;
  65. shift @lines;
  66. }
  67. $data{$key}=[@values];
  68. }
  69. else {
  70. $data{$key}=$value;
  71. }
  72. }
  73. else {
  74. warning "parse error in stanza $. of $desc";
  75. }
  76. }
  77. if (%data) {
  78. $data{relevance}=5 unless exists $data{relevance};
  79. push @ret, \%data;
  80. }
  81. }
  82. close DESC;
  83. return @ret;
  84. }
  85. # Loads info for all tasks, and returns a set of task structures.
  86. sub all_tasks {
  87. my %seen;
  88. grep { $seen{$_->{task}}++; $seen{$_->{task}} < 2 }
  89. map { read_task_desc($_) } list_task_descs();
  90. }
  91. sub _info_avail {
  92. my %ret = ();
  93. # Might be better to use the perl apt bindings, but they are not
  94. # currently in base.
  95. open (AVAIL, "apt-cache dumpavail|");
  96. local $_;
  97. my ($package, $section, $priority);
  98. while (<AVAIL>) {
  99. chomp;
  100. if (not $_) {
  101. if (defined $package && defined $priority && defined $section) {
  102. $ret{$package} = {
  103. "priority" => $priority,
  104. "section" => $section,
  105. };
  106. }
  107. }
  108. elsif (/^Package: (.*)/) {
  109. $package = $1;
  110. }
  111. elsif (/^Priority: (.*)/) {
  112. $priority = $1;
  113. }
  114. elsif (/^Section: (.*)/) {
  115. $section = $1;
  116. }
  117. }
  118. close AVAIL;
  119. return %ret;
  120. }
  121. # Returns a list of all installed packages.
  122. sub list_installed {
  123. my @list;
  124. open (LIST, q{LANG=C dpkg-query -W -f='${Package} ${Status}\n' |});
  125. while (<LIST>) {
  126. if (/^([^ ]+) .* installed$/m) {
  127. push @list, $1;
  128. }
  129. }
  130. close LIST;
  131. return @list;
  132. }
  133. my %_info_avail_cache;
  134. # Returns a hash of all available packages.
  135. sub info_avail {
  136. my $package = shift;
  137. if (!%_info_avail_cache) {
  138. %_info_avail_cache = _info_avail();
  139. }
  140. return \%_info_avail_cache;
  141. }
  142. # Given a package name, checks to see if it's available. Memoised.
  143. sub package_avail {
  144. my $package = shift;
  145. return info_avail()->{$package} || package_installed($package);
  146. }
  147. my %installed_pkgs;
  148. # Given a package name, checks to see if it's installed. Memoised.
  149. sub package_installed {
  150. my $package=shift;
  151. if (! %installed_pkgs) {
  152. foreach my $pkg (list_installed()) {
  153. $installed_pkgs{$pkg} = 1;
  154. }
  155. }
  156. return $installed_pkgs{$package};
  157. }
  158. # Given a task hash, checks if its key packages are available.
  159. sub task_avail {
  160. local $_;
  161. my $task=shift;
  162. if (! ref $task->{key}) {
  163. return 1;
  164. }
  165. else {
  166. foreach my $pkg (@{$task->{key}}) {
  167. if (! package_avail($pkg)) {
  168. return 0;
  169. }
  170. }
  171. return 1;
  172. }
  173. }
  174. # Given a task hash, checks to see if it is already installed.
  175. # (All of its key packages must be installed.)
  176. sub task_installed {
  177. local $_;
  178. my $task=shift;
  179. if (! ref $task->{key}) {
  180. return 0; # can't tell with no key packages
  181. }
  182. else {
  183. foreach my $pkg (@{$task->{key}}) {
  184. if (! package_installed($pkg)) {
  185. return 0;
  186. }
  187. }
  188. return 1;
  189. }
  190. }
  191. # Given task hash, returns a list of all available packages in the task.
  192. sub task_packages {
  193. my $task=shift;
  194. my %list;
  195. # key packages are always included
  196. if (ref $task->{key}) {
  197. map { $list{$_}=1 } @{$task->{key}};
  198. }
  199. if (! defined $task->{packages}) {
  200. # only key
  201. }
  202. elsif ($task->{packages} eq 'standard') {
  203. while (my ($package, $info) = each(info_avail())) {
  204. my ($priority, $section) = ($info->{priority}, $info->{section});
  205. if (($priority eq 'required' ||
  206. $priority eq 'important' ||
  207. $priority eq 'standard') &&
  208. # Exclude packages in non-main and library sections
  209. $section !~ /^lib|\// &&
  210. # Exclude already installed packages
  211. !package_installed($package)) {
  212. $list{$package} = 1;
  213. }
  214. }
  215. }
  216. else {
  217. # external method
  218. my ($method, @params);
  219. if (ref $task->{packages}) {
  220. @params=@{$task->{packages}};
  221. $method=shift @params;
  222. }
  223. else {
  224. $method=$task->{packages};
  225. }
  226. map { $list{$_}=1 }
  227. grep { package_avail($_) }
  228. split(' ', `$packagesdir/$method $task->{task} @params`);
  229. }
  230. return keys %list;
  231. }
  232. # Given a task hash, runs any test program specified in its data, and sets
  233. # the _display and _install fields to 1 or 0 depending on its result.
  234. sub task_test {
  235. my $task=shift;
  236. my $new_install=shift;
  237. $task->{_display} = shift; # default
  238. $task->{_install} = shift; # default
  239. $ENV{NEW_INSTALL}=$new_install if defined $new_install;
  240. foreach my $test (grep /^test-.*/, keys %$task) {
  241. $test=~s/^test-//;
  242. if (-x "$testdir/$test") {
  243. my $ret=system("$testdir/$test", $task->{task}, split " ", $task->{"test-$test"}) >> 8;
  244. if ($ret == 0) {
  245. $task->{_display} = 0;
  246. $task->{_install} = 1;
  247. }
  248. elsif ($ret == 1) {
  249. $task->{_display} = 0;
  250. $task->{_install} = 0;
  251. }
  252. elsif ($ret == 2) {
  253. $task->{_display} = 1;
  254. $task->{_install} = 1;
  255. }
  256. elsif ($ret == 3) {
  257. $task->{_display} = 1;
  258. $task->{_install} = 0;
  259. }
  260. }
  261. }
  262. delete $ENV{NEW_INSTALL};
  263. return $task;
  264. }
  265. # Hides a task and marks it not to be installed if it enhances other
  266. # tasks.
  267. sub hide_enhancing_tasks {
  268. my $task=shift;
  269. if (exists $task->{enhances} && length $task->{enhances}) {
  270. $task->{_display} = 0;
  271. $task->{_install} = 0;
  272. }
  273. return $task;
  274. }
  275. # Looks up the descriptions of a set of tasks, returning a new list
  276. # with the shortdesc fields filled in.
  277. sub getdescriptions {
  278. my @tasks=@_;
  279. # If the task has a description field in the task desc file,
  280. # just use it, looking up a translation in gettext.
  281. @tasks = map {
  282. if (defined $_->{description}) {
  283. $_->{shortdesc}=dgettext("debian-tasks", $_->{description}->[0]);
  284. }
  285. $_;
  286. } @tasks;
  287. # Otherwise, a more expensive apt-cache query is done,
  288. # to use the descriptions of task packages.
  289. my @todo = grep { ! defined $_->{shortdesc} } @tasks;
  290. if (@todo) {
  291. open(APT_CACHE, "apt-cache show ".join(" ", map { $taskpackageprefix.$_->{task} } @todo)." |") || die "apt-cache show: $!";
  292. local $/="\n\n";
  293. while (<APT_CACHE>) {
  294. my ($name)=/^Package: $taskpackageprefix(.*)$/m;
  295. my ($description)=/^Description-(?:[a-z][a-z](?:_[A-Z][A-Z])?): (.*)$/m;
  296. ($description)=/^Description: (.*)$/m
  297. unless defined $description;
  298. if (defined $name && defined $description) {
  299. @tasks = map {
  300. if ($_->{task} eq $name) {
  301. $_->{shortdesc}=$description;
  302. }
  303. $_;
  304. } @tasks;
  305. }
  306. }
  307. close APT_CACHE;
  308. }
  309. return @tasks;
  310. }
  311. # Converts a list of tasks into a debconf list of the task short
  312. # descriptions.
  313. sub task_to_debconf {
  314. join ", ", map { my $d=$_->{shortdesc}; $d=~s/,/\\,/g; $d } getdescriptions(@_);
  315. }
  316. # Converts a list of tasks into a debconf list of the task names.
  317. sub task_to_debconf_C {
  318. join ", ", map { $_->{task} } @_;
  319. }
  320. # Given a first parameter that is a string listing task names, and then a
  321. # list of task hashes, returns a list of hashes for all the tasks
  322. # in the list.
  323. sub list_to_tasks {
  324. my $list=shift;
  325. my %lookup = map { $_->{task} => $_ } @_;
  326. return grep { defined } map { $lookup{$_} } split /[, ]+/, $list;
  327. }
  328. # Orders a list of tasks for display.
  329. sub order_for_display {
  330. sort {
  331. $b->{relevance} <=> $a->{relevance}
  332. || 0 ||
  333. $a->{section} cmp $b->{section}
  334. || 0 ||
  335. $a->{task} cmp $b->{task}
  336. } @_;
  337. }
  338. # Given a set of tasks and a name, returns the one with that name.
  339. sub name_to_task {
  340. my $name=shift;
  341. return (grep { $_->{task} eq $name } @_)[0];
  342. }
  343. sub task_script {
  344. my $task=shift;
  345. my $script=shift;
  346. my $path="$infodir/$task.$script";
  347. if (-e $path && -x _) {
  348. my $ret=run($path);
  349. if ($ret != 0) {
  350. warning("$path exited with nonzero code $ret");
  351. return 0;
  352. }
  353. }
  354. return 1;
  355. }
  356. sub usage {
  357. print STDERR gettext(q{Usage:
  358. tasksel install <task>...
  359. tasksel remove <task>...
  360. tasksel [options]
  361. -t, --test test mode; don't really do anything
  362. --new-install automatically install some tasks
  363. --list-tasks list tasks that would be displayed and exit
  364. --task-packages list available packages in a task
  365. --task-desc returns the description of a task
  366. });
  367. }
  368. # Process command line options and return them in a hash.
  369. sub getopts {
  370. my %ret;
  371. Getopt::Long::Configure ("bundling");
  372. if (! GetOptions(\%ret, "test|t", "new-install", "list-tasks",
  373. "task-packages=s@", "task-desc=s",
  374. "debconf-apt-progress=s")) {
  375. usage();
  376. exit(1);
  377. }
  378. # Special case apt-like syntax.
  379. if (@ARGV) {
  380. my $cmd = shift @ARGV;
  381. if ($cmd eq "install") {
  382. $ret{cmd_install} = \@ARGV;
  383. }
  384. elsif ($cmd eq "remove") {
  385. $ret{cmd_remove} = \@ARGV;
  386. }
  387. else {
  388. usage();
  389. exit 1;
  390. }
  391. }
  392. $testmode=1 if $ret{test}; # set global
  393. return %ret;
  394. }
  395. sub interactive {
  396. my $options = shift;
  397. my @tasks = @_;
  398. if (! $options->{"new-install"}) {
  399. # Don't install hidden tasks if this is not a new install.
  400. map { $_->{_install} = 0 } grep { $_->{_display} == 0 } @tasks;
  401. }
  402. my @list = order_for_display(grep { $_->{_display} == 1 } @tasks);
  403. if (@list) {
  404. if (! $options->{"new-install"}) {
  405. # Find tasks that are already installed.
  406. map { $_->{_installed} = task_installed($_) } @list;
  407. # Don't install new tasks unless manually selected.
  408. map { $_->{_install} = 0 } @list;
  409. }
  410. else {
  411. # Assume that no tasks are installed, to ensure
  412. # that complete tasks get installed on new
  413. # installs.
  414. map { $_->{_installed} = 0 } @list;
  415. }
  416. my $question="tasksel/tasks";
  417. if ($options->{"new-install"}) {
  418. $question="tasksel/first";
  419. }
  420. my @default = grep { $_->{_display} == 1 && ($_->{_install} == 1 || $_->{_installed} == 1) } @tasks;
  421. my $tmpfile=`tempfile`;
  422. chomp $tmpfile;
  423. my $ret=system($debconf_helper, $tmpfile,
  424. task_to_debconf_C(@list),
  425. task_to_debconf(@list),
  426. task_to_debconf_C(@default),
  427. $question) >> 8;
  428. if ($ret == 30) {
  429. exit 10; # back up
  430. }
  431. elsif ($ret != 0) {
  432. error "debconf failed to run";
  433. }
  434. open(IN, "<$tmpfile");
  435. $ret=<IN>;
  436. if (! defined $ret) {
  437. die "tasksel canceled\n";
  438. }
  439. chomp $ret;
  440. close IN;
  441. unlink $tmpfile;
  442. # Set _install flags based on user selection.
  443. map { $_->{_install} = 0 } @list;
  444. foreach my $task (list_to_tasks($ret, @tasks)) {
  445. if (! $task->{_installed}) {
  446. $task->{_install} = 1;
  447. }
  448. $task->{_selected} = 1;
  449. }
  450. foreach my $task (@list) {
  451. if (! $task->{_selected} && $task->{_installed}) {
  452. $task->{_remove} = 1;
  453. }
  454. }
  455. }
  456. # If an enhancing task is already marked for
  457. # install, probably by preseeding, mark the tasks
  458. # it enhances for install.
  459. foreach my $task (grep { $_->{_install} && exists $_->{enhances} &&
  460. length $_->{enhances} } @tasks) {
  461. map { $_->{_install}=1 } list_to_tasks($task->{enhances}, @tasks);
  462. }
  463. # Select enhancing tasks for install.
  464. # XXX FIXME ugly hack -- loop until enhances settle to handle
  465. # chained enhances. This is ugly and could loop forever if
  466. # there's a cycle.
  467. my $enhances_needswork=1;
  468. my %tested;
  469. while ($enhances_needswork) {
  470. $enhances_needswork=0;
  471. foreach my $task (grep { ! $_->{_install} && exists $_->{enhances} &&
  472. length $_->{enhances} } @tasks) {
  473. my %tasknames = map { $_->{task} => $_ } @tasks;
  474. my @deps=map { $tasknames{$_} } split ", ", $task->{enhances};
  475. if (grep { ! defined $_ } @deps) {
  476. # task enhances an unavailable or
  477. # uninstallable task
  478. next;
  479. }
  480. if (@deps) {
  481. my $orig_state=$task->{_install};
  482. # Mark enhancing tasks for install if their
  483. # dependencies are met and their test fields
  484. # mark them for install.
  485. if (! exists $tested{$task->{task}}) {
  486. $ENV{TESTING_ENHANCER}=1;
  487. task_test($task, $options->{"new-install"}, 0, 1);
  488. delete $ENV{TESTING_ENHANCER};
  489. $tested{$task->{task}}=$task->{_install};
  490. }
  491. else {
  492. $task->{_install}=$tested{$task->{task}};
  493. }
  494. foreach my $dep (@deps) {
  495. if (! $dep->{_install}) {
  496. $task->{_install} = 0;
  497. }
  498. }
  499. if ($task->{_install} != $orig_state) {
  500. $enhances_needswork=1;
  501. }
  502. }
  503. }
  504. }
  505. }
  506. sub main {
  507. my %options=getopts();
  508. my @tasks_remove;
  509. my @tasks_install;
  510. # Options that output stuff and don't need a full processed list of
  511. # tasks.
  512. if (exists $options{"task-packages"}) {
  513. my @tasks=all_tasks();
  514. foreach my $taskname (@{$options{"task-packages"}}) {
  515. my $task=name_to_task($taskname, @tasks);
  516. if ($task) {
  517. print "$_\n" foreach task_packages($task);
  518. }
  519. }
  520. exit(0);
  521. }
  522. elsif ($options{"task-desc"}) {
  523. my $task=name_to_task($options{"task-desc"}, all_tasks());
  524. if ($task) {
  525. my $extdesc=join(" ", @{$task->{description}}[1..$#{$task->{description}}]);
  526. print dgettext("debian-tasks", $extdesc)."\n";
  527. exit(0);
  528. }
  529. else {
  530. exit(1);
  531. }
  532. }
  533. # This is relatively expensive, get the full list of available tasks and
  534. # mark them.
  535. my @tasks=map { hide_enhancing_tasks($_) } map { task_test($_, $options{"new-install"}, 1, 0) }
  536. grep { task_avail($_) } all_tasks();
  537. if ($options{"list-tasks"}) {
  538. map { $_->{_installed} = task_installed($_) } @tasks;
  539. @tasks=getdescriptions(@tasks);
  540. print "".($_->{_installed} ? "i" : "u")." ".$_->{task}."\t".$_->{shortdesc}."\n"
  541. foreach order_for_display(grep { $_->{_display} } @tasks);
  542. exit(0);
  543. }
  544. if ($options{cmd_install}) {
  545. @tasks_install = map { name_to_task($_, @tasks) } @{$options{cmd_install}};
  546. }
  547. elsif ($options{cmd_remove}) {
  548. @tasks_remove = map { name_to_task($_, @tasks) } @{$options{cmd_remove}};
  549. }
  550. else {
  551. interactive(\%options, @tasks);
  552. # Add tasks to install
  553. @tasks_install = grep { $_->{_install} } @tasks;
  554. # Add tasks to remove
  555. @tasks_remove = grep { $_->{_remove} } @tasks;
  556. }
  557. my @cmd;
  558. if (-x "/usr/bin/debconf-apt-progress") {
  559. @cmd = "debconf-apt-progress";
  560. push @cmd, split(' ', $options{'debconf-apt-progress'})
  561. if exists $options{'debconf-apt-progress'};
  562. push @cmd, "--";
  563. }
  564. push @cmd, qw{apt-get -q -y -o APT::Install-Recommends=true -o APT::Get::AutomaticRemove=true install};
  565. # And finally, act on selected tasks.
  566. if (@tasks_install || @tasks_remove) {
  567. foreach my $task (@tasks_remove) {
  568. push @cmd, map { "$_-" } task_packages($task);
  569. task_script($task->{task}, "prerm");
  570. }
  571. foreach my $task (@tasks_install) {
  572. push @cmd, task_packages($task);
  573. task_script($task->{task}, "preinst");
  574. }
  575. my $ret=run(@cmd);
  576. if ($ret != 0) {
  577. error gettext("apt-get failed")." ($ret)";
  578. }
  579. foreach my $task (@tasks_remove) {
  580. task_script($task->{task}, "postrm");
  581. }
  582. foreach my $task (@tasks_install) {
  583. task_script($task->{task}, "postinst");
  584. }
  585. }
  586. }
  587. main();