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.

tasksel.pl 15 KiB

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