software/rpm-lib.pl

   1 # rpm-lib.pl
   2 # Functions for redhat linux package management
   3
   4 sub list_package_system_commands
   5 {
   6 return ("rpm");
   7 }
   8
   9 # list_packages([package]*)
  10 # Fills the array %packages with all or listed packages
  11 sub list_packages
  12 {
  13 local($i, $list); $i = 0;
  14 $list = @_ ? join(' ', map { quotemeta($_) } @_) : "-a";
  15 %packages = ( );
  16 &open_execute_command(RPM, "rpm -q $list --queryformat \"%{NAME}\\n%{VERSION}-%{RELEASE}\\n%{EPOCH}\\n%{GROUP}\\n%{SUMMARY}\\n\\n\"", 1, 1);
  17 while($packages{$i,'name'} = <RPM>) {
  18         chop($packages{$i,'name'});
  19         chop($packages{$i,'version'} = <RPM>);
  20         chop($packages{$i,'epoch'} = <RPM>);
  21         $packages{$i,'epoch'} = undef if ($packages{$i,'epoch'} eq '(none)');
  22         chop($packages{$i,'class'} = <RPM>);
  23         while(<RPM>) {
  24                 s/\r|\n/ /g;
  25                 last if (!/\S/);
  26                 $packages{$i,'desc'} .= $_;
  27                 }
  28         if ($packages{$i,'name'} eq 'gpg-pubkey') {
  29                 # Bogus pseudo-package we don't want to include
  30                 $packages{$i,'desc'} = undef;
  31                 $i--;
  32                 }
  33         $i++;
  34         }
  35 close(RPM);
  36 return 0 if ($?);       # couldn't find the package
  37 return $i;
  38 }
  39
  40 # package_info(package, [version])
  41 # Returns an array of package information in the order
  42 #  name, class, description, arch, version, vendor, installtime
  43 sub package_info
  44 {
  45 local(@rv, @tmp, $d);
  46 local $n = $_[1] ? "$_[0]-$_[1]" : $_[0];
  47 &open_execute_command(RPM, "rpm -q $n --queryformat \"%{NAME}\\n%{GROUP}\\n%{ARCH}\\n%{VERSION}-%{RELEASE}\\n%{VENDOR}\\n%{INSTALLTIME}\\n\" 2>/dev/null", 1, 1);
  48 @tmp = <RPM>;
  49 chop(@tmp);
  50 local $ex = close(RPM);
  51 if (!@tmp || $tmp[0] =~ /not\s+installed/) { return (); }
  52 &open_execute_command(RPM, "rpm -q $n --queryformat \"%{DESCRIPTION}\"", 1, 1);
  53 while(<RPM>) { $d .= $_; }
  54 close(RPM);
  55 return ($tmp[0], $tmp[1], $d, $tmp[2], $tmp[3], $tmp[4], &make_date($tmp[5]));
  56 }
  57
  58 # is_package(file)
  59 # Check if some file is a package file
  60 sub is_package
  61 {
  62 local($out);
  63 local $real = &translate_filename($_[0]);
  64 if (-d $real) {
  65         # a directory .. see if it contains any .rpm files
  66         opendir(DIR, $real);
  67         local @list = grep { /\.rpm$/ } readdir(DIR);
  68         closedir(DIR);
  69         return @list ? 1 : 0;
  70         }
  71 elsif ($real =~ /\*|\?/) {
  72         # a wildcard .. see what it matches
  73         local @list = glob($real);
  74         return @list ? 1 : 0;
  75         }
  76 else {
  77         # just a normal file .. check if it is an RPM and not an SRPM
  78         local $qm = quotemeta($_[0]);
  79         $out = &backquote_command("rpm -q -p $qm 2>&1", 1);
  80         if ($out =~ /does not appear|No such file|with major numbers|not an rpm/i || $?) {
  81                 return 0;
  82                 }
  83         &open_execute_command(OUT, "rpm -q -p -l $qm 2>&1", 1, 1);
  84         while(<OUT>) {
  85                 return 0 if (/^([^\/\s]+)\.spec$/);
  86                 }
  87         close(OUT);
  88         return 1;
  89         }
  90 }
  91
  92 # file_packages(file)
  93 # Returns a list of all packages in the given file, in the form
  94 #  package-version description
  95 sub file_packages
  96 {
  97 local $real = &translate_filename($_[0]);
  98 local $qm = quotemeta($_[0]);
  99 if (-d $real) {
 100         local @rv;
 101         &open_execute_command(RPM, "cd $qm ; rpm -q -p *.rpm --queryformat \"%{NAME} %{SUMMARY}\\n\" 2>&1", 1, 1);
 102         while(<RPM>) {
 103                 chop;
 104                 push(@rv, $_) if (!/does not appear|query of.*failed|warning:/);
 105                 }
 106         close(RPM);
 107         return @rv;
 108         }
 109 elsif ($_[0] =~ /\*|\?/) {
 110         local @rv;
 111         &open_execute_command(RPM, "rpm -q -p $_[0] --queryformat \"%{NAME} %{SUMMARY}\\n\" 2>&1", 1);
 112         while(<RPM>) {
 113                 chop;
 114                 push(@rv, $_) if (!/does not appear|query of.*failed|warning:/);
 115                 }
 116         close(RPM);
 117         return @rv;
 118         }
 119 else {
 120         local($out);
 121         $out = &backquote_command("rpm -q -p $qm --queryformat \"%{NAME} %{SUMMARY}\\n\" 2>&1", 1);
 122         $out =~ s/warning:.*\n//;
 123         $out =~ s/\n//g;
 124         return ($out);
 125         }
 126 }
 127
 128 # install_options(file, package)
 129 # Outputs HTML for choosing install options for some package
 130 sub install_options
 131 {
 132 print &yesno_input($text{'rpm_upgrade'}, "upgrade", 1, 0, 1);
 133 print &yesno_input($text{'rpm_replacepkgs'}, "replacepkgs", 1, 0);
 134
 135 print &yesno_input($text{'rpm_nodeps'}, "nodeps", 1, 0);
 136 print &yesno_input($text{'rpm_oldpackage'}, "oldpackage", 1, 0);
 137
 138 print &yesno_input($text{'rpm_noscripts'}, "noscripts", 0, 1);
 139 print &yesno_input($text{'rpm_excludedocs'}, "excludedocs", 0, 1);
 140
 141 print &yesno_input($text{'rpm_notriggers'}, "notriggers", 0, 1);
 142 print &yesno_input($text{'rpm_ignoresize'}, "ignoresize", 0, 1);
 143
 144 print &yesno_input($text{'rpm_replacefiles'}, "replacefiles", 1, 0);
 145 print &ui_table_row(&hlink($text{'rpm_root'}, "root"),
 146                 &ui_textbox("root", "/", 50)." ".
 147                 &file_chooser_button("root", 1), 3);
 148 }
 149
 150 sub yesno_input
 151 {
 152 return &ui_table_row(&hlink($_[0], $_[1]),
 153                      &ui_radio($_[1], int($_[4]),
 154                                [ [ $_[2], $text{'yes'} ],
 155                                  [ $_[3], $text{'no'} ] ]));
 156 }
 157
 158 # install_package(file, package, [&inputs])
 159 # Install the given package from the given file, using options from %in
 160 sub install_package
 161 {
 162 local $file = $_[0];
 163 local $real = &translate_filename($file);
 164 local $in = $_[2] ? $_[2] : \%in;
 165 local $opts;
 166 foreach $o ('oldpackage', 'replacefiles', 'replacepkgs', 'noscripts',
 167             'excludedocs', 'nodeps', 'upgrade', 'notriggers', 'ignoresize') {
 168         if ($in->{$o}) { $opts .= " --$o"; }
 169         }
 170 if ($in->{'root'} =~ /^\/.+/) {
 171         if (!(-d $in{'root'})) {
 172                 return &text('rpm_eroot', $in->{'root'});
 173                 }
 174         $opts .= " --root $in->{'root'}";
 175         }
 176 if (-d $real) {
 177         # Find the package in the directory
 178         local ($f, $out);
 179         opendir(DIR, $real);
 180         while($f = readdir(DIR)) {
 181                 next if ($f !~ /\.rpm$/);
 182                 $out = &backquote_command("rpm -q -p $file/$f --queryformat \"%{NAME}\\n\" 2>&1", 1);
 183                 $out =~ s/warning:.*\n//;
 184                 $out =~ s/\n//;
 185                 if ($out eq $_[1]) {
 186                         $file = "$file/$f";
 187                         last;
 188                         }
 189                 }
 190         closedir(DIR);
 191         &error(&text('rpm_erpm', $_[1], $out)) if ($file eq $_[0]);
 192         }
 193 elsif ($file =~ /\*|\?/) {
 194         # Find the package in the glob
 195         # XXX won't work when translation is in effect
 196         local ($f, $out);
 197         foreach $f (glob($real)) {
 198                 $out = &backquote_command("rpm -q -p $f --queryformat \"%{NAME}\\n\" 2>&1", 1);
 199                 $out =~ s/warning:.*\n//;
 200                 $out =~ s/\n//;
 201                 if ($out eq $_[1]) {
 202                         $file = $f;
 203                         last;
 204                         }
 205                 }
 206         &error(&text('rpm_erpm', $_[1], $out)) if ($file eq $_[0]);
 207         }
 208 local $temp = &transname();
 209 local $rv = &system_logged("rpm -i $opts ".quotemeta($file)." >$temp 2>&1");
 210 local $out = &backquote_command("cat $temp");
 211 $out =~ s/warning:.*\n//;
 212 &unlink_file($temp);
 213 if ($rv) {
 214         return "<pre>$out</pre>";
 215         }
 216 return undef;
 217 }
 218
 219 # install_packages(file, [&inputs])
 220 # Installs all the packages in the given file or glob
 221 sub install_packages
 222 {
 223 local $file = $_[0];
 224 local $in = $_[1] ? $_[1] : \%in;
 225 local $opts;
 226 foreach $o ('oldpackage', 'replacefiles', 'replacepkgs', 'noscripts',
 227             'excludedocs', 'nodeps', 'upgrade', 'notriggers', 'ignoresize') {
 228         if ($in->{$o}) { $opts .= " --$o"; }
 229         }
 230 if ($in->{'root'} =~ /^\/.+/) {
 231         if (!(-d $in{'root'})) {
 232                 return &text('rpm_eroot', $in->{'root'});
 233                 }
 234         $opts .= " --root $in->{'root'}";
 235         }
 236 if (-d &translate_filename($file)) {
 237         # Install everything in a directory
 238         $file = "$file/*.rpm";
 239         }
 240 else {
 241         # Install packages matching a glob (no need for any special action)
 242         }
 243 local $temp = &transname();
 244 local $rv = &system_logged("rpm -i $opts $file >$temp 2>&1");
 245 local $out = &backquote_command("cat $temp");
 246 $out =~ s/warning:.*\n//;
 247 unlink($temp);
 248 if ($rv) {
 249         return "<pre>$out</pre>";
 250         }
 251 return undef;
 252 }
 253
 254 # check_files(package, version)
 255 # Fills in the %files array with information about the files belonging
 256 # to some package. Values in %files are  path type user group size error
 257 sub check_files
 258 {
 259 local($i, $_, @w, %errs, $epath); $i = 0;
 260 local $n = $_[1] ? "$_[0]-$_[1]" : $_[0];
 261 local $qn = quotemeta($n);
 262 &open_execute_command(RPM, "rpm -V $qn", 1, 1);
 263 while(<RPM>) {
 264         /^(.{8}) (.) (.*)$/;
 265         if ($1 eq "missing ") {
 266                 $errs{$3} = $text{'rpm_missing'};
 267                 }
 268         else {
 269                 $epath = $3;
 270                 @w = grep { $_ ne "." } split(//, $1);
 271                 $errs{$epath} =
 272                         join("\n", map { &text('rpm_checkfail', $etype{$_}) } @w);
 273                 }
 274         }
 275 close(RPM);
 276 &open_execute_command(RPM, "rpm -q $qn -l --dump", 1, 1);
 277 while(<RPM>) {
 278         chop;
 279         @w = split(/ /);
 280         $files{$i,'path'} = $w[0];
 281         if ($w[10] ne "X") { $files{$i,'link'} = $w[10]; }
 282         $files{$i,'type'} = $w[10] ne "X" ? 3 :
 283                             (-d &translate_filename($w[0])) ? 1 :
 284                             $w[7] ? 5 : 0;
 285         $files{$i,'user'} = $w[5];
 286         $files{$i,'group'} = $w[6];
 287         $files{$i,'size'} = $w[1];
 288         $files{$i,'error'} = $w[7] ? "" : $errs{$w[0]};
 289         $i++;
 290         }
 291 close(RPM);
 292 return $i;
 293 }
 294
 295 # package_files(package, [version])
 296 # Returns a list of all files in some package
 297 sub package_files
 298 {
 299 local ($pkg, $version) = @_;
 300 local $qn = quotemeta($version ? "$pkg-$version" : $pkg);
 301 local @rv;
 302 &open_execute_command(RPM, "rpm -q -l $qn", 1, 1);
 303 while(<RPM>) {
 304         s/\r|\n//g;
 305         push(@rv, $_);
 306         }
 307 close(RPM);
 308 return @rv;
 309 }
 310
 311 # installed_file(file)
 312 # Given a filename, fills %file with details of the given file and returns 1.
 313 # If the file is not known to the package system, returns 0
 314 # Usable values in %file are  path type user group mode size packages
 315 sub installed_file
 316 {
 317 local($pkg, @w, $_, @pkgs, @vers);
 318 undef(%file);
 319 local $qm = quotemeta($_[0]);
 320 $pkg = &backquote_command("rpm -q -f $qm --queryformat \"%{NAME}\\n\" 2>&1", 1);
 321 if ($pkg =~ /not owned/ || $?) { return 0; }
 322 @pkgs = split(/\n/, $pkg);
 323 $pkg = &backquote_command("rpm -q -f $qm --queryformat \"%{VERSION}-%{RELEASE}\\n\" 2>&1", 1);
 324 @vers = split(/\n/, $pkg);
 325 &open_execute_command(RPM, "rpm -q $pkgs[0] -l --dump", 1, 1);
 326 while(<RPM>) {
 327         chop;
 328         @w = split(/ /);
 329         if ($w[0] eq $_[0]) {
 330                 $file{'packages'} = join(' ', @pkgs);
 331                 $file{'versions'} = join(' ', @vers);
 332                 $file{'path'} = $w[0];
 333                 if ($w[10] ne "X") { $files{$i,'link'} = $w[10]; }
 334                 $file{'type'} = $w[10] ne "X" ? 3 :
 335                                 (-d &translate_filename($w[0])) ? 1 :
 336                                 $w[7] ? 5 : 0;
 337                 $file{'user'} = $w[5];
 338                 $file{'group'} = $w[6];
 339                 $file{'mode'} = substr($w[4], -4);
 340                 $file{'size'} = $w[1];
 341                 last;
 342                 }
 343         }
 344 close(RPM);
 345 return 1;
 346 }
 347
 348 # delete_options(package)
 349 # Outputs HTML for package uninstall options
 350 sub delete_options
 351 {
 352 print "<b>$text{'delete_nodeps'}</b>\n";
 353 print &ui_yesno_radio("nodeps", 0),"<br>\n";
 354
 355 print "<b>$text{'delete_noscripts'}</b>\n";
 356 print &ui_yesno_radio("noscripts", 0),"<br>\n";
 357 }
 358
 359 # delete_package(package, [&options], version)
 360 # Attempt to remove some package
 361 sub delete_package
 362 {
 363 local $opts;
 364 $opts .= $_[1]->{'nodeps'} ? "--nodeps " : "";
 365 $opts .= $_[1]->{'noscripts'} ? "--noscripts " : "";
 366 local $n = $_[2] ? "$_[0]-$_[2]" : $_[0];
 367 local $qm = quotemeta($n);
 368 local $out = &backquote_logged("rpm -e $opts $qm 2>&1");
 369 if ($? || $out =~ /error:/) { return "<pre>$out</pre>"; }
 370 return undef;
 371 }
 372
 373 # delete_packages(&packages, [&options], &versions)
 374 # Attempt to remove multiple packages at once
 375 sub delete_packages
 376 {
 377 local $opts;
 378 $opts .= $_[1]->{'nodeps'} ? "--nodeps " : "";
 379 $opts .= $_[1]->{'noscripts'} ? "--noscripts " : "";
 380 local $cmd = "rpm -e $opts";
 381 local $i;
 382 for($i=0; $i<@{$_[0]}; $i++) {
 383         if ($_[2]->[$i]) {
 384                 $cmd .= " ".quotemeta($_[0]->[$i]."-".$_[2]->[$i]);
 385                 }
 386         else {
 387                 $cmd .= " ".quotemeta($_[0]->[$i]);
 388                 }
 389         }
 390 local $out = &backquote_logged("$cmd 2>&1");
 391 if ($? || $out =~ /error:/) { return "<pre>$out</pre>"; }
 392 return undef;
 393 }
 394
 395 sub package_system
 396 {
 397 return "RPM";
 398 }
 399
 400 sub package_help
 401 {
 402 return "rpm";
 403 }
 404
 405 %etype = (      "5", $text{'rpm_md5'},  "S", $text{'rpm_fsize'},
 406                 "L", $text{'rpm_sym'},  "T", $text{'rpm_mtime'},
 407                 "D", $text{'rpm_dev'},  "U", $text{'rpm_user'},
 408                 "M", $text{'rpm_perm'}, "G", $text{'rpm_group'} );
 409
 410 $has_search_system = 1;
 411
 412 sub search_system_input
 413 {
 414 print "<input type=button onClick='window.ifield = document.forms[2].url; chooser = window.open(\"rpmfind.cgi\", \"chooser\", \"toolbar=no,menubar=no,scrollbars=yes,width=800,height=500\")' value=\"$text{'rpm_find'}\">";
 415 }
 416
 417 1;
 418