software/cygwin-lib.pl

   1 # cygwin-lib.pl
   2 # Functions for cygwin + redhat package management
   3
   4 use vars '$hasrpm'; $hasrpm = (-f "/usr/bin/rpm.exe");
   5 use vars '$db'; $db = "/etc/setup/installed.db";
   6
   7 sub validate_package_system
   8 {
   9 return -r $db ? undef : &text('cygwin_edb', "<tt>$db</tt>");
  10 }
  11
  12 # list_packages([package]*)
  13 # Fills the array %packages with all or listed packages
  14 sub list_packages
  15 {
  16 my (@pkgs) = @_;
  17 my $allpkgs = (@_ == 0);
  18 local($i, $list); $i = 0;
  19 %packages = ( );
  20 if (&open_tempfile(DB, $db)) {
  21     while (<DB>) {
  22         #suppress packages that begin with an underscore
  23         if (/^([^_][^\s]*)\s+([^\s]+)\s+(\d+)/) {
  24             #TODO: classes, descriptions
  25             my ($name, $ver, $class, $desc) = ($1, $2, "cygwin", "");
  26             my $qmname = quotemeta($name);
  27             next if ! $allpkgs && ! grep(/^$qmname$/, @pkgs);
  28             $ver =~ s/.*?[_\-](\d.*)\.tar\..*/$1/;
  29             $packages{$i, 'name'} = $name;
  30             $packages{$i, 'class'} = $class;
  31             $packages{$i, 'version'} = $ver;
  32             $packages{$i, 'desc'} = $desc;
  33             $i++;
  34             @pkgs = grep { $_ ne $name } @pkgs if ! $allpkgs;
  35         }
  36         last if (! $allpkgs && @pkgs == 0);
  37     }
  38     close(DB);
  39     @_ = @pkgs;
  40 }
  41 return $i if ! $hasrpm || (! $allpkgs && @pkgs == 0);
  42
  43 $list = @_ ? join(' ', map { quotemeta($_) } @_) : "-a";
  44 &open_execute_command(RPM, "rpm -q $list --queryformat \"%{NAME}\\n%{VERSION}-%{RELEASE}\\n%{GROUP}\\n%{SUMMARY}\\n\\n\"", 1, 1);
  45 while($packages{$i,'name'} = <RPM>) {
  46         chop($packages{$i,'name'});
  47         chop($packages{$i,'version'} = <RPM>);
  48         chop($packages{$i,'class'} = <RPM>);
  49         while(<RPM>) {
  50                 s/\r|\n/ /g;
  51                 last if (!/\S/);
  52                 $packages{$i,'desc'} .= $_;
  53                 }
  54         $i++;
  55         }
  56 close(RPM);
  57 return $i;
  58 }
  59
  60 # package_info(package, version)
  61 # Returns an array of package information in the order
  62 #  name, class, description, arch, version, vendor, installtime
  63 sub package_info
  64 {
  65 my @cygdata = cygwin_pkg_info(@_);
  66 return @cygdata if @cygdata > 0;
  67 return undef if ! $hasrpm;
  68
  69 local(@rv, @tmp, $d);
  70 local $n = $_[1] ? "$_[0]-$_[1]" : $_[0];
  71 local $qm = quotemeta($n);
  72 &open_execute_command(RPM, "rpm -q $qm --queryformat \"%{NAME}\\n%{GROUP}\\n%{ARCH}\\n%{VERSION}-%{RELEASE}\\n%{VENDOR}\\n%{INSTALLTIME}\\n\" 2>/dev/null", 1, 1);
  73 @tmp = <RPM>;
  74 chop(@tmp);
  75 if (!@tmp) { return (); }
  76 close(RPM);
  77 &open_execute_command(RPM, "rpm -q $qm --queryformat \"%{DESCRIPTION}\"", 1, 1);
  78 while(<RPM>) { $d .= $_; }
  79 close(RPM);
  80 return ($tmp[0], $tmp[1], $d, $tmp[2], $tmp[3], $tmp[4], &make_date($tmp[5]));
  81 }
  82
  83 # is_package(file)
  84 # Check if some file is a package file
  85 sub is_package
  86 {
  87 local($out);
  88 local $real = &translate_filename($_[0]);
  89 if (-d $_[0]) {
  90         # a directory .. see if it contains any .rpm or .tar.bz2 files
  91         opendir(DIR, $real);
  92         local @list = grep { /([^\s]+[_\-](\d[^\s]*|src)-\d[^\s]*\.tar\.bz2|\.rpm)$/} readdir(DIR);
  93         closedir(DIR);
  94         return @list ? 1 : 0;
  95         }
  96 elsif ($_[0] =~ /\*|\?/) {
  97         # a wildcard .. see what it matches
  98         local @list = glob($real);
  99         return @list ? 1 : 0;
 100         }
 101 else {
 102         # just a normal file ..check if it is an RPM and not an SRPM or tar.bz2
 103         return 1 if $_[0] =~ /[^\s]+[_\-](\d[^\s]*|src)-\d[^\s]*\.tar\.bz2$/;
 104         local $qm = quotemeta($_[0]);
 105         $out = &backquote_command("rpm -q -p $qm 2>&1", 1);
 106         if ($out =~ /does not appear|No such file|with major numbers/i) {
 107                 return 0;
 108                 }
 109         &open_execute_command(OUT, "rpm -q -p -l $qm 2>&1", 1, 1);
 110         while(<OUT>) {
 111                 return 0 if (/^([^\/\s]+)\.spec$/);
 112                 }
 113         close(OUT);
 114         return 1;
 115         }
 116 }
 117
 118 # file_packages(file)
 119 # Returns a list of all packages in the given file, in the form
 120 #  package-version description
 121 sub file_packages
 122 {
 123 local $real = &translate_filename($_[0]);
 124 local $qm = quotemeta($_[0]);
 125 if (-d $real) {
 126         local @rv;
 127         opendir(DIR, $real);
 128         @rv = grep { s/.*\/([^\s]+)[_\-]((\d[^\s]*|src)-\d[^\s]*)\.tar\.bz2$/$1/ } readdir(DIR);
 129         closedir(DIR);
 130         &open_execute_command(RPM, "cd $qm && rpm -q -p *.rpm --queryformat \"%{NAME} %{SUMMARY}\\n\" 2>&1", 1, 1);
 131         while(<RPM>) {
 132                 chop;
 133                 push(@rv, $_) if (!/does not appear|query of.*failed|warning:/);
 134                 }
 135         close(RPM);
 136         return @rv;
 137         }
 138 elsif ($_[0] =~ /\*|\?/) {
 139         local @rv;
 140         my @p = &backquote_command("ls $_[0]");
 141         @rv = grep { s/.*\/([^\s]+)[_\-]((\d[^\s]*|src)-\d[^\s]*)\.tar\.bz2$/$1/ } @p;
 142         &open_execute_command(RPM, "rpm -q -p $_[0] --queryformat \"%{NAME} %{SUMMARY}\\n\" 2>&1", 1);
 143         while(<RPM>) {
 144                 chop;
 145                 push(@rv, $_) if (!/does not appear|query of.*failed|warning:/);
 146                 }
 147         close(RPM);
 148         return @rv;
 149         }
 150 else {
 151         local($out);
 152         $out = $_[0];
 153         return $out
 154             if $out =~ s/.*\/([^\s]+)[_\-]((\d[^\s]*|src)-\d[^\s]*)\.tar\.bz2$/$1/;
 155         $out = &backquote_command("rpm -q -p $qm --queryformat \"%{NAME} %{SUMMARY}\\n\" 2>&1", 1);
 156         $out =~ s/warning:.*\n//;
 157         $out =~ s/\n//g;
 158         return ($out);
 159         }
 160 }
 161
 162 # install_options(file, package)
 163 # Outputs HTML for choosing install options for some package
 164 sub install_options
 165 {
 166     my ($file, $pkg) = @_;
 167     if ($file =~ /\/[^\s]+[_\-]src[_\-]\d[^\s]*\.tar\.bz2$/) {
 168         # No options
 169     } elsif ($file =~ /\/[^\s]+[_\-]\d[^\s]*-\d[^\s]*\.tar\.bz2$/) {
 170         print &ui_table_row(undef, "<b>$text{'cygwin_warnuse'}</b>", 4);
 171
 172         print &yesno_input($text{'rpm_upgrade'}, "upgrade", 1, 0, 1);
 173         print &yesno_input($text{'rpm_replacepkgs'}, "replacepkgs", 1, 0);
 174
 175         print &yesno_input($text{'rpm_noscripts'}, "noscripts", 0, 1);
 176     } else {
 177         print &yesno_input($text{'rpm_upgrade'}, "upgrade", 1, 0, 1);
 178         print &yesno_input($text{'rpm_replacepkgs'}, "replacepkgs", 1, 0);
 179
 180         print &yesno_input($text{'rpm_nodeps'}, "nodeps", 1, 0);
 181         print &yesno_input($text{'rpm_oldpackage'}, "oldpackage", 1, 0);
 182
 183         print &yesno_input($text{'rpm_noscripts'}, "noscripts", 0, 1);
 184         print &yesno_input($text{'rpm_excludedocs'}, "excludedocs", 0, 1);
 185
 186         print &yesno_input($text{'rpm_notriggers'}, "notriggers", 0, 1);
 187         print &yesno_input($text{'rpm_ignoresize'}, "ignoresize", 0, 1);
 188
 189         print &yesno_input($text{'rpm_replacefiles'}, "replacefiles", 1, 0);
 190     }
 191 print &ui_table_row(&hlink($text{'rpm_root'}, "root"),
 192                 &ui_textbox("root", "/", 50)." ".
 193                 &file_chooser_button("root", 1), 3);
 194 }
 195
 196 sub yesno_input
 197 {
 198 return &ui_table_row(&hlink($_[0], $_[1]),
 199                      &ui_radio($_[1], int($_[4]),
 200                                [ [ $_[2], $text{'yes'} ],
 201                                  [ $_[3], $text{'no'} ] ]));
 202 }
 203
 204 # install_package(file, package, [&inputs])
 205 # Install the given package from the given file, using options from %in
 206 sub install_package
 207 {
 208 local $file = $_[0];
 209 local $real = &translate_filename($file);
 210 local $in = $_[2] ? $_[2] : \%in;
 211 local $opts;
 212 foreach $o ('oldpackage', 'replacefiles', 'replacepkgs', 'noscripts',
 213             'excludedocs', 'nodeps', 'upgrade', 'notriggers', 'ignoresize') {
 214         if ($in->{$o}) { $opts .= " --$o"; }
 215         }
 216 if ($in->{'root'} =~ /^\/.+/) {
 217         if (!(-d $in{'root'})) {
 218                 return &text('rpm_eroot', $in->{'root'});
 219                 }
 220         $opts .= " --root $in->{'root'}";
 221         }
 222 if (-d $real) {
 223         # Find the package in the directory
 224         local ($f, $out);
 225         opendir(DIR, $real);
 226         while($f = readdir(DIR)) {
 227             if ($f =~ /\/([^\s]+[_\-]src[_\-]\d[^\s]*)\.tar\.bz2$/) {
 228                 $out = $1;
 229             } elsif ($f =~ /^([^\s]+[_\-]\d[^\s]*-\d[^\s]*)\.tar\.bz2$/) {
 230                 $out = $1;
 231             } else {
 232                 next if ($f !~ /\.rpm$/);
 233                 $out = &backquote_command("rpm -q -p $file/$f --queryformat \"%{NAME}\\n\" 2>&1");
 234                 $out =~ s/warning:.*\n//;
 235                 $out =~ s/\n//;
 236             }
 237                 if ($out eq $_[1]) {
 238                         $file = "$file/$f";
 239                         last;
 240                         }
 241                 }
 242         closedir(DIR);
 243         &error(&text('rpm_erpm', $_[1], $out)) if ($file eq $_[0]);
 244         }
 245 elsif ($file =~ /\*|\?/) {
 246         # Find the package in the glob
 247         # XXX won't work when translation is in effect
 248         local ($f, $out);
 249         foreach $f (glob($real)) {
 250             if ($f =~ /\/([^\s]+[_\-]src[_\-]\d[^\s]*)\.tar\.bz2$/) {
 251                 $out = $1;
 252             } elsif ($f =~ /\/([^\s]+[_\-]\d[^\s]*-\d[^\s]*)\.tar\.bz2$/) {
 253                 $out = $1;
 254             } else {
 255                 $out = &backquote_command("rpm -q -p $f --queryformat \"%{NAME}\\n\" 2>&1", 1);
 256                 $out =~ s/warning:.*\n//;
 257                 $out =~ s/\n//;
 258             }
 259                 if ($out eq $_[1]) {
 260                         $file = $f;
 261                         last;
 262                         }
 263                 }
 264         &error(&text('rpm_erpm', $_[1], $out)) if ($file eq $_[0]);
 265         }
 266 local $temp = &transname();
 267 local $rv;
 268 if ($file =~ /\/[^\s]+[_\-]src[_\-]\d[^\s]*\.tar\.bz2$/) {
 269     $rv = install_cygwin_src_pkg($file, $temp, $in->{'root'});
 270 } elsif ($file =~ /\/[^\s]+[_\-]\d[^\s]*-\d[^\s]*\.tar\.bz2$/) {
 271     my $run_scripts = 1;
 272     $run_scripts = 0 if defined($in->{'noscripts'}) && $in->{'noscripts'} == 1;
 273     $rv = install_cygwin_pkg($file, $temp, $in->{'root'}, $run_scripts,
 274                              $in->{'replacepkgs'}, $in->{'upgrade'});
 275 } else {
 276     $rv = &system_logged("rpm -i $opts ".quotemeta($file)." >$temp 2>&1");
 277 }
 278 local $out = "";
 279 if (! open(FILE, "<$temp")) {
 280     warn "could not open $temp: $!\n";
 281 } else {
 282     $out = join('', <FILE>);
 283     close(FILE);
 284     $out =~ s/warning:.*\n//;
 285     unlink($temp);
 286 }
 287 if ($rv) {
 288         return "<pre>$out</pre>";
 289         }
 290 return undef;
 291 }
 292
 293 #instead of defining install_packages() (which do_install.cgi has a
 294 #couple of design flaws with), make it install them one-by-one.
 295 #<<- no sub install_packages here ->>
 296
 297 # check_files(package, version)
 298 # Fills in the %files array with information about the files belonging
 299 # to some package. Values in %files are  path type user group size error
 300 sub check_files
 301 {
 302 local($i, $_, @w, %errs, $epath); $i = 0;
 303 my @cygdata = cygwin_pkg_info(@_);
 304 my $root = "/";
 305 my $origlst = "${root}etc/setup/$cygdata[0].lst.gz";
 306 if (@cygdata && -f $origlst) {
 307     #$name, $class, $desc, $arch, $ver, $vendor, $date
 308     my $lst = uncompress_if_needed($origlst);
 309     if (&open_readfile(FILES, $lst)) {
 310         while (<FILES>) {
 311             chomp($_);
 312             my $f = get_file_info($root . $_);
 313             for (qw(path link type user group size error)) {
 314                 $files{$i, $_} = $f->{$_} if defined($f->{$_});
 315             }
 316             $i++;
 317         }
 318         close(FILES);
 319         &unlink_file($lst) if $origlst ne $lst;
 320     }
 321 }
 322 return $i if $i > 0 || ! $hasrpm;
 323
 324 local $n = $_[1] ? "$_[0]-$_[1]" : $_[0];
 325 local $qm = quotemeta($n);
 326 &open_execute_command(RPM, "rpm -V $qm", 1, 1);
 327 while(<RPM>) {
 328         /^(.{8}) (.) (.*)$/;
 329         if ($1 eq "missing ") {
 330                 $errs{$3} = $text{'rpm_missing'};
 331                 }
 332         else {
 333                 $epath = $3;
 334                 @w = grep { $_ ne "." } split(//, $1);
 335                 $errs{$epath} =
 336                         join("\n", map { &text('rpm_checkfail', $etype{$_}) } @w);
 337                 }
 338         }
 339 close(RPM);
 340 &open_execute_command(RPM, "rpm -q $qm -l --dump", 1, 1);
 341 while(<RPM>) {
 342         chop;
 343         @w = split(/ /);
 344         $files{$i,'path'} = $w[0];
 345         if ($w[10] ne "X") { $files{$i,'link'} = $w[10]; }
 346         $files{$i,'type'} = $w[10] ne "X" ? 3 :
 347                             (-d &translate_filename($w[0])) ? 1 :
 348                             $w[7] ? 5 : 0;
 349         $files{$i,'user'} = $w[5];
 350         $files{$i,'group'} = $w[6];
 351         $files{$i,'size'} = $w[1];
 352         $files{$i,'error'} = $w[7] ? "" : $errs{$w[0]};
 353         $i++;
 354         }
 355 close(RPM);
 356 return $i;
 357 }
 358
 359 # installed_file(file)
 360 # Given a filename, fills %file with details of the given file and returns 1.
 361 # If the file is not known to the package system, returns 0
 362 # Usable values in %file are  path type user group mode size packages
 363 sub installed_file
 364 {
 365 local($pkg, @w, $_, @pkgs, @vers);
 366 undef(%file);
 367 my $root = "/";
 368
 369 my $file = $_[0];
 370 $file =~ s/^$root//;
 371 local $qm = quotemeta($file);
 372 @pkgs = &backquote_command("zgrep -le '^$qm\$' /etc/setup/*.lst.gz 2>&1", 1);
 373 chomp(@pkgs);
 374 if (@pkgs) {
 375     grep(s/.*etc\/setup\/(.+)\.lst\.gz/$1/g, @pkgs);
 376     my $f = get_file_info($root . $file);
 377     $f->{'packages'} = join(' ', @pkgs);
 378     if (&open_readfile(LST, $db)) {
 379         while (<LST>) {
 380             if (/^([^\s]+)\s+[^\s]+[_\-]([\d][^\s]\.tar\.bz2)\s/) {
 381                 my ($pkg, $ver) = ($1, $2);
 382                 $f->{'versions'} .= "$ver "
 383                     if grep(/^$pkg$/, @pkgs);
 384             }
 385         }
 386         close(LST);
 387     }
 388     %file = %$f;
 389     return 1;
 390 } else {
 391     return 0 if ! $hasrpm;
 392 }
 393
 394 local $qm = quotemeta($_[0]);
 395 $pkg = &backquote_command("rpm -q -f $qm --queryformat \"%{NAME}\\n\" 2>&1", 1);
 396 if ($pkg =~ /not owned/ || $?) { return 0; }
 397 @pkgs = split(/\n/, $pkg);
 398 $pkg = &backquote_command("rpm -q -f $qm --queryformat \"%{VERSION}-%{RELEASE}\\n\" 2>&1");
 399 @vers = split(/\n/, $pkg);
 400 &open_execute_command(RPM, "rpm -q $pkgs[0] -l --dump", 1, 1);
 401 while(<RPM>) {
 402         chop;
 403         @w = split(/ /);
 404         if ($w[0] eq $_[0]) {
 405                 $file{'packages'} = join(' ', @pkgs);
 406                 $file{'versions'} = join(' ', @vers);
 407                 $file{'path'} = $w[0];
 408                 if ($w[10] ne "X") { $files{$i,'link'} = $w[10]; }
 409                 $file{'type'} = $w[10] ne "X" ? 3 :
 410                                 (-d &translate_filename($w[0])) ? 1 :
 411                                 $w[7] ? 5 : 0;
 412                 $file{'user'} = $w[5];
 413                 $file{'group'} = $w[6];
 414                 $file{'mode'} = substr($w[4], -4);
 415                 $file{'size'} = $w[1];
 416                 last;
 417                 }
 418         }
 419 close(RPM);
 420 return 1;
 421 }
 422
 423 # delete_options(package)
 424 # Outputs HTML for package uninstall options
 425 sub delete_options
 426 {
 427     my @cygdata = cygwin_pkg_info(@_);
 428     if (@cygdata) {
 429         print "<b>$text{'cygwin_warnuse'}</b><br>\n";
 430     } else {
 431         print "<b>$text{'delete_nodeps'}</b>\n";
 432         print &ui_yesno_radio("nodeps", 0),"<br>\n";
 433     }
 434 print "<b>$text{'delete_noscripts'}</b>\n";
 435 print &ui_yesno_radio("noscripts", 0),"<br>\n";
 436 }
 437
 438 # delete_package(package, [&options], version)
 439 # Attempt to remove some package
 440 sub delete_package
 441 {
 442     local $in = $_[2] ? $_[2] : \%in;
 443     my @cygdata = cygwin_pkg_info($_[0], $_[2]);
 444     if (@cygdata) {
 445         my $root = "/";
 446         my $run_scripts = 1;
 447         $run_scripts = 0 if (defined($in->{'noscripts'}) &&
 448                              $in->{'noscripts'} == 1);
 449         local $temp = &transname();
 450         my $rv = remove_cygwin_pkg($_[0], $temp, $root, $run_scripts);
 451         if ($rv && &open_readfile(FILE, $temp)) {
 452             my $out = join('', <FILE>);
 453             close(FILE);
 454             unlink($temp);
 455             return "<pre>$out</pre>" if $rv;
 456         }
 457         return undef;
 458     }
 459
 460 local $opts;
 461 $opts .= $_[1]->{'nodeps'} ? "--nodeps " : "";
 462 $opts .= $_[1]->{'noscripts'} ? "--noscripts " : "";
 463 local $n = $_[2] ? "$_[0]-$_[2]" : $_[0];
 464 local $qm = quotemeta($n);
 465 local $out = &backquote_logged("rpm -e $opts $qm 2>&1");
 466 if ($? || $out =~ /error:/) { return "<pre>$out</pre>"; }
 467 return undef;
 468 }
 469
 470 # delete_packages(&packages, [&options], &versions)
 471 # Attempt to remove multiple packages at once
 472 sub delete_packages
 473 {
 474 local $opts;
 475 $opts .= $_[1]->{'nodeps'} ? "--nodeps " : "";
 476 $opts .= $_[1]->{'noscripts'} ? "--noscripts " : "";
 477 local $cmd = "rpm -e $opts";
 478 local $i;
 479 for($i=0; $i<@{$_[0]}; $i++) {
 480         if ($_[2]->[$i]) {
 481                 $cmd .= " ".quotemeta($_[0]->[$i]."-".$_[2]->[$i]);
 482                 }
 483         else {
 484                 $cmd .= " ".quotemeta($_[0]->[$i]);
 485                 }
 486         }
 487 local $out = &backquote_logged("$cmd 2>&1");
 488 if ($? || $out =~ /error:/) { return "<pre>$out</pre>"; }
 489 return undef;
 490 }
 491
 492 sub package_system
 493 {
 494     my $text = "CYGWIN";
 495     $text .= "/RPM" if $hasrpm;
 496     return $text;
 497 }
 498
 499 sub package_help
 500 {
 501 return "cygwin";
 502 }
 503
 504 %etype = (      "5", $text{'rpm_md5'},  "S", $text{'rpm_fsize'},
 505                 "L", $text{'rpm_sym'},  "T", $text{'rpm_mtime'},
 506                 "D", $text{'rpm_dev'},  "U", $text{'rpm_user'},
 507                 "M", $text{'rpm_perm'}, "G", $text{'rpm_group'} );
 508
 509 $has_search_system = 1;
 510
 511 sub search_system_input
 512 {
 513 print "<input type=button onClick='window.ifield = document.forms[2].url; chooser = window.open(\"rpmfind.cgi\", \"chooser\", \"toolbar=no,menubar=no,scrollbars=yes,width=600,height=500\")' value=\"$text{'rpm_find'}\">";
 514 }
 515
 516 # file, temp output file, root path
 517 sub install_cygwin_src_pkg
 518 {
 519     my ($file, $temp, $root) = @_;
 520     $root .= "/" if $root =~ /[^\/]$/;
 521     $root .= "usr/src/";
 522     &system_logged("mkdir -p $root > $temp 2>&1") if ! -d $root;
 523     my $opts = "-jt";
 524     $opts .= " -C $root";
 525     my $pkg = $file;
 526     $pkg =~ s/[_\-]\d.*//;
 527     my $rv = &system_logged("tar $opts -f ".quotemeta($file).
 528                             " >>$temp 2>&1");
 529     return $rv;
 530 }
 531
 532 # file, temp output file, root path, run_scripts, replace pkgs, upgrade
 533 sub install_cygwin_pkg
 534 {
 535     my ($file, $temp, $root, $run_scripts, $replace_pkgs, $upgrade) = @_;
 536
 537     $root .= "/" if $root =~ /[^\/]$/;
 538     &system_logged("mkdir -p $root > $temp 2>&1") if ! -d $root;
 539     my $opts = "-jxv";
 540     $opts .= " -C $root";
 541     my $pkg = $file;
 542     $pkg =~ s/.*\/(.+?)[_\-]\d.*/$1/;
 543     my $setupdir = "${root}etc/setup";
 544     my $lstfile = "$setupdir/$pkg.lst";
 545
 546     #the only time we don't check for the same package currently installed
 547     #is if the user specified to replace pkgs but not to upgrade
 548     my @cygdata = ();
 549     unless (! $upgrade && $replace_pkgs) {
 550         #check to see if a package is already installed
 551         @cygdata = cygwin_pkg_info($pkg);
 552         if (@cygdata && $upgrade) {
 553             remove_cygwin_pkg($cygdata[0], $temp, $root, $run_scripts);
 554         }
 555     }
 556     if (@cygdata && ! $upgrade && ! $replace_pkgs) {
 557         if (&open_tempfile(FILE, ">>$temp", 1)) {
 558             &print_tempfile(FILE, &text('cygwin_pkgexists', $pkg) . "\n");
 559             &close_tempfile(FILE);
 560         }
 561         return 1;
 562     }
 563
 564     &system_logged("mkdir -p $setupdir") if ! -d $setupdir;
 565     my $rv = &system_logged("tar $opts -f ".quotemeta($file).
 566                             " > $lstfile 2>>$temp");
 567     if ($run_scripts && open(FILE, "<$lstfile")) {
 568         #run postinstall scripts
 569         while (<FILE>) {
 570             if (/etc\/postinstall\/.*sh/) {
 571                 my $f = quotemeta($_);
 572                 $rv += &system_logged("sh $root$f >> $temp 2>&1");
 573                 $rv += &system_logged("mv -v $root$f $root$f.done>>$temp 2>&1");
 574             }
 575         }
 576         close(FILE);
 577     }
 578     $rv += &system_logged("gzip -f $lstfile >>$temp 2>&1");
 579     my $db = "$setupdir/installed.db";
 580     $file =~ s/.*\///;
 581     if (open(FILE, "<$db")) {
 582         my @lines = <FILE>;
 583         close(FILE);
 584         #avoid windows security issues
 585         &system_logged("chmod u+w $db >>$temp 2>&1") if ! -w $db;
 586         &system_logged("chown $ENV{'USERNAME'} $db >>$temp 2>&1")
 587             if ! -O $db;
 588         &lock_file($db);
 589         if (&open_tempfile(FILE, ">$db", 1)) {
 590             #remove the package from the db if it already exists
 591             @lines = grep {! /^$pkg /} @lines;
 592             #add this package to the end.
 593             push(@lines, "$pkg $file 0\n");
 594             &print_tempfile(FILE, @lines);
 595             &close_tempfile(FILE);
 596         }
 597         &unlock_file($db);
 598     }
 599     return $rv;
 600 }
 601
 602 # pkg, temp output file, root path, run_scripts
 603 sub remove_cygwin_pkg
 604 {
 605     my ($pkg, $temp, $root, $run_scripts) = @_;
 606     $root .= "/" if $root =~ /[^\/]$/;
 607     my $setupdir = "${root}etc/setup";
 608     my $lstfile = "$setupdir/$pkg.lst.gz";
 609     my $rv = 0;
 610
 611     my @cygdata = cygwin_pkg_info($pkg);
 612     if (! @cygdata) {
 613         if (&open_tempfile(FILE, ">$temp", 1)) {
 614             &print_tempfile(FILE, "Could not find $pkg\n");
 615             &close_tempfile(FILE);
 616         }
 617
 618     #kludge: don't get rid of packages on which we depend
 619     } elsif ($pkg =~ /^(perl|webmin|gzip|tar|bzip2|cygwin|ash)$/) {
 620         if (&open_tempfile(FILE, ">$temp", 1)) {
 621             &print_tempfile(FILE, "Not removing $pkg because of dependencies.\n");
 622             &print_tempfile(FILE, "You'll have to force installation of the package.\n");
 623             &close_tempfile(FILE);
 624         }
 625
 626     #load in the list file
 627     } elsif (! -f $lstfile || ! open(LST, "gunzip -c $lstfile |")) {
 628         $rv = 1;
 629         if (&open_tempfile(FILE, ">$temp")) {
 630             &print_tempfile(FILE, "Could not open $lstfile\n");
 631             &close_tempfile(FILE);
 632         }
 633     } else {
 634         my @files = <LST>;
 635         chomp(@files);
 636         close(LST);
 637
 638         #run preremove scripts
 639         if ($run_scripts) {
 640             my @scripts = grep(/^etc\/preremove\/.*sh/, @files);
 641             foreach (@scripts) {
 642                 my $f = quotemeta($_);
 643                 $rv += system_logged("sh $root$f >> $temp 2>&1");
 644                 $rv += system_logged("mv -v $root$f $root$f.done>>$temp 2>&1");
 645             }
 646         }
 647
 648         #remove all files except files in etc
 649         foreach (reverse(@files)) {
 650             next if /^etc\//;
 651             if (-d $_) {
 652                 my $msg = &unlink_logged($_)? "" : $!;
 653                 $rv++ if $msg ne "";
 654             } elsif (-f $_) {
 655                 my $msg = &unlink_logged($_)? "" : $!;
 656                 $rv++ if $msg ne "";
 657             }
 658         }
 659
 660         #run postremove scripts
 661         if ($run_scripts) {
 662             my @scripts = grep(/^etc\/postremove\/.*sh/, @files);
 663             foreach (@scripts) {
 664                 my $f = quotemeta($_);
 665                 $rv += system_logged("sh $root$f >> $temp 2>&1");
 666                 $rv += system_logged("mv -v $root$f $root$f.done>>$temp 2>&1");
 667             }
 668         }
 669
 670         $rv += system_logged("rm -f $lstfile >>$temp 2>&1");
 671         my $db = "$setupdir/installed.db";
 672         lock_file($db);
 673         if (&open_readfile(FILE, $db)) {
 674             my @lines = <FILE>;
 675             close(FILE);
 676             if (&open_tempfile(FILE, ">$db")) {
 677                 #remove the package from the db
 678                 @lines = grep {! /^$pkg /} @lines;
 679                 &print_tempfile(FILE, @lines);
 680                 &close_tempfile(FILE);
 681             }
 682         }
 683         unlock_file($db);
 684     }
 685     return $rv;
 686 }
 687
 688 #returns: name, class, description, arch, version, vendor, installtime
 689 sub cygwin_pkg_info
 690 {
 691     my ($pkg_name, $pkg_ver) = @_;
 692     if (&open_readfile(DB, $db)) {
 693         while (<DB>) {
 694             if (/^([^\s]*)\s+([^\s]+)\s+(\d+)/) {
 695                 #TODO: classes, descriptions, vendor, installtime, arch
 696                 my ($name, $ver, $class, $desc) = ($1, $2, "cygwin", "");
 697                 next if $name ne $pkg_name;
 698                 $ver =~ s/.*?[_\-]([\d+].*)\.tar\..*/$1/;
 699                 next if defined($pkg_ver) && $pkg_ver ne $ver;
 700                 my ($arch, $vendor, $date) = ("i586", "cygwin", undef);
 701                 if (@_ = stat(&translate_filename("/etc/setup/$name.lst.gz"))) {
 702                     $date = make_date($_[9]);
 703                 }
 704                 close(DB);
 705                 return ($name, $class, $desc, $arch, $ver, $vendor, $date)
 706             }
 707         }
 708         close(DB);
 709     }
 710     return ();
 711 }
 712
 713 # Usable values in %file are  path type user group mode size packages
 714 sub get_file_info
 715 {
 716     my ($f) = @_;
 717     my $predetected_error = "";
 718
 719     #check to make sure if it is a post install script that it was run
 720     if ($f =~ /\/etc\/postinstall\/.*\.sh$/) {
 721         if (-e $f) {
 722             $predetected_error = $text{'cygwin_badpostscript'};
 723         } else {
 724             #automatically change postinstall script to be .done
 725             #since it does not exist
 726             $f =~ s%(/etc/postinstall/.*\.sh)$%$1.done%;
 727         }
 728     }
 729
 730     my %file;
 731     my $real = &translate_filename($f);
 732     $file{'path'} = $f;
 733     if (! -l $real && ! -e $real) {
 734         $file{'error'} = $text{'cygwin_fmissing'};
 735     } elsif (-d $real) {
 736         $file{'type'} = 1;
 737         $file{'error'} = $predetected_error;
 738         if (@_ = stat($real)) {
 739             my @ent = getpwuid($_[4]);
 740             $file{'user'} = (@ent && $ent[0] ne "????????")?
 741                 $ent[0] : $_[4];
 742             @ent = getgrgid($_[5]);
 743             $file{'group'} = (@ent && $ent[0] ne "????????")?
 744                 $ent[0] : $_[5];
 745             $file{'size'} = $_[7];
 746             $file{'mode'} = sprintf "%o", $_[2] & 07777;
 747         }
 748     } elsif (-l $real) {
 749         $file{'type'} = 3;
 750         if (@_ = lstat($real)) {
 751             my @ent = getpwuid($_[4]);
 752             $file{'user'} = (@ent && $ent[0] ne "????????")?
 753                 $ent[0] : $_[4];
 754             @ent = getgrgid($_[5]);
 755             $file{'group'} = (@ent && $ent[0] ne "????????")?
 756                 $ent[0] : $_[5];
 757             $file{'size'} = $_[7];
 758             $file{'mode'} = sprintf "%o", $_[2] & 07777;
 759             if ($file{'link'} = readlink($real)) {
 760                 my $l = $file{'link'};
 761                 my $lreal = &translate_filename($l);
 762                 my $fb = $f; $fb =~ s/[^\/]*$//;
 763                 $l = $fb . $l if $l !~ /^\//;
 764                 if (! -l $lreal && ! -e $lreal) {
 765                     $file{'error'} = $text{'cygwin_lmissing'};
 766                 } else {
 767                     $file{'error'} = $predetected_error;
 768                 }
 769             } else {
 770                 $file{'error'} = &text('cygwin_elread', $!);
 771             }
 772         } else {
 773             $file{'error'} = &text('cygwin_elstat', $!);
 774         }
 775     } else {
 776         #2 = special file; 0 = regular file
 777         $file{'type'} = (-f $real)? 0 : 2;
 778         if (@_ = stat($real)) {
 779             my @ent = getpwuid($_[4]);
 780             $file{'user'} = (@ent && $ent[0] ne "????????")?
 781                 $ent[0] : $_[4];
 782             @ent = getgrgid($_[5]);
 783             $file{'group'} = (@ent && $ent[0] ne "????????")?
 784                 $ent[0] : $_[5];
 785             $file{'size'} = $_[7];
 786             $file{'mode'} = sprintf "%o", $_[2] & 07777;
 787             $file{'error'} = $predetected_error;
 788         } else {
 789             $file{'error'} = &text('cygwin_estat', $!);
 790         }
 791     }
 792     return \%file;
 793 }
 794 1;
 795