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.
 
 
 

949 lines
27 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. # This boolean indicates whether we are in dry-run (no-do) mode. More
  19. # specifically, it disables the actual running of commands by the
  20. # &run() function.
  21. my $testmode=0;
  22. my $taskpackageprefix="task-";
  23. sub warning {
  24. print STDERR "tasksel: @_\n";
  25. }
  26. sub error {
  27. print STDERR "tasksel: @_\n";
  28. exit 1;
  29. }
  30. # my $statuscode = &run("ls", "-l", "/tmp");
  31. # => 0
  32. # Run a shell command except in test mode, and returns its exit code.
  33. # Prints the command in test mode. Parameters should be pre-split for
  34. # system.
  35. sub run {
  36. if ($testmode) {
  37. print join(" ", @_)."\n";
  38. return 0;
  39. }
  40. else {
  41. return system(@_) >> 8;
  42. }
  43. }
  44. # my @paths = &list_task_descs();
  45. # => ("/path/to/debian-tasks.desc", "/some/other/taskfile.desc")
  46. # Get the list of desc files.
  47. sub list_task_descs {
  48. # Setting DEBIAN_TASKS_ONLY is a way for the Debian installer
  49. # to tell tasksel to only use the Debian tasks (from
  50. # tasksel-data).
  51. if ($ENV{DEBIAN_TASKS_ONLY}) {
  52. return glob("$descdir/debian-tasks.desc");
  53. }
  54. else {
  55. return glob("$descdir/*.desc"), glob("$localdescdir/*.desc");
  56. }
  57. }
  58. # &read_task_desc("/path/to/taskfile.desc");
  59. # => (
  60. # {
  61. # task => "gnome-desktop",
  62. # parent => "desktop",
  63. # relevance => 1,
  64. # key => [task-gnome-desktop"],
  65. # section => "user",
  66. # test-default-desktop => "3 gnome",
  67. # sortkey => 1desktop-01
  68. # },
  69. # ...
  70. # )
  71. # Returns a list of hashes; hash values are arrays for multi-line fields.
  72. sub read_task_desc {
  73. my $desc=shift;
  74. # %tasks maps the name of each task (the Task: field) to its
  75. # %%data information (that maps each key to value(s), see the
  76. # %"while" loop below).
  77. my %tasks;
  78. open (DESC, "<$desc") || die "Could not open $desc for reading: $!";
  79. local $/="\n\n";
  80. while (defined($_ = <DESC>)) {
  81. # %data will contain the keys/values of the current
  82. # stanza.
  83. #
  84. # The keys are stored lowercase.
  85. #
  86. # A single-line value is stored as a scalar "line1"; a
  87. # multi-line value is stored as a ref to array
  88. # ["line1", "line2"].
  89. #
  90. # $data{relevance} is set to 5 if not otherwise
  91. # specified in the stanza.
  92. my %data;
  93. my @lines=split("\n");
  94. while (@lines) {
  95. my $line=shift(@lines);
  96. if ($line=~/^([^ ]+):(?: (.*))?/) {
  97. my ($key, $value)=($1, $2);
  98. $key=lc($key);
  99. if (@lines && $lines[0] =~ /^\s+/) {
  100. # multi-line field
  101. my @values;
  102. # Ignore the first line if it is empty.
  103. if (defined $value && length $value) {
  104. push @values, $value;
  105. }
  106. while (@lines && $lines[0] =~ /^\s+(.*)/) {
  107. push @values, $1;
  108. shift @lines;
  109. }
  110. $data{$key}=[@values];
  111. }
  112. else {
  113. $data{$key}=$value;
  114. }
  115. }
  116. else {
  117. warning "$desc: in stanza $.: warning: parse error, ignoring line: $line";
  118. }
  119. }
  120. $data{relevance}=5 unless exists $data{relevance};
  121. if (exists $data{task}) {
  122. $tasks{$data{task}} = \%data;
  123. }
  124. }
  125. close DESC;
  126. my @ret;
  127. # In this loop, we simultaneously:
  128. #
  129. # - enrich the %data structures of all tasks with a
  130. # ->{sortkey} field
  131. #
  132. # - and collect them into @ret.
  133. foreach my $task (keys %tasks) {
  134. my $t=$tasks{$task};
  135. if (exists $t->{parent} && exists $tasks{$t->{parent}}) {
  136. # This task has a "Parent:" task. For example:
  137. #
  138. # Task: sometask
  139. # Relevance: 3
  140. # Parent: parenttask
  141. #
  142. # Task: parenttask
  143. # Relevance: 6
  144. #
  145. # In this case, we set the sortkey to "6parenttask-03".
  146. #
  147. # XXX TODO: support correct sorting when
  148. # Relevance is 10 or more (e.g. package
  149. # education-tasks).
  150. $t->{sortkey}=$tasks{$t->{parent}}->{relevance}.$t->{parent}."-0".$t->{relevance};
  151. }
  152. else {
  153. # This task has no "Parent:" task. For example:
  154. #
  155. # Task: sometask
  156. # Relevance: 3
  157. #
  158. # In this case, we set the sortkey to "3sometask-00".
  159. $t->{sortkey}=$t->{relevance}.$t->{task}."-00";
  160. }
  161. push @ret, $t;
  162. }
  163. return @ret;
  164. }
  165. # &all_tasks();
  166. # => (
  167. # {
  168. # task => "gnome-desktop",
  169. # parent => "desktop",
  170. # relevance => 1,
  171. # key => [task-gnome-desktop"],
  172. # section => "user",
  173. # test-default-desktop => "3 gnome",
  174. # sortkey => 1desktop-01
  175. # },
  176. # ...
  177. # )
  178. # Loads info for all tasks, and returns a set of task structures.
  179. sub all_tasks {
  180. my %seen;
  181. # Filter out duplicates: only the first occurrence of each
  182. # task name is taken into account.
  183. grep { $seen{$_->{task}}++; $seen{$_->{task}} < 2 }
  184. map { read_task_desc($_) } list_task_descs();
  185. }
  186. # my %apt_available = %_info_avail()
  187. # => (
  188. # "debian-policy" => { priority => "optional", section => "doc" },
  189. # ...
  190. # )
  191. #
  192. # Call "apt-cache dumpavail" and collect the output information about
  193. # package name, priority and section.
  194. sub _info_avail {
  195. my %ret = ();
  196. # Might be better to use the perl apt bindings, but they are not
  197. # currently in base.
  198. open (AVAIL, "apt-cache dumpavail|");
  199. local $_;
  200. my ($package, $section, $priority);
  201. while (<AVAIL>) {
  202. chomp;
  203. if (not $_) {
  204. # End of stanza
  205. if (defined $package && defined $priority && defined $section) {
  206. $ret{$package} = {
  207. "priority" => $priority,
  208. "section" => $section,
  209. };
  210. }
  211. }
  212. elsif (/^Package: (.*)/) {
  213. $package = $1;
  214. }
  215. elsif (/^Priority: (.*)/) {
  216. $priority = $1;
  217. }
  218. elsif (/^Section: (.*)/) {
  219. $section = $1;
  220. }
  221. }
  222. close AVAIL;
  223. return %ret;
  224. }
  225. # my @installed = &list_installed();
  226. # => ("emacs", "vim", ...)
  227. # Returns a list of all installed packages.
  228. # This is not memoised and will run dpkg-query at each invocation.
  229. # See &package_installed() for memoisation.
  230. sub list_installed {
  231. my @list;
  232. open (LIST, q{LANG=C dpkg-query -W -f='${Package} ${Status}\n' |});
  233. while (<LIST>) {
  234. # Each line looks like this:
  235. # "adduser install ok installed"
  236. if (/^([^ ]+) .* installed$/m) {
  237. push @list, $1;
  238. }
  239. }
  240. close LIST;
  241. return @list;
  242. }
  243. my %_info_avail_cache;
  244. # my $apt_available = &info_avail();
  245. # => {
  246. # "debian-policy" => { priority => "optional", section => "doc" },
  247. # ...
  248. # }
  249. # Returns a hash of all available packages. Memoised.
  250. sub info_avail {
  251. my $package = shift;
  252. if (!%_info_avail_cache) {
  253. %_info_avail_cache = _info_avail();
  254. }
  255. return \%_info_avail_cache;
  256. }
  257. # if (&package_avail("debian-policy")) { ... }
  258. # Given a package name, checks to see if it's installed or available.
  259. # Memoised.
  260. sub package_avail {
  261. my $package = shift;
  262. return info_avail()->{$package} || package_installed($package);
  263. }
  264. # Memoisation for &package_installed().
  265. my %installed_pkgs;
  266. # if (&package_installed("debian-policy")) { ... }
  267. # Given a package name, checks to see if it's installed. Memoised.
  268. sub package_installed {
  269. my $package=shift;
  270. if (! %installed_pkgs) {
  271. foreach my $pkg (list_installed()) {
  272. $installed_pkgs{$pkg} = 1;
  273. }
  274. }
  275. return $installed_pkgs{$package};
  276. }
  277. # if (&task_avail($task)) { ... }
  278. # Given a task hash, checks that all of its key packages are installed or available.
  279. # Returns true if all key packages are installed or available.
  280. # Returns false if any of the key packages is not.
  281. sub task_avail {
  282. local $_;
  283. my $task=shift;
  284. if (! ref $task->{key}) {
  285. return 1;
  286. }
  287. else {
  288. foreach my $pkg (@{$task->{key}}) {
  289. if (! package_avail($pkg)) {
  290. return 0;
  291. }
  292. }
  293. return 1;
  294. }
  295. }
  296. # if (&task_installed($task)) { ... }
  297. # Given a task hash, checks to see if it is already installed.
  298. # All of its key packages must be installed. Other packages are not checked.
  299. sub task_installed {
  300. local $_;
  301. my $task=shift;
  302. if (! ref $task->{key}) {
  303. return 0; # can't tell with no key packages
  304. }
  305. else {
  306. foreach my $pkg (@{$task->{key}}) {
  307. if (! package_installed($pkg)) {
  308. return 0;
  309. }
  310. }
  311. return 1;
  312. }
  313. }
  314. # my @packages = &task_packages($task);
  315. # Given a task hash, returns a list of all available packages in the task.
  316. #
  317. # It is the list of "Key:" packages, plus the packages indicated
  318. # through the "Packages:" field.
  319. sub task_packages {
  320. my $task=shift;
  321. # The %list hashtable is used as a set: only its keys matter,
  322. # the value is irrelevant.
  323. my %list;
  324. # "Key:" packages are always included.
  325. if (ref $task->{key}) {
  326. # $task->{key} is not a line but a reference (to an
  327. # array of lines).
  328. map { $list{$_}=1 } @{$task->{key}};
  329. }
  330. if (! defined $task->{packages}) {
  331. # No "Packages:" field.
  332. # only key
  333. }
  334. elsif ($task->{packages} eq 'standard') {
  335. # Special case of "Packages: standard"
  336. #
  337. # The standard packages are the non-library ones in
  338. # "main" which priority is required, important or
  339. # standard.
  340. #
  341. # We add all standard packages to %list, except the
  342. # ones that are already installed.
  343. my %info_avail=%{info_avail()};
  344. while (my ($package, $info) = each(%info_avail)) {
  345. my ($priority, $section) = ($info->{priority}, $info->{section});
  346. if (($priority eq 'required' ||
  347. $priority eq 'important' ||
  348. $priority eq 'standard') &&
  349. # Exclude packages in non-main and library sections
  350. $section !~ /^lib|\// &&
  351. # Exclude already installed packages
  352. !package_installed($package)) {
  353. $list{$package} = 1;
  354. }
  355. }
  356. }
  357. else {
  358. # external method
  359. my ($method, @params);
  360. # "Packages:" requests to run a program and use its
  361. # output as the names of packages.
  362. #
  363. # There are basically two forms:
  364. #
  365. # Packages: myprogram
  366. #
  367. # Runs /usr/lib/tasksel/packages/myprogram TASKNAME
  368. #
  369. # Packages: myprogram
  370. # arg1
  371. # arg2...
  372. #
  373. # Runs /usr/lib/tasksel/packages/myprogram TASKNAME arg1 arg2...
  374. #
  375. # The tasksel package provides the simple "list"
  376. # program which simply outputs its arguments.
  377. if (ref $task->{packages}) {
  378. @params=@{$task->{packages}};
  379. $method=shift @params;
  380. }
  381. else {
  382. $method=$task->{packages};
  383. }
  384. map { $list{$_}=1 }
  385. grep { package_avail($_) }
  386. split(' ', `$packagesdir/$method $task->{task} @params`);
  387. }
  388. return keys %list;
  389. }
  390. # &task_test($task, $new_install, $display_by_default, $install_by_default);
  391. # Given a task hash, runs any test program specified in its data, and sets
  392. # the _display and _install fields to 1 or 0 depending on its result.
  393. #
  394. # If _display is true, _install means the default proposal shown to
  395. # the user, who can modify it. If _display is false, _install says
  396. # what to do, without asking the user.
  397. sub task_test {
  398. my $task=shift;
  399. my $new_install=shift;
  400. $task->{_display} = shift; # default
  401. $task->{_install} = shift; # default
  402. $ENV{NEW_INSTALL}=$new_install if defined $new_install;
  403. # Each task may define one or more tests in the form:
  404. #
  405. # Test-PROGRAM: ARGUMENTS...
  406. #
  407. # Each of the programs will be run like this:
  408. #
  409. # /usr/lib/tasksel/tests/PROGRAM TASKNAME ARGUMENTS...
  410. #
  411. # If $new_install is true, the NEW_INSTALL environment
  412. # variable is set for invoking the program.
  413. #
  414. # The return code of the invocation then indicates what to set:
  415. #
  416. # 0 - don't display, but install it
  417. # 1 - don't display, don't install
  418. # 2 - display, mark for installation
  419. # 3 - display, don't mark for installation
  420. # anything else - don't change the values of _display or _install
  421. foreach my $test (grep /^test-.*/, keys %$task) {
  422. $test=~s/^test-//;
  423. if (-x "$testdir/$test") {
  424. my $ret=system("$testdir/$test", $task->{task}, split " ", $task->{"test-$test"}) >> 8;
  425. if ($ret == 0) {
  426. $task->{_display} = 0;
  427. $task->{_install} = 1;
  428. }
  429. elsif ($ret == 1) {
  430. $task->{_display} = 0;
  431. $task->{_install} = 0;
  432. }
  433. elsif ($ret == 2) {
  434. $task->{_display} = 1;
  435. $task->{_install} = 1;
  436. }
  437. elsif ($ret == 3) {
  438. $task->{_display} = 1;
  439. $task->{_install} = 0;
  440. }
  441. }
  442. }
  443. delete $ENV{NEW_INSTALL};
  444. return $task;
  445. }
  446. # &hide_enhancing_tasks($task);
  447. #
  448. # Hides a task and marks it not to be installed if it enhances other
  449. # tasks.
  450. #
  451. # Returns $task.
  452. sub hide_enhancing_tasks {
  453. my $task=shift;
  454. if (exists $task->{enhances} && length $task->{enhances}) {
  455. $task->{_display} = 0;
  456. $task->{_install} = 0;
  457. }
  458. return $task;
  459. }
  460. # &getdescriptions(@tasks);
  461. #
  462. # Looks up the descriptions of a set of tasks, returning a new list
  463. # with the ->{shortdesc} fields filled in.
  464. #
  465. # Ideally, the .desc file would indicate a description of each task,
  466. # which would be retrieved quickly. For missing Description fields,
  467. # we fetch the data with "apt-cache show task-TASKNAME...", which
  468. # takes longer.
  469. #
  470. # @tasks: list of references, each referencing a task data structure.
  471. #
  472. # Each data structured is enriched with a ->{shortdesc} field,
  473. # containing the localized short description.
  474. #
  475. # Returns @tasks.
  476. sub getdescriptions {
  477. my @tasks=@_;
  478. # If the task has a description field in the task desc file,
  479. # just use it, looking up a translation in gettext.
  480. @tasks = map {
  481. if (defined $_->{description}) {
  482. $_->{shortdesc}=dgettext("debian-tasks", $_->{description}->[0]);
  483. }
  484. $_;
  485. } @tasks;
  486. # Otherwise, a more expensive apt-cache query is done,
  487. # to use the descriptions of task packages.
  488. my @todo = grep { ! defined $_->{shortdesc} } @tasks;
  489. if (@todo) {
  490. open(APT_CACHE, "apt-cache show ".join(" ", map { $taskpackageprefix.$_->{task} } @todo)." |") || die "apt-cache show: $!";
  491. local $/="\n\n";
  492. while (defined($_ = <APT_CACHE>)) {
  493. my ($name)=/^Package: $taskpackageprefix(.*)$/m;
  494. my ($description)=/^Description-(?:[a-z][a-z](?:_[A-Z][A-Z])?): (.*)$/m;
  495. ($description)=/^Description: (.*)$/m
  496. unless defined $description;
  497. if (defined $name && defined $description) {
  498. @tasks = map {
  499. if ($_->{task} eq $name) {
  500. $_->{shortdesc}=$description;
  501. }
  502. $_;
  503. } @tasks;
  504. }
  505. }
  506. close APT_CACHE;
  507. }
  508. return @tasks;
  509. }
  510. # &task_to_debconf(@tasks);
  511. # => "task1, task2, task3"
  512. # Converts a list of tasks into a debconf list of the task short
  513. # descriptions.
  514. sub task_to_debconf {
  515. join ", ", map { format_description_for_debconf($_) } getdescriptions(@_);
  516. }
  517. # my $debconf_string = &format_description_for_debconf($task);
  518. # => "... GNOME"
  519. # Build a string for making a debconf menu item.
  520. # If the task has a parent task, "... " is prepended.
  521. sub format_description_for_debconf {
  522. my $task=shift;
  523. my $d=$task->{shortdesc};
  524. $d=~s/,/\\,/g;
  525. $d="... ".$d if exists $task->{parent};
  526. return $d;
  527. }
  528. # my $debconf_string = &task_to_debconf_C(@tasks);
  529. # => "gnome-desktop, kde-desktop"
  530. # Converts a list of tasks into a debconf list of the task names.
  531. sub task_to_debconf_C {
  532. join ", ", map { $_->{task} } @_;
  533. }
  534. # my @my_tasks = &list_to_tasks("task1, task2, task3", @tasks);
  535. # => ($task1, $task2, $task3)
  536. # Given a first parameter that is a string listing task names, and then a
  537. # list of task hashes, returns a list of hashes for all the tasks
  538. # in the list.
  539. sub list_to_tasks {
  540. my $list=shift;
  541. my %lookup = map { $_->{task} => $_ } @_;
  542. return grep { defined } map { $lookup{$_} } split /[, ]+/, $list;
  543. }
  544. # my @sorted_tasks = &order_for_display(@tasks);
  545. # Orders a list of tasks for display.
  546. # The tasks are ordered according to the ->{sortkey}.
  547. sub order_for_display {
  548. sort {
  549. $a->{sortkey} cmp $b->{sortkey}
  550. || 0 ||
  551. $a->{task} cmp $b->{task}
  552. } @_;
  553. }
  554. # &name_to_task($taskname, &all_tasks());
  555. # &name_to_task("gnome-desktop", &all_tasks());
  556. # => {
  557. # task => "gnome-desktop",
  558. # parent => "desktop",
  559. # relevance => 1,
  560. # key => [task-gnome-desktop"],
  561. # section => "user",
  562. # test-default-desktop => "3 gnome",
  563. # sortkey => 1desktop-01
  564. # }
  565. # Given a set of tasks and a name, returns the one with that name.
  566. sub name_to_task {
  567. my $name=shift;
  568. return (grep { $_->{task} eq $name } @_)[0];
  569. }
  570. # &task_script($task, "preinst") or die;
  571. # Run the task's (pre|post)(inst|rm) script, if there is any.
  572. # Such scripts are located under /usr/lib/tasksel/info/.
  573. sub task_script {
  574. my $task=shift;
  575. my $script=shift;
  576. my $path="$infodir/$task.$script";
  577. if (-e $path && -x _) {
  578. my $ret=run($path);
  579. if ($ret != 0) {
  580. warning("$path exited with nonzero code $ret");
  581. return 0;
  582. }
  583. }
  584. return 1;
  585. }
  586. # &usage;
  587. # Print the usage.
  588. sub usage {
  589. print STDERR gettext(q{tasksel [OPTIONS...] [COMMAND...]
  590. Commands:
  591. install TASK... install tasks
  592. remove TASK... uninstall tasks
  593. --task-packages=TASK list packages installed by TASK; can be repeated
  594. --task-desc=TASK print the description of a task
  595. --list-tasks list tasks that would be displayed and exit
  596. Options:
  597. -t, --test dry-run: don't really change anything
  598. --new-install automatically install some tasks
  599. --debconf-apt-progress="ARGUMENTS..."
  600. provide additional arguments to debconf-apt-progress(1)
  601. });
  602. }
  603. # Process command line options and return them in a hash.
  604. sub getopts {
  605. my %ret;
  606. Getopt::Long::Configure ("bundling");
  607. if (! GetOptions(\%ret, "test|t", "new-install", "list-tasks",
  608. "task-packages=s@", "task-desc=s",
  609. "debconf-apt-progress=s")) {
  610. usage();
  611. exit(1);
  612. }
  613. # Special case apt-like syntax.
  614. if (@ARGV) {
  615. my $cmd = shift @ARGV;
  616. if ($cmd eq "install") {
  617. $ret{cmd_install} = \@ARGV;
  618. }
  619. elsif ($cmd eq "remove") {
  620. $ret{cmd_remove} = \@ARGV;
  621. }
  622. else {
  623. usage();
  624. exit 1;
  625. }
  626. }
  627. $testmode=1 if $ret{test}; # set global
  628. return %ret;
  629. }
  630. # &interactive($options, @tasks);
  631. # Ask the user and mark tasks to install or remove accordingly.
  632. # The tasks are enriched with ->{_install} or ->{_remove} set to true accordingly.
  633. sub interactive {
  634. my $options = shift;
  635. my @tasks = @_;
  636. if (! $options->{"new-install"}) {
  637. # Don't install hidden tasks if this is not a new install.
  638. map { $_->{_install} = 0 } grep { $_->{_display} == 0 } @tasks;
  639. }
  640. my @list = order_for_display(grep { $_->{_display} == 1 } @tasks);
  641. if (@list) {
  642. if (! $options->{"new-install"}) {
  643. # Find tasks that are already installed.
  644. map { $_->{_installed} = task_installed($_) } @list;
  645. # Don't install new tasks unless manually selected.
  646. map { $_->{_install} = 0 } @list;
  647. }
  648. else {
  649. # Assume that no tasks are installed, to ensure
  650. # that complete tasks get installed on new
  651. # installs.
  652. map { $_->{_installed} = 0 } @list;
  653. }
  654. my $question="tasksel/tasks";
  655. if ($options->{"new-install"}) {
  656. $question="tasksel/first";
  657. }
  658. my @default = grep { $_->{_display} == 1 && ($_->{_install} == 1 || $_->{_installed} == 1) } @tasks;
  659. my $tmpfile=`mktemp`;
  660. chomp $tmpfile;
  661. my $ret=system($debconf_helper, $tmpfile,
  662. task_to_debconf_C(@list),
  663. task_to_debconf(@list),
  664. task_to_debconf_C(@default),
  665. $question) >> 8;
  666. if ($ret == 30) {
  667. exit 10; # back up
  668. }
  669. elsif ($ret != 0) {
  670. error "debconf failed to run";
  671. }
  672. open(IN, "<$tmpfile");
  673. $ret=<IN>;
  674. if (! defined $ret) {
  675. die "tasksel canceled\n";
  676. }
  677. chomp $ret;
  678. close IN;
  679. unlink $tmpfile;
  680. # Set _install flags based on user selection.
  681. map { $_->{_install} = 0 } @list;
  682. foreach my $task (list_to_tasks($ret, @tasks)) {
  683. if (! $task->{_installed}) {
  684. $task->{_install} = 1;
  685. }
  686. $task->{_selected} = 1;
  687. }
  688. foreach my $task (@list) {
  689. if (! $task->{_selected} && $task->{_installed}) {
  690. $task->{_remove} = 1;
  691. }
  692. }
  693. }
  694. # When a $task Enhances: a @group_of_tasks, it means that
  695. # $task can only be installed if @group_of_tasks are also
  696. # installed; and if @group_of_tasks is installed, it is an
  697. # incentive to also install $task.
  698. #
  699. # For example, consider this task:
  700. #
  701. # Task: amharic-desktop
  702. # Enhances: desktop, amharic
  703. #
  704. # The task amharic-desktop installs packages that make
  705. # particular sense if the user wants both a desktop and the
  706. # amharic language environment. Conversely, if
  707. # amharic-desktop is selected (e.g. by preseeding), then it
  708. # automatically also selects tasks "desktop" and "amharic".
  709. # If an enhancing task is already marked for
  710. # install, probably by preseeding, mark the tasks
  711. # it enhances for install.
  712. foreach my $task (grep { $_->{_install} && exists $_->{enhances} &&
  713. length $_->{enhances} } @tasks) {
  714. map { $_->{_install}=1 } list_to_tasks($task->{enhances}, @tasks);
  715. }
  716. # Select enhancing tasks for install.
  717. # XXX FIXME ugly hack -- loop until enhances settle to handle
  718. # chained enhances. This is ugly and could loop forever if
  719. # there's a cycle.
  720. my $enhances_needswork=1;
  721. # %tested is the memoization of the below calls to
  722. # %&task_test().
  723. my %tested;
  724. # Loop as long as there is work to do.
  725. while ($enhances_needswork) {
  726. $enhances_needswork=0;
  727. # Loop over all unselected tasks that enhance one or
  728. # more things.
  729. foreach my $task (grep { ! $_->{_install} && exists $_->{enhances} &&
  730. length $_->{enhances} } @tasks) {
  731. # TODO: the computation of %tasknames could be
  732. # done once and for all outside of this nested
  733. # loop, saving some redundant work.
  734. my %tasknames = map { $_->{task} => $_ } @tasks;
  735. # @deps is the list of tasks enhanced by $task.
  736. #
  737. # Basically, if all the deps are installed,
  738. # and tests say that $task can be installed,
  739. # then mark it to install. Otherwise, don't
  740. # install it.
  741. my @deps=map { $tasknames{$_} } split ", ", $task->{enhances};
  742. if (grep { ! defined $_ } @deps) {
  743. # task enhances an unavailable or
  744. # uninstallable task
  745. next;
  746. }
  747. if (@deps) {
  748. # FIXME: isn't $orig_state always
  749. # false, given that the "for" loop
  750. # above keeps only $tasks that do
  751. # not have $_->{_install}?
  752. my $orig_state=$task->{_install};
  753. # Mark enhancing tasks for install if their
  754. # dependencies are met and their test fields
  755. # mark them for install.
  756. if (! exists $tested{$task->{task}}) {
  757. $ENV{TESTING_ENHANCER}=1;
  758. task_test($task, $options->{"new-install"}, 0, 1);
  759. delete $ENV{TESTING_ENHANCER};
  760. $tested{$task->{task}}=$task->{_install};
  761. }
  762. else {
  763. $task->{_install}=$tested{$task->{task}};
  764. }
  765. foreach my $dep (@deps) {
  766. if (! $dep->{_install}) {
  767. $task->{_install} = 0;
  768. }
  769. }
  770. if ($task->{_install} != $orig_state) {
  771. # We have made progress:
  772. # continue another round.
  773. $enhances_needswork=1;
  774. }
  775. }
  776. }
  777. }
  778. }
  779. sub main {
  780. my %options=getopts();
  781. my @tasks_remove;
  782. my @tasks_install;
  783. # Options that output stuff and don't need a full processed list of
  784. # tasks.
  785. if (exists $options{"task-packages"}) {
  786. my @tasks=all_tasks();
  787. foreach my $taskname (@{$options{"task-packages"}}) {
  788. my $task=name_to_task($taskname, @tasks);
  789. if ($task) {
  790. print "$_\n" foreach task_packages($task);
  791. }
  792. }
  793. exit(0);
  794. }
  795. elsif ($options{"task-desc"}) {
  796. my $task=name_to_task($options{"task-desc"}, all_tasks());
  797. if ($task) {
  798. # The Description looks like this:
  799. #
  800. # Description: one-line short description
  801. # Longer description,
  802. # possibly spanning
  803. # multiple lines.
  804. #
  805. # $extdesc will contain the long description,
  806. # reformatted to one line.
  807. my $extdesc=join(" ", @{$task->{description}}[1..$#{$task->{description}}]);
  808. print dgettext("debian-tasks", $extdesc)."\n";
  809. exit(0);
  810. }
  811. else {
  812. fprintf STDERR ("Task %s has no description\n", $options{"task-desc"});
  813. exit(1);
  814. }
  815. }
  816. # This is relatively expensive, get the full list of available tasks and
  817. # mark them.
  818. my @tasks=map { hide_enhancing_tasks($_) } map { task_test($_, $options{"new-install"}, 1, 0) }
  819. grep { task_avail($_) } all_tasks();
  820. if ($options{"list-tasks"}) {
  821. map { $_->{_installed} = task_installed($_) } @tasks;
  822. @tasks=getdescriptions(@tasks);
  823. # TODO: use printf() instead of print for correct column alignment
  824. print "".($_->{_installed} ? "i" : "u")." ".$_->{task}."\t".$_->{shortdesc}."\n"
  825. foreach order_for_display(grep { $_->{_display} } @tasks);
  826. exit(0);
  827. }
  828. if ($options{cmd_install}) {
  829. @tasks_install = map { name_to_task($_, @tasks) } @{$options{cmd_install}};
  830. }
  831. elsif ($options{cmd_remove}) {
  832. @tasks_remove = map { name_to_task($_, @tasks) } @{$options{cmd_remove}};
  833. }
  834. else {
  835. interactive(\%options, @tasks);
  836. # Add tasks to install
  837. @tasks_install = grep { $_->{_install} } @tasks;
  838. # Add tasks to remove
  839. @tasks_remove = grep { $_->{_remove} } @tasks;
  840. }
  841. my @cmd;
  842. if (-x "/usr/bin/debconf-apt-progress") {
  843. @cmd = "debconf-apt-progress";
  844. push @cmd, split(' ', $options{'debconf-apt-progress'})
  845. if exists $options{'debconf-apt-progress'};
  846. push @cmd, "--";
  847. }
  848. push @cmd, qw{apt-get -q -y -o APT::Install-Recommends=true -o APT::Get::AutomaticRemove=true -o Acquire::Retries=3 install};
  849. # And finally, act on selected tasks.
  850. if (@tasks_install || @tasks_remove) {
  851. foreach my $task (@tasks_remove) {
  852. push @cmd, map { "$_-" } task_packages($task);
  853. task_script($task->{task}, "prerm");
  854. }
  855. foreach my $task (@tasks_install) {
  856. push @cmd, task_packages($task);
  857. task_script($task->{task}, "preinst");
  858. }
  859. my $ret=run(@cmd);
  860. if ($ret != 0) {
  861. error gettext("apt-get failed")." ($ret)";
  862. }
  863. foreach my $task (@tasks_remove) {
  864. task_script($task->{task}, "postrm");
  865. }
  866. foreach my $task (@tasks_install) {
  867. task_script($task->{task}, "postinst");
  868. }
  869. }
  870. }
  871. main();