software/pkgadd-lib.pl.bak

   1 # pkgadd-lib.pl
   2 # Functions for solaris package management
   3
   4 &foreign_require("proc", "proc-lib.pl");
   5
   6 # list_packages([package]*)
   7 # Fills the array %packages with a list of all packages
   8 sub list_packages
   9 {
  10 local($_, $list, $i); $i = 0;
  11 $list = join(' ', @_);
  12 open(PKGINFO, "pkginfo $list |");
  13 while(<PKGINFO>) {
  14         last if (/The following software/i);
  15         if (/^(\S+)\s+(\S+)\s+(.*)$/) {
  16                 $packages{$i,'name'} = $2;
  17                 $packages{$i,'class'} = $1;
  18                 $packages{$i,'desc'} = $3;
  19                 $i++;
  20                 }
  21         }
  22 close(PKGINFO);
  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($out, @rv);
  32 $out = `pkginfo -l $_[0] 2>&1`;
  33 if ($out =~ /^ERROR:/) { return (); }
  34 push(@rv, $_[0]);
  35 push(@rv, $out =~ /CATEGORY:\s+(.*)\n/ ? $1 : "");
  36 push(@rv, $out =~ /DESC:\s+(.*)\n/ ? $1 :
  37           $out =~ /NAME:\s+(.*)\n/ ? $1 : $_[0]);
  38 push(@rv, $out =~ /ARCH:\s+(.*)\n/ ? $1 : $text{'pkgadd_unknown'});
  39 push(@rv, $out =~ /VERSION:\s+(.*)\n/ ? $1 : $text{'pkgadd_unknown'});
  40 push(@rv, $out =~ /VENDOR:\s+(.*)\n/ ? $1 : $text{'pkgadd_unknown'});
  41 push(@rv, $out =~ /INSTDATE:\s+(.*)\n/ ? $1 : $text{'pkgadd_unknown'});
  42 return @rv;
  43 }
  44
  45 # is_package(file)
  46 # Tests if some file is a valid package file
  47 sub is_package
  48 {
  49 local ($ph, $ppid) = &foreign_call("proc", "pty_process_exec",
  50                                    "pkgadd -d $_[0]");
  51 $rv = &wait_for($ph, 'ERROR', 'Select package|more choices');
  52 close($ph);
  53 return $rv;
  54 }
  55
  56 # file_packages(file)
  57 # Returns a list of all packages in the given file, in the form
  58 #  package description
  59 sub file_packages
  60 {
  61 local ($ph, $ppid) = &foreign_call("proc", "pty_process_exec",
  62                                    "pkgadd -d $_[0]");
  63 &wait_for($ph, 'available:');
  64 while($rv = &wait_for($ph, 'Select package',
  65                            '\r?\n\s+(\d+)\s+(\S+)\s+(.*)\r?\n',
  66                            'more choices.*:')) {
  67         if ($rv == 1) { push(@rv, "$matches[2] $matches[3]"); }
  68         else { &sysprint($ph, "\n"); }
  69         }
  70 close($ph);
  71 return @rv;
  72 }
  73
  74 # install_options(file, package)
  75 # Outputs HTML for choosing install options
  76 sub install_options
  77 {
  78 print "<tr> <td>",&hlink("<b>$text{'pkgadd_root'}</b>","root"),"</td>\n";
  79 print "<td colspan=3><input name=root size=30 value=/>\n";
  80 print &file_chooser_button("root", 1); print "</td> </tr>\n";
  81 }
  82
  83 # install_package(file, package)
  84 # Installs the package in the given file, with options from %in
  85 sub install_package
  86 {
  87 local(@opts, %seen, $wf, $rv, $old_input);
  88 local $in = $_[2] ? $_[2] : \%in;
  89 if ($in->{'root'} =~ /^\/.+/) {
  90         if (!(-d $in->{'root'})) { &error(&text('pkgadd_eroot', $in->{'root'})); }
  91         @opts = ("-R", $in->{'root'});
  92         }
  93 local ($ph, $ppid) = &foreign_call("proc", "pty_process_exec_logged",
  94                                    "pkgadd -d $_[0] ".join(" ",@opts)." $_[1]);
  95 while(1) {
  96         $wf = &wait_for($ph, '(.*) \[\S+\]',
  97                              'Installation of \S+ failed',
  98                              'Installation of \S+ was successful',
  99                              'No changes were made to the system');
 100         if ($wf == 0) {
 101                 # some question which should not have appeared before
 102                 if ($seen{$matches[1]}++) {
 103                         $rv = "<pre>$old_input$wait_for_input</pre>";
 104                         last;
 105                         }
 106                 &sysprint($ph, "y\n");
 107                 }
 108         elsif ($wf == 1 || $wf == 3) {
 109                 # failed for some reason.. give up
 110                 $rv = "<pre>$old_input$wait_for_input</pre>";
 111                 last;
 112                 }
 113         elsif ($wf == 2) {
 114                 # done ok!
 115                 $rv = undef;
 116                 last;
 117                 }
 118         $old_input = $wait_for_input;
 119         }
 120 close($ph);
 121 return $rv;
 122 }
 123
 124
 125 # check_files(package)
 126 # Fills in the %files array with information about the files belonging
 127 # to some package. Values in %files are  path type user group mode size error
 128 sub check_files
 129 {
 130 local($i, %errs, $curr, $line, %file);
 131 undef(%files);
 132 $chk = `pkgchk -n $_[0] 2>&1`;
 133 while($chk =~ /^(\S+): (\S+)\n((\s+.*\n)+)([\0-\177]*)$/) {
 134         if ($1 eq "ERROR") { $errs{$2} = $3; }
 135         $chk = $5;
 136         }
 137
 138 open(CHK, "pkgchk -l $_[0] 2>&1 |");
 139 FILES: for($i=0; 1; $i++) {
 140         # read one package
 141         $curr = "";
 142         while(1) {
 143                 if (!($line = <CHK>)) { last FILES; }
 144                 if ($line =~ /Current status/) { $line = <CHK>; last; }
 145                 $curr .= $line;
 146                 }
 147
 148         # extract information
 149         &parse_pkgchk($curr);
 150         foreach $k (keys %file) { $files{$i,$k} = $file{$k}; }
 151         $files{$i,'error'} = $errs{$files{$i,'path'}};
 152         }
 153 close(CHK);
 154 return $i;
 155 }
 156
 157 # installed_file(file)
 158 # Given a filename, fills %file with details of the given file and returns 1.
 159 # If the file is not known to the package system, returns 0
 160 # Usable values in %file are  path type user group mode size packages
 161 sub installed_file
 162 {
 163 $temp = &tempname();
 164 open(TEMP, "> $temp");
 165 print TEMP "$_[0]\n";
 166 close(TEMP);
 167
 168 $out = `pkgchk -l -i $temp 2>&1`;
 169 unlink($temp);
 170 if ($out =~ /\S/) {
 171         &parse_pkgchk($out);
 172         return 1;
 173         }
 174 else { return 0; }
 175 }
 176
 177 # delete_package(package)
 178 # Totally remove some package
 179 sub delete_package
 180 {
 181 local($ph, $pth, $ppid, $wf, %seen, $old_input);
 182 local ($ph, $ppid) = &foreign_call("proc", "pty_process_exec_logged",
 183                                    "pkgrm", $_[0]);
 184 if (&wait_for($ph, 'remove this package', 'ERROR')) {
 185         return "package does not exist";
 186         }
 187 &sysprint($ph, "y\n");
 188 while(1) {
 189         $wf = &wait_for($ph, '(.*) \[\S+\]',
 190                              'Removal of \S+ failed',
 191                              'Removal of \S+ was successful');
 192         if ($wf == 0) {
 193                 # some question which should not have appeared before
 194                 if ($seen{$matches[1]}++) {
 195                         $rv = "<pre>$old_input$wait_for_input</pre>";
 196                         last;
 197                         }
 198                 &sysprint($ph, "y\n");
 199                 }
 200         elsif ($wf == 1) {
 201                 # failed for some reason.. give up
 202                 $rv = "<pre>$old_input$wait_for_input</pre>";
 203                 last;
 204                 }
 205         elsif ($wf == 2) {
 206                 # done ok!
 207                 $rv = undef;
 208                 last;
 209                 }
 210         $old_input = $wait_for_input;
 211         }
 212 close($ph);
 213 return $rv;
 214 }
 215
 216 # parse_pkgchk(output)
 217 # Parse output about one file from pkgchk into the array %file
 218 sub parse_pkgchk
 219 {
 220 undef(%file);
 221 if ($_[0] =~ /Pathname:\s+(.*)/) { $file{'path'} = $1; }
 222 if ($_[0] =~ /Type:\s+(.*)/) {
 223         $file{'type'} = $1 eq "regular file" ? 0 :
 224                         $1 eq "directory" ? 1 :
 225                         $1 eq "special file" ? 2 :
 226                         $1 eq "symbolic link" ? 3 :
 227                         $1 eq "linked file" ? 4 :
 228                         $1 eq "volatile file" ? 5 :
 229                         $1 eq "editted file" ? 5 :
 230                         $1 eq "edited file" ? 5 :
 231                         -1;
 232         }
 233 if ($_[0] =~ /Source of link:\s+(\S+)/) { $file{'link'} = $1; }
 234 if ($_[0] =~ /Expected owner:\s+(\S+)/) { $file{'user'} = $1; }
 235 if ($_[0] =~ /Expected group:\s+(\S+)/) { $file{'group'} = $1; }
 236 if ($_[0] =~ /Expected mode:\s+(\S+)/) { $file{'mode'} = $1; }
 237 if ($_[0] =~ /size \(bytes\):\s+(\d+)/) { $file{'size'} = $1; }
 238 if ($_[0] =~ /following packages:\n(((\s+.*\n)|\n)+)/)
 239         { $file{'packages'} = join(' ', split(/\s+/, $1)); }
 240 }
 241
 242
 243 sub package_system
 244 {
 245 return $text{'pkgadd_manager'};
 246 }
 247
 248 sub package_help
 249 {
 250 return "pkgadd pkginfo pkgchk pkgrm";
 251 }
 252
 253 1;
 254