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