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.
 
 
 

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