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.
 
 
 

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