software/emerge-lib.pl

   1 # emerge-lib.pl
   2 # Functions for gentoo package management
   3
   4 chop($system_arch = `uname -m`);
   5 $pkg_dir = "/var/db/pkg";
   6 $portage_bin = "/usr/lib/portage/bin";
   7 $ENV{'TERM'} = "dumb";
   8 $package_list_binary = $package_list_command = "$portage_bin/pkglist";
   9 if (!-x $package_list_binary) {
  10         $package_list_binary = &has_command("qlist");
  11         $package_list_command = $package_list_binary." --nocolor -Iv";
  12         }
  13
  14 sub list_package_system_commands
  15 {
  16 return ( $package_list_binary || "pkglist" );
  17 }
  18
  19 sub list_update_system_commands
  20 {
  21 return ("emerge");
  22 }
  23
  24 # list_packages([package]*)
  25 # Fills the array %packages with all or listed packages
  26 sub list_packages
  27 {
  28 local $i = 0;
  29 %packages = ( );
  30 &open_execute_command(LIST, $package_list_command, 1, 1);
  31 while(<LIST>) {
  32         if (/^([^\/]+)\/([^0-9]+)-(\d\S+)$/ &&
  33             !@_ || &indexof($2, @_) >= 0) {
  34                 $packages{$i,'name'} = $2;
  35                 $packages{$i,'class'} = $1;
  36                 $packages{$i,'version'} = $3;
  37                 &open_readfile(BUILD, "$pkg_dir/$1/$2-$3/$2-$3.ebuild");
  38                 while(<BUILD>) {
  39                         if (/DESCRIPTION="([^"]+)"/ || /DESCRIPTION='([^']+)'/) {
  40                                 $packages{$i,'desc'} = $1;
  41                                 last;
  42                                 }
  43                         }
  44                 close(BUILD);
  45                 $i++;
  46                 }
  47         }
  48 return $i;
  49 }
  50
  51 # package_search(string, [allavailable])
  52 # Searches the package database for packages matching some string and puts
  53 # them into %packages
  54 sub package_search
  55 {
  56 local $n = 0;
  57 local $qm = quotemeta($_[0]);
  58 &open_execute_command(SEARCH, "emerge search $qm", 1, 1);
  59 while(<SEARCH>) {
  60         s/\r|\n//g;
  61         s/\033[^m]+m//g;
  62         if (/^\*\s+([^\/]+)\/(\S+)/) {
  63                 $packages{$n,'name'} = $2;
  64                 $packages{$n,'class'} = $1;
  65                 $packages{$n,'missing'} = 0;
  66                 }
  67         elsif (/version\s+Available:\s+(\S+)/i) {
  68                 $packages{$n,'version'} = $1;
  69                 }
  70         elsif (/version\s+Installed:\s+\[\s+Not/i && !$_[1]) {
  71                 $packages{$n,'missing'} = 1;
  72                 }
  73         elsif (/\s+Description:\s*(.*)/i) {
  74                 $packages{$n,'desc'} = $1;
  75                 local $nl = <SEARCH>;
  76                 chop($nl);
  77                 if ($nl =~ /\S/) {
  78                         $packages{$n,'desc'} .= " " if ($packages{$n,'desc'});
  79                         $packages{$n,'desc'} .= $nl;
  80                         }
  81                 $n++ if (!$packages{$n,'missing'} || $_[1]);
  82                 }
  83         }
  84 close(SEARCH);
  85 return $n;
  86 }
  87
  88 # package_info(package)
  89 # Returns an array of package information in the order
  90 #  name, class, description, arch, version, vendor, installtime
  91 sub package_info
  92 {
  93 local %packages;
  94 local $n = &list_packages($_[0]);
  95 $n || return ();
  96 local @st = stat("$pkg_dir/$packages{0,'class'}/$packages{0,'name'}-$packages{0,'version'}");
  97 return ( $packages{0,'name'}, $packages{0,'class'}, $packages{0,'desc'},
  98          $system_arch, $packages{0,'version'}, "Gentoo", &make_date($st[9]) );
  99 }
 100
 101 # is_package(file)
 102 # Check if some file is a package file
 103 sub is_package
 104 {
 105 local $qm = quotemeta($_[0]);
 106 local $out = &backquote_command("emerge --pretend $qm 2>&1", 1);
 107 return $? ? 0 : 1;
 108 }
 109
 110 # file_packages(file)
 111 # Returns a list of all packages in the given file, in the form
 112 #  package description
 113 sub file_packages
 114 {
 115 local @rv;
 116 local $qm = quotemeta($_[0]);
 117 &open_execute_command(EMERGE, "emerge --pretend $qm", 1, 1);
 118 while(<EMERGE>) {
 119         s/\r|\n//g;
 120         s/\033[^m]+m//g;
 121         if (/\s+[NRU]\s+\]\s+([^\/]+)\/([^0-9]+)\-(\d\S+)/) {
 122                 push(@rv, $2);
 123                 }
 124         }
 125 close(EMERGE);
 126 return @rv;
 127 }
 128
 129 # install_options(file, package)
 130 # Outputs HTML for choosing install options for some package
 131 sub install_options
 132 {
 133 print &ui_table_row($text{'emerge_noreplace'},
 134         &ui_radio("noreplace", 0, [ [ 0, $text{'yes'} ], [ 1, $text{'no'} ] ]));
 135
 136 print &ui_table_row($text{'emerge_onlydeps'},
 137         &ui_yesno_radio("onlydeps", 0));
 138 }
 139
 140 $show_install_progress = 1;
 141
 142 # install_package(file, package, [&inputs], [show])
 143 # Install the given package from the given file, using options from %in
 144 sub install_package
 145 {
 146 local $file = $_[0];
 147 local $in = $_[2] ? $_[2] : \%in;
 148 local $cmd = "emerge";
 149 $cmd .= " --noreplace" if ($in{'noreplace'});
 150 $cmd .= " --onlydeps" if ($in{'onlydeps'});
 151 $cmd .= " ".quotemeta($_[1]);
 152 if ($_[3]) {
 153         &open_execute_command(OUT, "$cmd 2>&1", 1);
 154         while(<OUT>) {
 155                 print &html_escape($_);
 156                 }
 157         close(OUT);
 158         return $? ? "Emerge error" : undef;
 159         }
 160 else {
 161         local $out;
 162         &open_execute_command(OUT, "$cmd 2>&1 | tail -10", 1);
 163         while(<OUT>) {
 164                 $out .= $_;
 165                 }
 166         close(OUT);
 167         return $? ? "<pre>$out</pre>" : undef;
 168         }
 169 }
 170
 171 # check_files(package)
 172 # Fills in the %files array with information about the files belonging
 173 # to some package. Values in %files are  path type user group size error
 174 sub check_files
 175 {
 176 local $i = 0;
 177 local (@files, %filesmap);
 178 local %packages;
 179 &list_packages($_[0]);
 180 &open_readfile(CONTENTS, "$pkg_dir/$packages{0,'class'}/$packages{0,'name'}-$packages{0,'version'}/CONTENTS");
 181 while(<CONTENTS>) {
 182         s/\r|\n//g;
 183         local @l = split(/\s+/);
 184         $files{$i,'path'} = $l[1];
 185         $files{$i,'type'} = $l[0] eq 'dir' ? 1 :
 186                             $l[0] eq 'sym' ? 3 : 0;
 187         local $real = &translate_filename($l[1]);
 188         local @st = stat($real);
 189         $files{$i,'user'} = getpwuid($st[4]);
 190         $files{$i,'group'} = getgrgid($st[5]);
 191         $files{$i,'size'} = $st[7];
 192         if (!-e $l[1]) {
 193                 $files{$i,'error'} = "Does not exist";
 194                 }
 195         elsif ($l[0] eq 'sym') {
 196                 $files{$i,'link'} = $l[3];
 197                 local $lnk = readlink($real);
 198                 $files{$i,'error'} = "Incorrect link" if ($l[3] ne $lnk);
 199                 }
 200         elsif ($l[0] eq 'obj') {
 201                 push(@files, $l[1]);
 202                 $filesmap{$l[1]} = $i;
 203                 $files{$i,'md5'} = $l[2];
 204                 }
 205         $i++;
 206         }
 207 close(CONTENTS);
 208 if (&has_command("md5sum")) {
 209         &open_execute_command(MD5, "md5sum ".join(" ", @files), 1, 1);
 210         while(<MD5>) {
 211                 local ($md, $fn) = split(/\s+/);
 212                 local $n = $filesmap{$fn};
 213                 if ($md ne $files{$n,'md5'}) {
 214                         $files{$n,'error'} = "Checksum failed";
 215                         }
 216                 }
 217         close(MD5);
 218         }
 219 return $i;
 220 }
 221
 222 # installed_file(file)
 223 # Given a filename, fills %file with details of the given file and returns 1.
 224 # If the file is not known to the package system, returns 0
 225 # Usable values in %file are  path type user group mode size packages
 226 sub installed_file
 227 {
 228 local ($cf, $type, @packs);
 229 local $real_dir = &translate_filename($pkg_dir);
 230 while($cf = <$real_dir/*/*/CONTENTS>) {
 231         open(FILE, $cf);
 232         while(<FILE>) {
 233                 local @l = split(/\s+/);
 234                 if ($l[1] eq $_[0]) {
 235                         # Found it!
 236                         $cf =~ /\/([^0-9\/]+)-(\d[^\s\/]+)\/CONTENTS$/;
 237                         push(@packs, $1);
 238                         $type = $l[0] if (!$type);
 239                         }
 240                 }
 241         close(FILE);
 242         }
 243 return 0 if (!@packs);
 244
 245 local $real = &translate_filename($_[0]);
 246 local @st = stat($real);
 247 $file{'packages'} = join(' ', @packs);
 248 $file{'path'} = $_[0];
 249 $file{'user'} = getpwuid($st[4]);
 250 $file{'group'} = getgrgid($st[5]);
 251 $file{'mode'} = sprintf "%o", $st[2] & 07777;
 252 $file{'size'} = $st[7];
 253 $file{'link'} = readlink($real);
 254 $file{'type'} = $type eq 'dir' ? 1 :
 255                 $type eq 'sym' ? 3 : 0;
 256 return 1;
 257 }
 258
 259
 260
 261 # delete_package(package, [&options])
 262 # Attempt to remove some package
 263 sub delete_package
 264 {
 265 local $out = &backquote_logged("emerge -u ".quotemeta($_[0])." 2>&1");
 266 return $? ? "<pre>$out</pre>" : undef;
 267 }
 268
 269 sub package_system
 270 {
 271 return "Gentoo Ebuild";
 272 }
 273
 274 sub package_help
 275 {
 276 return "emerge";
 277 }
 278
 279 $has_update_system = 1;
 280
 281 # update_system_input()
 282 # Returns HTML for entering a package to install
 283 sub update_system_input
 284 {
 285 return "$text{'emerge_input'} <input name=update size=20> <input type=button onClick='window.ifield = form.update; chooser = window.open(\"../$module_name/emerge_find.cgi\", \"chooser\", \"toolbar=no,menubar=no,scrollbars=yes,width=600,height=500\")' value=\"$text{'emerge_find'}\">";
 286 }
 287
 288 # update_system_install([package])
 289 # Install some package with emerge
 290 sub update_system_install
 291 {
 292 local $update = $_[0] || $in{'update'};
 293 local $cmd = "emerge ".quotemeta($update);
 294 local @rv;
 295 print "<b>",&text('emerge_install', "<tt>$cmd</tt>"),"</b><p>\n";
 296 print "<pre>\n";
 297 &additional_log('exec', undef, $cmd);
 298 &open_execute_command(CMD, "$cmd 2>&1 </dev/null", 1);
 299 while(<CMD>) {
 300         print &html_escape($_);
 301         if (/^\>\>\>\s+([^\/]+)\/([^0-9]+)-(\d\S+)\s+merged\./i) {
 302                 push(@rv, $2);
 303                 }
 304         }
 305 close(CMD);
 306 print "</pre>\n";
 307 if ($?) { print "<b>$text{'emerge_failed'}</b><p>\n"; }
 308 else { print "<b>$text{'emerge_ok'}</b><p>\n"; }
 309 return @rv;
 310 }
 311
 312 1;
 313