usr.sbin/pkg_install/update/pkg_update.pl

   1 #!/usr/bin/perl -w
   2
   3 # Copyright (c) 2000
   4 #  Paul Richards. All rights reserved.
   5 #
   6 # Redistribution and use in source and binary forms, with or without
   7 # modification, are permitted provided that the following conditions
   8 # are met:
   9 # 1. Redistributions of source code must retain the above copyright
  10 #    notice, this list of conditions and the following disclaimer,
  11 #    verbatim and that no modifications are made prior to this
  12 #    point in the file.
  13 # 2. Redistributions in binary form must reproduce the above copyright
  14 #    notice, this list of conditions and the following disclaimer in the
  15 #    documentation and/or other materials provided with the distribution.
  16 #
  17 # THIS SOFTWARE IS PROVIDED BY PAUL RICHARDS ``AS IS'' AND
  18 # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  19 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  20 # ARE DISCLAIMED.  IN NO EVENT SHALL PAUL RICHARDS BE LIABLE
  21 # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  22 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  23 # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  24 # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  25 # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  26 # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  27 # SUCH DAMAGE.
  28 #
  29 # $FreeBSD: src/usr.sbin/pkg_install/update/pkg_update.pl,v 1.4.2.1 2001/03/16 04:36:01 paul Exp $
  30 #/
  31
  32 use strict;
  33
  34 use File::Basename;
  35 use Getopt::Std;
  36
  37 my $PKG_DB = "/var/db/pkg";
  38 my $PKG_DEP_FILE = "+REQUIRED_BY";
  39
  40 my $PKG_ADD = "/usr/sbin/pkg_add";
  41 my $PKG_CREATE = "/usr/sbin/pkg_create";
  42 my $PKG_DELETE = "/usr/sbin/pkg_delete -f";
  43 my $PKG_INFO = "/usr/sbin/pkg_info -Ia";
  44
  45 sub error ($) {
  46         my ($error) = @_;
  47
  48         print STDERR $error, "\n";
  49 }
  50
  51 sub get_version($) {
  52         my ($pkg) = @_;
  53
  54         $pkg =~ /(.+)-([0-9\.]+)/;
  55         if (! $2) {
  56                 return($pkg, "");
  57         } else {
  58                 return ($1, $2);
  59         }
  60 }
  61
  62 sub get_requires($$) {
  63         my ($pkg, $requires) = @_;
  64
  65         my $file = "$PKG_DB/$pkg/$PKG_DEP_FILE";
  66
  67         if (! -f $file) {
  68                 # Not all packages have dependencies
  69                 return 1;
  70         }
  71
  72         if (! open(REQUIRES, "< $file")) {
  73                 error("Can't open $file, $!");
  74                 return 0;
  75         }
  76
  77         while (<REQUIRES>) {
  78                 chomp $_;
  79                 $$requires{$_} = 1;
  80         }
  81
  82         close(REQUIRES) || warn("Can't close $file, $!");
  83
  84         return 1;
  85 }
  86
  87 sub put_requires($$) {
  88         my ($pkg, $requires) = @_;
  89
  90         my $file = "$PKG_DB/$pkg/$PKG_DEP_FILE";
  91
  92         if (! open(REQUIRES, "> $file")) {
  93                 error("Can't open $file, $!");
  94                 return 0;
  95         }
  96
  97         my $req;
  98         for $req (keys %$requires) {
  99                 print REQUIRES $req, "\n";
 100         }
 101
 102         if (! close(REQUIRES)) {
 103                 error("Can't close $file, $!");
 104                 return 0;
 105         }
 106
 107         return 1;
 108 }
 109
 110 #
 111 # Start of main program
 112 #
 113
 114 my @installed;
 115 my %requires;
 116 my $pkg = "";
 117 my $update_pkg = "";
 118
 119 use vars qw($opt_a $opt_c $opt_v $opt_r $opt_n);
 120 getopts('acnvr:');
 121
 122 if ($opt_a && $opt_c) {
 123         die("Options 'a' and 'c' are mutually exclusive");
 124 }
 125
 126 if ($opt_v) {
 127         $PKG_DELETE .= " -v";
 128         $PKG_ADD .= " -v";
 129         $PKG_CREATE .= " -v";
 130 }
 131
 132 if ($opt_n) {
 133         $PKG_DELETE .= " -n";
 134         $PKG_ADD .= " -n";
 135 }
 136
 137 if (scalar @ARGV < 1) {
 138         die("No package specified.\n");
 139 } elsif (scalar @ARGV > 1) {
 140         die("Only one package may be updated at a time.\n");
 141 }
 142
 143 my $pkgfile = $ARGV[0];
 144 if (! -f $pkgfile) {
 145         die("Can't find package file $pkgfile\n");
 146 }
 147
 148 my $newpkg = basename($pkgfile, '.tgz');
 149 my ($pkgname, $new_version) = get_version($newpkg);
 150
 151 if ($opt_r && $opt_r ne "") {
 152         my ($old_pkg, $old_version) = get_version($opt_r);
 153         print "Updating $old_pkg package version ";
 154         print "$old_version to $new_version\n";
 155         $update_pkg = $opt_r;
 156 } else {
 157         print "Updating $pkgname packages to version $new_version\n";
 158         $update_pkg = $pkgname;
 159 }
 160
 161 # Safety net to prevent all packages getting deleted
 162 if ($update_pkg eq "") {
 163         die ("Package to update is empty, aborting\n");
 164 }
 165
 166 # Find out what package versions are already installed
 167
 168 open(PKGINFO, "$PKG_INFO|") || die("Can't run $PKG_INFO, $!");
 169
 170 while (<PKGINFO>) {
 171         my ($pkg) = /^(.*?)\s+.*/;
 172
 173         if ($pkg =~ /^$update_pkg-[0-9\.]+/) {
 174                 push(@installed, $pkg);
 175         }
 176 }
 177
 178 close(PKGINFO) || die("Couldn't close pipe from $PKG_INFO, $!");
 179
 180 if (scalar @installed == 0) {
 181         if (! $opt_r) {
 182                 die("There are no $pkgname packages installed.\n");
 183         } else {
 184                 die("Package $opt_r is not installed.\n");
 185         }
 186 }
 187
 188 # For each installed package that matches get the dependencies
 189 my $old_pkg;
 190 for $old_pkg (@installed) {
 191         if (! get_requires($old_pkg, \%requires)) {
 192                 die("Failed to get requires from $old_pkg\n");
 193         }
 194 }
 195
 196 # Now delete all currently installed packages
 197 for $old_pkg (@installed) {
 198         if (! system("$PKG_DELETE $old_pkg")) {
 199                 print "Deleted $old_pkg\n" if ($opt_v);
 200         } else {
 201                 error("Couldn't remove package $old_pkg, $!");
 202         }
 203 }
 204
 205 if (system("$PKG_ADD $pkgfile")) {
 206         error("Command '$PKG_ADD $newpkg' failed, $!");
 207         if (scalar keys %requires) {
 208                 print "The following packages depended on previously\n";
 209                 print "installed versions of $pkgname.\n";
 210                 print "You need to add them to the +REQUIRES file when you\n";
 211                 print "succeed in installing $newpkg.\n";
 212                 my $req;
 213                 for $req (keys %requires) {
 214                         print $req, "\n";
 215                 }
 216         }
 217 } else {
 218         put_requires($pkgname . "-" . $new_version, \%requires);
 219 }
 220
 221 exit;