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.
 
 
 

633 lines
15 KiB

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