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.
 
 
 

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