software/rpm-lib.pl.bak

   1 # rpm-lib.pl
   2 # Functions for redhat linux package management
   3
   4 # list_packages([package]*)
   5 # Fills the array %packages with all or listed packages
   6 sub list_packages
   7 {
   8 local($i, $list); $i = 0;
   9 $list = @_ ? join(' ', @_) : "-a";
  10 open(RPM, "rpm -q $list --queryformat \"%{NAME}\\n%{VERSION}\\n%{GROUP}\\n%{SUMMARY}\\n\\n\" |");
  11 while($packages{$i,'name'} = <RPM>) {
  12         chop($packages{$i,'name'});
  13         chop($packages{$i,'version'} = <RPM>);
  14         chop($packages{$i,'class'} = <RPM>);
  15         while(<RPM>) {
  16                 s/\r|\n/ /g;
  17                 last if (!/\S/);
  18                 $packages{$i,'desc'} .= $_;
  19                 }
  20         $i++;
  21         }
  22 close(RPM);
  23 return $i;
  24 }
  25
  26 # package_info(package)
  27 # Returns an array of package information in the order
  28 #  name, class, description, arch, version, vendor, installtime
  29 sub package_info
  30 {
  31 local(@rv, @tmp, $d);
  32 open(RPM, "rpm -q $_[0] --queryformat \"%{NAME}\\n%{GROUP}\\n%{ARCH}\\n%{VERSION}\\n%{VENDOR}\\n%{INSTALLTIME}\\n\" 2>/dev/null |");
  33 @tmp = <RPM>;
  34 chop(@tmp);
  35 if (!@tmp) { return (); }
  36 close(RPM);
  37 open(RPM, "rpm -q $_[0] --queryformat \"%{DESCRIPTION}\" |");
  38 while(<RPM>) { $d .= $_; }
  39 close(RPM);
  40 return ($tmp[0], $tmp[1], $d, $tmp[2], $tmp[3], $tmp[4], &make_date($tmp[5]));
  41 }
  42
  43 # is_package(file)
  44 # Check if some file is a package file
  45 sub is_package
  46 {
  47 local($out);
  48 if (-d $_[0]) {
  49         # a directory .. see if it contains any .rpm files
  50         opendir(DIR, $_[0]);
  51         local @list = grep { /\.rpm$/ } readdir(DIR);
  52         closedir(DIR);
  53         return @list ? 1 : 0;
  54         }
  55 else {
  56         # just a normal file
  57         $out = `rpm -q -p $_[0] 2>&1`;
  58         return $out !~ /does not appear|No such file/;
  59         }
  60 }
  61
  62 # file_packages(file)
  63 # Returns a list of all packages in the given file, in the form
  64 #  package description
  65 sub file_packages
  66 {
  67 if (-d $_[0]) {
  68         local @rv;
  69         open(RPM, "cd $_[0] ; rpm -q -p *.rpm --queryformat \"%{NAME} %{SUMMARY}\\n\" 2>&1 |");
  70         while(<RPM>) {
  71                 chop;
  72                 push(@rv, $_) if (!/does not appear|query of.*failed/);
  73                 }
  74         close(RPM);
  75         return @rv;
  76         }
  77 else {
  78         local($out);
  79         $out = `rpm -q -p $_[0] --queryformat "%{NAME} %{SUMMARY}" 2>&1`;
  80         return ($out);
  81         }
  82 }
  83
  84 $wide_install_options = 1;
  85
  86 # install_options(file, package)
  87 # Outputs HTML for choosing install options for some package
  88 sub install_options
  89 {
  90 print "<tr>\n";
  91 print &yesno_input($text{'rpm_upgrade'}, "upgrade", 1, 0, 1);
  92 print &yesno_input($text{'rpm_replacepkgs'}, "replacepkgs", 1, 0);
  93 print "</tr>\n";
  94
  95 print "<tr>\n";
  96 print &yesno_input($text{'rpm_nodeps'}, "nodeps", 1, 0);
  97 print &yesno_input($text{'rpm_oldpackage'}, "oldpackage", 1, 0);
  98 print "</tr>\n";
  99
 100 print "<tr>\n";
 101 print &yesno_input($text{'rpm_noscripts'}, "noscripts", 0, 1);
 102 print &yesno_input($text{'rpm_excludedocs'}, "excludedocs", 0, 1);
 103 print "</tr>\n";
 104
 105 print "<tr>\n";
 106 print &yesno_input($text{'rpm_replacefiles'}, "replacefiles", 1, 0);
 107 print "<td align=right>",&hlink("<b>$text{'rpm_root'}</b>","root"),"</td>\n";
 108 print "<td><input name=root size=25 value=\"/\">\n";
 109 print &file_chooser_button("root", 1),"</td> </tr>\n";
 110 }
 111
 112 sub yesno_input
 113 {
 114 local $cy = $_[2] ^ $_[4] ? "" : "checked";
 115 local $cn = $_[3] ^ $_[4] ? "" : "checked";
 116 return  "<td align=right>".&hlink("<b>$_[0]</b>", $_[1])."</td> <td>\n".
 117         "<input type=radio name=$_[1] value=$_[2] $cy> $text{'yes'}\n".
 118         "<input type=radio name=$_[1] value=$_[3] $cn> $text{'no'}</td>\n";
 119 }
 120
 121 # install_package(file, package, [&inputs])
 122 # Install the given package from the given file, using options from %in
 123 sub install_package
 124 {
 125 local $file = $_[0];
 126 local $in = $_[2] ? $_[2] : \%in;
 127 foreach $o ('oldpackage', 'replacefiles', 'replacepkgs', 'noscripts',
 128             'excludedocs', 'nodeps', 'upgrade') {
 129         if ($in->{$o}) { $opts .= " --$o"; }
 130         }
 131 if ($in->{'root'} =~ /^\/.+/) {
 132         if (!(-d $in{'root'})) {
 133                 return &text('rpm_eroot', $in->{'root'});
 134                 }
 135         $opts .= " --root $in->{'root'}";
 136         }
 137 if (-d $file) {
 138         # Find the package in the directory
 139         local ($f, $out);
 140         opendir(DIR, $file);
 141         while($f = readdir(DIR)) {
 142                 next if ($f !~ /\.rpm$/);
 143                 ($out = `rpm -q -p $file/$f --queryformat '%{NAME}' 2>&1`) =~ s/\r|\n//g;
 144                 if ($out eq $_[1]) {
 145                         $file = "$file/$f";
 146                         last;
 147                         }
 148                 }
 149         closedir(DIR);
 150         &error(&text('rpm_erpm', $_[1], $out)) if ($file eq $_[0]);
 151         }
 152 local $temp = &tempname();
 153 local $rv = &system_logged("rpm -i $opts $file >$temp 2>&1");
 154 local $out = `cat $temp`;
 155 unlink($temp);
 156 if ($rv) {
 157         return "<pre>$out</pre>";
 158         }
 159 return undef;
 160 }
 161
 162 # check_files(package)
 163 # Fills in the %files array with information about the files belonging
 164 # to some package. Values in %files are  path type user group size error
 165 sub check_files
 166 {
 167 local($i, $_, @w, %errs, $epath); $i = 0;
 168 open(RPM, "rpm -V $_[0] |");
 169 while(<RPM>) {
 170         /^(.{8}) (.) (.*)$/;
 171         if ($1 eq "missing ") {
 172                 $errs{$3} = $text{'rpm_missing'};
 173                 }
 174         else {
 175                 $epath = $3;
 176                 @w = grep { $_ ne "." } split(//, $1);
 177                 $errs{$epath} =
 178                         join("\n", map { &text('rpm_checkfail', $etype{$_}) } @w);
 179                 }
 180         }
 181 close(RPM);
 182 open(RPM, "rpm -q $_[0] -l --dump |");
 183 while(<RPM>) {
 184         chop;
 185         @w = split(/ /);
 186         $files{$i,'path'} = $w[0];
 187         if ($w[10] ne "X") { $files{$i,'link'} = $w[10]; }
 188         $files{$i,'type'} = $w[10] ne "X" ? 3 :
 189                             (-d $w[0]) ? 1 :
 190                             $w[7] ? 5 : 0;
 191         $files{$i,'user'} = $w[5];
 192         $files{$i,'group'} = $w[6];
 193         $files{$i,'size'} = $w[1];
 194         $files{$i,'error'} = $w[7] ? "" : $errs{$w[0]};
 195         $i++;
 196         }
 197 close(RPM);
 198 return $i;
 199 }
 200
 201 # installed_file(file)
 202 # Given a filename, fills %file with details of the given file and returns 1.
 203 # If the file is not known to the package system, returns 0
 204 # Usable values in %file are  path type user group mode size packages
 205 sub installed_file
 206 {
 207 local($pkg, @w, $_);
 208 undef(%file);
 209 $pkg = `rpm -q -f $_[0] --queryformat "%{NAME}\\n" 2>&1`;
 210 if ($pkg =~ /not owned/ || $?) { return 0; }
 211 @pkgs = split(/\n/, $pkg);
 212 open(RPM, "rpm -q $pkgs[0] -l --dump |");
 213 while(<RPM>) {
 214         chop;
 215         @w = split(/ /);
 216         if ($w[0] eq $_[0]) {
 217                 $file{'packages'} = join(' ', @pkgs);
 218                 $file{'path'} = $w[0];
 219                 if ($w[10] ne "X") { $files{$i,'link'} = $w[10]; }
 220                 $file{'type'} = $w[10] ne "X" ? 3 :
 221                                 (-d $w[0]) ? 1 :
 222                                 $w[7] ? 5 : 0;
 223                 $file{'user'} = $w[5];
 224                 $file{'group'} = $w[6];
 225                 $file{'mode'} = substr($w[4], -4);
 226                 $file{'size'} = $w[1];
 227                 last;
 228                 }
 229         }
 230 close(RPM);
 231 return 1;
 232 }
 233
 234 # delete_package(package)
 235 # Attempt to remove some package
 236 sub delete_package
 237 {
 238 $out = &backquote_logged("rpm -e $_[0] 2>&1");
 239 if ($out) { return "<pre>$out</pre>"; }
 240 return undef;
 241 }
 242
 243 sub package_system
 244 {
 245 return "RPM";
 246 }
 247
 248 sub package_help
 249 {
 250 return "rpm";
 251 }
 252
 253 %etype = (      "5", $text{'rpm_md5'},  "S", $text{'rpm_fsize'},
 254                 "L", $text{'rpm_sym'},  "T", $text{'rpm_mtime'},
 255                 "D", $text{'rpm_dev'},  "U", $text{'rpm_user'},
 256                 "M", $text{'rpm_perm'}, "G", $text{'rpm_group'} );
 257
 258 1;
 259