software/pkgadd-lib.pl

   1 # pkgadd-lib.pl
   2 # Functions for solaris package management
   3
   4 &foreign_require("proc", "proc-lib.pl");
   5
   6 sub list_package_system_commands
   7 {
   8 return ("pkginfo", "pkgadd", "pkgrm");
   9 }
  10
  11 # list_packages([package]*)
  12 # Fills the array %packages with a list of all packages
  13 sub list_packages
  14 {
  15 local $i = 0;
  16 local $list = join(' ', map { quotemeta($_) } @_);
  17 local $_;
  18 local %indexmap;
  19 %packages = ( );
  20 &open_execute_command(PKGINFO, "pkginfo -x $list", 1, 1);
  21 while(<PKGINFO>) {
  22         if (/^(\S+)\s*(.*)/) {
  23                 # Package name and description
  24                 $packages{$i,'name'} = $1;
  25                 $packages{$i,'desc'} = $2;
  26                 $indexmap{$1} = $i;
  27                 $i++;
  28                 }
  29         elsif (/^\s+\((\S+)\)\s*(\S+)/) {
  30                 # Arch and version
  31                 $packages{($i-1),'arch'} = $1;
  32                 $packages{($i-1),'version'} = $2;
  33                 $packages{($i-1),'shortversion'} = $2;
  34                 $packages{($i-1),'shortversion'} =~ s/,REV=.*//;
  35                 }
  36         }
  37 close(PKGINFO);
  38
  39 # Call pkginfo to get classes
  40 &open_execute_command(PKGINFO, "pkginfo $list", 1, 1);
  41 while(<PKGINFO>) {
  42         last if (/The following software/i);
  43         if (/^(\S+)\s+(\S+)\s+(.*)$/) {
  44                 local $idx = $indexmap{$2};
  45                 if (defined($idx)) {
  46                         $packages{$idx,'class'} = $1;
  47                         }
  48                 }
  49         }
  50 close(PKGINFO);
  51 return $i;
  52 }
  53
  54 # package_info(package)
  55 # Returns an array of package information in the order
  56 #  name, class, description, arch, version, vendor, installtime
  57 sub package_info
  58 {
  59 local($out, @rv);
  60 local $qm = quotemeta($_[0]);
  61 $out = &backquote_command("pkginfo -l $qm 2>&1", 1);
  62 if ($out =~ /^ERROR:/) { return (); }
  63 push(@rv, $_[0]);
  64 push(@rv, $out =~ /CATEGORY:\s+(.*)\n/ ? $1 : "");
  65 push(@rv, $out =~ /DESC:\s+(.*)\n/ ? $1 :
  66           $out =~ /NAME:\s+(.*)\n/ ? $1 : $_[0]);
  67 push(@rv, $out =~ /ARCH:\s+(.*)\n/ ? $1 : $text{'pkgadd_unknown'});
  68 push(@rv, $out =~ /VERSION:\s+(.*)\n/ ? $1 : $text{'pkgadd_unknown'});
  69 push(@rv, $out =~ /VENDOR:\s+(.*)\n/ ? $1 : $text{'pkgadd_unknown'});
  70 push(@rv, $out =~ /INSTDATE:\s+(.*)\n/ ? $1 : $text{'pkgadd_unknown'});
  71 return @rv;
  72 }
  73
  74 # is_package(file)
  75 # Tests if some file is a valid package file
  76 sub is_package
  77 {
  78 local $real = &translate_filename($_[0]);
  79 local $qm = quotemeta($_[0]);
  80 if (-d $real && !-r "$real/pkginfo") {
  81         # A directory .. see if it contains any package files
  82         local $rv = 0;
  83         opendir(DIR, $real);
  84         foreach $f (readdir(DIR)) {
  85                 next if ($f eq "." || $f eq "..");
  86                 if (&is_package("$_[0]/$f")) {
  87                         $rv = 1;
  88                         last;
  89                         }
  90                 }
  91         closedir(DIR);
  92         return $rv;
  93         }
  94 elsif ($real =~ /\*|\?/) {
  95         # a wildcard .. see what it matches
  96         # XXX won't work under translation
  97         local $f;
  98         foreach $f (glob($real)) {
  99                 if (&is_package($f)) {
 100                         $rv = 1;
 101                         last;
 102                         }
 103                 }
 104         return $rv;
 105         }
 106 else {
 107         # just a normal file - see if it is a package
 108         local $out = &backquote_command("pkginfo -d $qm 2>/dev/null");
 109         return !$? && $out !~ /ERROR/;
 110         }
 111 }
 112
 113 # file_packages(file)
 114 # Returns a list of all packages in the given file, directory or glob, as an
 115 # array of strings in the form
 116 #  package description
 117 sub file_packages
 118 {
 119 local $real = &translate_filename($_[0]);
 120 local $qm = quotemeta($_[0]);
 121 if (-d $real && !-r "$real/pkgproto") {
 122         # Scan directory for packages
 123         local ($f, @rv);
 124         opendir(DIR, $real);
 125         while($f = readdir(DIR)) {
 126                 if (&is_package("$_[0]/$f")) {
 127                         local @pkg = &file_packages("$_[0]/$f");
 128                         push(@rv, @pkg);
 129                         }
 130                 }
 131         closedir(DIR);
 132         return @rv;
 133         }
 134 elsif ($real =~ /\*|\?/) {
 135         # Expand glob of packages
 136         # XXX won't work under translation
 137         local ($f, @rv);
 138         foreach $f (glob($real)) {
 139                 local @pkg = &file_packages($f);
 140                 push(@rv, @pkg);
 141                 }
 142         return @rv;
 143         }
 144 else {
 145         # Just one package file
 146         local @rv;
 147         &open_execute_command(OUT, "pkginfo -d $qm", 1, 1);
 148         while(<OUT>) {
 149                 if (/^(\S+)\s+(\S+)\s+(\S.*)/) {
 150                         push(@rv, "$2 $3");
 151                         }
 152                 }
 153         close(OUT);
 154         return @rv;
 155         }
 156 }
 157
 158 # install_options(file, package)
 159 # Outputs HTML for choosing install options
 160 sub install_options
 161 {
 162 print &ui_table_row(&hlink($text{'pkgadd_root'}, "root"),
 163         &ui_textbox("root", "/", 50)." ".
 164         &file_chooser_button("root", 1), 3);
 165 }
 166
 167 # install_package(file, package)
 168 # Installs the package in the given file, with options from %in
 169 sub install_package
 170 {
 171 local(@opts, %seen, $wf, $rv, $old_input);
 172 local $real = &translate_filename($_[0]);
 173 local $qm = quotemeta($_[0]);
 174 local $in = $_[2] ? $_[2] : \%in;
 175 local $has_postinstall = 0; #detect if contains postinstall script
 176
 177 if ($in->{'root'} =~ /^\/.+/) {
 178         if (!(-d $in->{'root'})) { &error(&text('pkgadd_eroot', $in->{'root'})); }
 179         push(@opts, "-R", $in->{'root'});
 180         }
 181 if ($in->{'adminfile'} ne '') {
 182         push(@opts, "-a", $in->{'adminfile'});
 183         }
 184 if (-d $real && !-r "$real/pkgproto") {
 185         # Install one package from a file in this directory
 186         local $f;
 187         opendir(DIR, $real);
 188         while($f = readdir(DIR)) {
 189                 if (&is_package("$_[0]/$f")) {
 190                         local @pkg = &file_packages("$_[0]/$f");
 191                         foreach $pkg (@pkg) {
 192                                 local ($name, $desc) = split(/\s+/, $pkg);
 193                                 if ($name eq $_[1]) {
 194                                         return &install_package("$_[0]/$f", $name);
 195                                         }
 196                                 }
 197                         }
 198                 }
 199         closedir(DIR);
 200         return "Failed to find package $_[1]";
 201         }
 202 elsif ($real =~ /\?|\*/) {
 203         # Install one package from a file that matches a glob
 204         local $f;
 205         foreach $f (glob($real)) {
 206                 if (&is_package($f)) {
 207                         local @pkg = &file_packages($f);
 208                         foreach $pkg (@pkg) {
 209                                 local ($name, $desc) = split(/\s+/, $pkg);
 210                                 if ($name eq $_[1]) {
 211                                         return &install_package($f, $name);
 212                                         }
 213                                 }
 214                         }
 215                 }
 216         return "Failed to find package $_[1]";
 217         }
 218 else {
 219         # Install just one package
 220         local ($ph, $ppid) = &foreign_call("proc", "pty_process_exec_logged",
 221                            "pkgadd -d $_[0] ".join(" ",@opts)." $_[1]");
 222
 223         while(1) {
 224                 $wf = &wait_for($ph, '(.*) \[\S+\]',
 225                              '(This package contains scripts|Executing checkinstall script)',
 226                              'Installation of .* failed',
 227                              'Installation of .* was successful',
 228                              'No changes were made to the system',
 229                              '\n\/.*\n');
 230                 if ($wf == 0) {
 231                         # some question which should not have appeared before
 232                         if ($seen{$matches[1]}++ > 3) {
 233                                 $rv = "<pre>$old_input$wait_for_input</pre>";
 234                                 last;
 235                                 }
 236                         &sysprint($ph, "y\n");
 237                         }
 238                 elsif ($wf == 1) {
 239                         # This package contains scripts requiring output to
 240                         # be sent to /dev/null.  Abort & redo.
 241                         $rv = undef;
 242                         $has_postinstall = 1;
 243                         &sysprint($ph, "n\n");
 244                         #let the next elsif catch that 'no changes were made'
 245                         #to complete the pkgadd execution.
 246                         }
 247                 elsif ($wf == 2 || $wf == 4 || $wf == -1) {
 248                         # failed for some reason.. give up
 249                         $rv = "<pre>$old_input$wait_for_input</pre>";
 250                         last;
 251                         }
 252                 elsif ($wf == 3) {
 253                         # done ok!
 254                         $rv = undef;
 255                         last;
 256                         }
 257                 $old_input = $wait_for_input;
 258                 }
 259         close($ph);
 260
 261         if ($has_postinstall) {
 262                 # Handle case where pkg has scripts that cause pkgadd to open
 263                 # /dev/tty
 264                 my $ret = system_logged("pkgadd -n -a pkgadd-no-ask -d $_[0] ".
 265                                         join(" ",@opts).
 266                                         " $_[1] 2>&1 > /dev/null")/256;
 267                 #only exit values of 1 & 3 are errors (see pkgadd(1M))
 268                 $rv = ($ret == 1 || $ret == 3)? "pkgadd returned $ret" : undef;
 269                 }
 270
 271         return $rv;
 272         }
 273 }
 274
 275
 276 # check_files(package)
 277 # Fills in the %files array with information about the files belonging
 278 # to some package. Values in %files are  path type user group mode size error
 279 sub check_files
 280 {
 281 local($i, %errs, $curr, $line, %file);
 282 undef(%files);
 283 local $qm = quotemeta($_[0]);
 284 $chk = &backquote_command("pkgchk -n $qm 2>&1", 1);
 285 while($chk =~ /^(\S+): (\S+)\n((\s+.*\n)+)([\0-\177]*)$/) {
 286         if ($1 eq "ERROR") { $errs{$2} = $3; }
 287         $chk = $5;
 288         }
 289
 290 &open_execute_command(CHK, "pkgchk -l $qm 2>&1", 1, 1);
 291 FILES: for($i=0; 1; $i++) {
 292         # read one package
 293         $curr = "";
 294         while(1) {
 295                 if (!($line = <CHK>)) { last FILES; }
 296                 if ($line =~ /Current status/) { $line = <CHK>; last; }
 297                 $curr .= $line;
 298                 }
 299
 300         # extract information
 301         &parse_pkgchk($curr);
 302         foreach $k (keys %file) { $files{$i,$k} = $file{$k}; }
 303         $files{$i,'error'} = $errs{$files{$i,'path'}};
 304         }
 305 close(CHK);
 306 return $i;
 307 }
 308
 309 # installed_file(file)
 310 # Given a filename, fills %file with details of the given file and returns 1.
 311 # If the file is not known to the package system, returns 0
 312 # Usable values in %file are  path type user group mode size packages
 313 sub installed_file
 314 {
 315 local $temp = &transname();
 316 &open_tempfile(TEMP, ">$temp", 0, 1, 1);
 317 print TEMP "$_[0]\n";
 318 close(TEMP);
 319
 320 $out = &backquote_command("pkgchk -l -i $temp 2>&1", 1);
 321 &unlink_file($temp);
 322 if ($out =~ /\S/) {
 323         &parse_pkgchk($out);
 324         return 1;
 325         }
 326 else { return 0; }
 327 }
 328
 329 # delete_package(package)
 330 # Totally remove some package
 331 sub delete_package
 332 {
 333 local($ph, $pth, $ppid, $wf, %seen, $old_input);
 334 local ($ph, $ppid) = &foreign_call("proc", "pty_process_exec_logged",
 335                                    "pkgrm $_[0]");
 336 if (&wait_for($ph, 'remove this package', 'ERROR')) {
 337         return "package does not exist";
 338         }
 339 &sysprint($ph, "y\n");
 340 while(1) {
 341         $wf = &wait_for($ph, '(.*) \[\S+\]',
 342                              'Removal of \S+ failed',
 343                              'Removal of \S+ was successful',
 344                              '\n\/.*\n');
 345         if ($wf == 0) {
 346                 # some question which should not have appeared before
 347                 if ($seen{$matches[1]}++) {
 348                         $rv = "<pre>$old_input$wait_for_input</pre>";
 349                         last;
 350                         }
 351                 &sysprint($ph, "y\n");
 352                 }
 353         elsif ($wf == 1) {
 354                 # failed for some reason.. give up
 355                 $rv = "<pre>$old_input$wait_for_input</pre>";
 356                 last;
 357                 }
 358         elsif ($wf == 2) {
 359                 # done ok!
 360                 $rv = undef;
 361                 last;
 362                 }
 363         $old_input = $wait_for_input;
 364         }
 365 close($ph);
 366 return $rv;
 367 }
 368
 369 # parse_pkgchk(output)
 370 # Parse output about one file from pkgchk into the array %file
 371 sub parse_pkgchk
 372 {
 373 undef(%file);
 374 if ($_[0] =~ /Pathname:\s+(.*)/) { $file{'path'} = $1; }
 375 if ($_[0] =~ /Type:\s+(.*)/) {
 376         $file{'type'} = $1 eq "regular file" ? 0 :
 377                         $1 eq "directory" ? 1 :
 378                         $1 eq "special file" ? 2 :
 379                         $1 eq "symbolic link" ? 3 :
 380                         $1 eq "linked file" ? 4 :
 381                         $1 eq "volatile file" ? 5 :
 382                         $1 eq "editted file" ? 5 :
 383                         $1 eq "edited file" ? 5 :
 384                         -1;
 385         }
 386 if ($_[0] =~ /Source of link:\s+(\S+)/) { $file{'link'} = $1; }
 387 if ($_[0] =~ /Expected owner:\s+(\S+)/) { $file{'user'} = $1; }
 388 if ($_[0] =~ /Expected group:\s+(\S+)/) { $file{'group'} = $1; }
 389 if ($_[0] =~ /Expected mode:\s+(\S+)/) { $file{'mode'} = $1; }
 390 if ($_[0] =~ /size \(bytes\):\s+(\d+)/) { $file{'size'} = $1; }
 391 if ($_[0] =~ /following packages:\n(((\s+.*\n)|\n)+)/)
 392         { $file{'packages'} = join(' ', grep { $_ ne '' } split(/\s+/, $1)); }
 393 }
 394
 395
 396 sub package_system
 397 {
 398 return $text{'pkgadd_manager'};
 399 }
 400
 401 sub package_help
 402 {
 403 return "pkgadd pkginfo pkgchk pkgrm";
 404 }
 405
 406 1;
 407