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

17 years ago
17 years ago
17 years ago
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616
  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. # Select enhancing tasks for install.
  468. my %provided;
  469. foreach my $task (grep { $_->{_install} && exists $_->{enhances} &&
  470. length $_->{enhances} } @tasks) {
  471. # If an enhancing task is already marked for
  472. # install, probably by preseeding, mark the tasks
  473. # it enhances for install.
  474. map { $_->{_install}=1 } list_to_tasks($task->{enhances}, @tasks);
  475. if (exists $task->{provides} && length $task->{provides}) {
  476. $provided{$task->{provides}}=1;
  477. }
  478. }
  479. foreach my $task (grep { ! $_->{_install} && exists $_->{enhances} &&
  480. length $_->{enhances} } @tasks) {
  481. # Mark enhancing tasks for install if their
  482. # dependencies are met and if their test fields
  483. # mark them for install.
  484. task_test($task, $options{"new-install"}, 0, 1);
  485. foreach my $dep (list_to_tasks($task->{enhances}, @tasks)) {
  486. if (! $dep->{_install}) {
  487. $task->{_install} = 0;
  488. }
  489. }
  490. # If two enhancing tasks that both provide
  491. # the same thing, only install one of them.
  492. if ($task->{_install} && exists $task->{provides} &&
  493. length $task->{provides}) {
  494. if (exists $provided{$task->{provides}}) {
  495. $task->{_install}=0;
  496. }
  497. $provided{$task->{provides}}=1;
  498. }
  499. }
  500. # Add tasks to install and see if any selected task requires manual
  501. # selection.
  502. my $manual_selection=0;
  503. foreach my $task (grep { $_->{_install} } @tasks) {
  504. push @tasks_install, $task;
  505. if ($task->{packages} eq 'manual') {
  506. $manual_selection=1;
  507. }
  508. }
  509. my @aptitude;
  510. if ($manual_selection) {
  511. # Manaul selection and task installs, as best
  512. # aptitude can do it currently. Disables use of
  513. # debconf-apt-progress.
  514. @aptitude="aptitude";
  515. }
  516. elsif (-x "/usr/bin/debconf-apt-progress") {
  517. @aptitude="debconf-apt-progress";
  518. push @aptitude, split(' ', $options{'debconf-apt-progress'})
  519. if exists $options{'debconf-apt-progress'};
  520. push @aptitude, qw{-- aptitude -q};
  521. }
  522. else {
  523. @aptitude="aptitude";
  524. }
  525. # Task removal..
  526. if (@tasks_remove) {
  527. my @packages_remove=map { task_packages($_, 0) } @tasks_remove;
  528. foreach my $task (@tasks_remove) {
  529. task_script($task->{task}, "prerm");
  530. }
  531. my $ret=run(@aptitude, "-y", "remove", @packages_remove);
  532. if ($ret != 0) {
  533. error gettext("aptitude failed")." ($ret)";
  534. }
  535. foreach my $task (@tasks_remove) {
  536. task_script($task->{task}, "postrm");
  537. }
  538. }
  539. # And finally, act on selected tasks.
  540. if (@tasks_install || $manual_selection) {
  541. my @packages_install=map {task_packages($_, 1) } @tasks_install;
  542. foreach my $task (@tasks_install) {
  543. task_script($task->{task}, "preinst");
  544. }
  545. # If the user selected no other tasks and manual package
  546. # selection, run aptitude w/o the --visual-preview parameter.
  547. if (! @packages_install && $manual_selection) {
  548. my $ret=run("aptitude");
  549. if ($ret != 0) {
  550. error gettext("aptitude failed")." ($ret)";
  551. }
  552. }
  553. else {
  554. if ($manual_selection) {
  555. unshift @packages_install, "--visual-preview";
  556. }
  557. my $ret=run(@aptitude, "--without-recommends",
  558. "-y", "install",
  559. @packages_install);
  560. if ($ret != 0) {
  561. error gettext("aptitude failed")." ($ret)";
  562. }
  563. }
  564. foreach my $task (@tasks_install) {
  565. task_script($task->{task}, "postinst");
  566. }
  567. }
  568. }
  569. main();