software/hpux-lib.pl

   1 # hpux-lib.pl
   2 # Functions for HP-UX package management
   3
   4 sub list_package_system_commands
   5 {
   6 return ("swlist", "swinstall");
   7 }
   8
   9 # list_packages([package]*)
  10 # Fills the array %packages with all or listed packages
  11 sub list_packages
  12 {
  13 local($i, $name, $class, @contents, $products, $title_flag);
  14 $i = 0;
  15 $products = join(' ', @_);
  16 $name = "";
  17 %packages = ( );
  18
  19 open(SW, "swlist -v -a title -a contents |");
  20 while(<SW>) {
  21         s/#.*$//g;
  22 # bundles and unbundled products
  23         if (/^  (\S*)/) {
  24                 $name = $1;
  25                 $packages{$i,'name'} = $1;
  26                 $packages{$i,'class'} = $1;
  27                 }
  28         if (/^bundle/ || /^product/) {
  29                 $title_flag = 1;
  30                 }
  31         if (/^title\s+(.*)/ && $title_flag) {
  32                 $packages{$i,'desc'} = $1;
  33                 if ($products eq "" || (index $products,$name) ne -1) {
  34                         $i++;
  35                         }
  36                 $title_flag = "";
  37                 }
  38 # bundeled products
  39         if (/^contents\s+(.*)/) {
  40                 @contents = split(/\./, $1);
  41                 $packages{$i,'name'} = "$name.$contents[0]";
  42                 $packages{$i,'class'} = $name;
  43                 if (($products eq "" ||
  44                      (index $products,"$contents[0]") ne -1) &&
  45                     $packages{$i,'name'} ne $packages{$i - 1,'name'} ) {
  46                         $i++;
  47                         }
  48                 }
  49         }
  50 close(SW);
  51
  52 return $i;
  53 }
  54
  55 # package_info(package)
  56 # Returns an array of package information in the order
  57 #  name, class, description, arch, version, vendor, installtime
  58 sub package_info
  59 {
  60 local(@name, $level, $name, $class, $desc, $arch, $version, $vendor, $date);
  61
  62 $name = $_[0];
  63 @name = split(/\./, $name);
  64 $class = $name[0];
  65
  66 open(SW, "swlist -l product -v -a vendor.title -a title -a revision -a architecture -a date $name | ");
  67 while(<SW>) {
  68         s/#.*$//g;
  69         if (/^date\s+(.*)/ &&
  70             ($name[1] eq "" && $date eq "" || $name[1] ne "")) {
  71                 $date = $1;
  72                 }
  73         if (/^architecture\s+(.*)/ &&
  74             ($name[1] eq "" && $arch eq "" || $name[1] ne "")) {
  75                 $arch = $1;
  76                 }
  77         if (/^revision\s+(.*)/ &&
  78             ($name[1] eq "" && $version eq "" || $name[1] ne "")) {
  79                 $version = $1;
  80                 }
  81         if (/^vendor\.title\s+(.*)/ &&
  82             ($name[1] eq "" && $vendor eq "" || $name[1] ne "")) {
  83                 $vendor = $1;
  84                 }
  85         if (/^title\s+(.*)/ &&
  86             ($name[1] eq "" && $desc eq "" || $name[1] ne "")) {
  87                 $desc = $1;
  88                 }
  89         }
  90 close(SW);
  91
  92 return ($name, $class, $desc, $arch, $version, $vendor, $date);
  93 }
  94
  95 # is_package(file)
  96 # Check if some file is a package file
  97 sub is_package
  98 {
  99 local($out);
 100 $out = `swlist -s $_[0] 2>&1`;
 101 return $out !~ /ERROR:   /;
 102 }
 103
 104 # file_packages(file)
 105 # Returns a list of all packages in the given file, in the form
 106 #  package description
 107 sub file_packages
 108 {
 109 local(@list);
 110 open(SW, "swlist -s $_[0] |");
 111 while(<SW>) {
 112         s/#.*$//g;
 113         if (/^  (\S*)\s+(\S*)/) {
 114                 push (@list, "$1 $2");
 115                 }
 116         }
 117 close(SW);
 118
 119 return @list;
 120 }
 121
 122 # install_options(file, package)
 123 # Outputs HTML for choosing install options for some package
 124 sub install_options
 125 {
 126 print &ui_table_row($text{'hpux_create_target_path'},
 127         &ui_yesno_radio("create_target_path", 1));
 128
 129 print &ui_table_row($text{'hpux_mount_all_filesystems'},
 130         &ui_yesno_radio("mount_all_filesystems", 1));
 131
 132 print &ui_table_row($text{'hpux_reinstall'},
 133         &ui_yesno_radio("reinstall", 0));
 134
 135 print &ui_table_row($text{'hpux_reinstall_files'},
 136         &ui_yesno_radio("reinstall_files", 1));
 137
 138 print &ui_table_row($text{'hpux_reinstall_files_use_cksum'},
 139         &ui_yesno_radio("reinstall_files_use_cksum", 1));
 140
 141 print &ui_table_row($text{'hpux_allow_multiple_versions'},
 142         &ui_yesno_radio("allow_multiple_versions", 0));
 143
 144 print &ui_table_row($text{'hpux_defer_configure'},
 145         &ui_yesno_radio("defer_configure", 0));
 146
 147 print &ui_table_row($text{'hpux_autorecover_product'},
 148         &ui_yesno_radio("autorecover_product", 0));
 149
 150 print &ui_table_row($text{'hpux_allow_downdate'},
 151         &ui_yesno_radio("allow_downdate", 0));
 152
 153 print &ui_table_row($text{'hpux_allow_incompatible'},
 154         &ui_yesno_radio("allow_incompatible", 0));
 155
 156 print &ui_table_row($text{'hpux_autoselect_dependencies'},
 157         &ui_yesno_radio("autoselect_dependencies", 1));
 158
 159 print &ui_table_row($text{'hpux_enforce_dependencies'},
 160         &ui_yesno_radio("enforce_dependencies", 1));
 161
 162 print &ui_table_row($text{'hpux_enforce_scripts'},
 163         &ui_yesno_radio("enforce_scripts", 1));
 164
 165 print &ui_table_row($text{'hpux_enforce_dsa'},
 166         &ui_yesno_radio("enforce_dsa", 1));
 167
 168 print &ui_table_row($text{'hpux_root'},
 169         &ui_textbox("root", "/", 50)." ".
 170         &file_chooser_button("root", 1), 3);
 171 }
 172
 173 # install_package(file, package)
 174 # Install the given package from the given file, using options from %in
 175 sub install_package
 176 {
 177 local $in = $_[2] ? $_[2] : \%in;
 178 foreach $o ('create_target_path',
 179             'mount_all_filesystems',
 180             'reinstall',
 181             'reinstall_files',
 182             'reinstall_files_use_cksum',
 183             'allow_multiple_versions',
 184             'defer_configure',
 185             'autorecover_product',
 186             'allow_downdate',
 187             'allow_incompatible',
 188             'autoselect_dependencies',
 189             'enforce_dependencies',
 190             'enforce_scripts',
 191             'enforce_dsa') {
 192         if ($in->{$o}) { $opts .= " -x $o=true"; }
 193         else { $opts .= " -x $o=false"; }
 194         }
 195 if ($in->{'root'} =~ /^\/.+/) {
 196         if (!(-d $in->{'root'})) {
 197                 return "Root directory '$in->{'root'}' does not exist";
 198                 }
 199         $opts .= " -r $in->{'root'}";
 200         }
 201 $out = &backquote_logged("swinstall -s $_[0] $opts $_[1] 2>&1");
 202 if ($?) { return "<pre>$out</pre>"; }
 203 return undef;
 204 }
 205
 206 # check_files(package)
 207 # Fills in the %files array with information about the files belonging
 208 # to some package.
 209 sub check_files
 210 {
 211 local($i, $path); $i = -1;
 212 open(SW, "swlist -l file -v -a path -a owner -a group -a type -a link_source -a size $_[0] | ");
 213 while(<SW>) {
 214         s/#.*$//g;
 215         if (/^path\s+(.*)/) {
 216                 $i++;
 217                 $files{$i,'path'} = $1;
 218                 $files{$i,'size'} = "-";
 219                 $files{$i,'user'} = "-";
 220                 $files{$i,'group'} = "-";
 221                 $files{$i,'link'} = "";
 222                 $path = $1;
 223                 }
 224         if (/^owner\s+(.*)/ && $path ne "") {
 225                 $files{$i,'user'} = $1;
 226                 }
 227         if (/^group\s+(.*)/ && $path ne "") {
 228                 $files{$i,'group'} = $1;
 229                 }
 230         if (/^type\s+(.*)/ && $path ne "") {
 231                 $files{$i,'type'} = $1 eq "f" ? 0 :
 232                                     $1 eq "d" ? 1 :
 233                                     $1 eq "s" ? 3 :
 234                                     $1 eq "h" ? 4 :
 235                                     -1;
 236                 }
 237         if (/^link_source\s+(.*)/ && $path ne "") {
 238                 $files{$i,'link'} = $1;
 239                 }
 240         if (/^size\s+(.*)/ && $path ne "") {
 241                 $files{$i,'size'} = $1;
 242                 $path = "";
 243                 }
 244         $files{$i,'error'} = "\n";
 245         }
 246 close(SW);
 247 return $i;
 248 }
 249
 250 # installed_file(file)
 251 # Given a filename, fills %file with details of the given file and returns 1.
 252 # If the file is not known to the package system, returns 0
 253 sub installed_file
 254 {
 255 local($path, $search, @tmp, $product, $product_flag, $path_flag);
 256 $search = $_[0];
 257
 258 open(SW, "swlist -l file -v -a path -a owner -a group -a type -a link_source -a mode -a size | ");
 259 while(<SW>) {
 260 #       s/#.*$//g;
 261         if (/^product/) {
 262                 $product_flag = 1;
 263                 }
 264         if (/^# (\S*)/ && $product_flag) {
 265                 @tmp = split(/\./, $1);
 266                 $product = $tmp[0];
 267                 $product_flag = "";
 268                 }
 269         if (/^path\s+(.*)/) {
 270                 if ($1 eq $search) {
 271                         $file{'path'} = $1;
 272                         $file{'size'} = "-";
 273                         $file{'user'} = "-";
 274                         $file{'mode'} = "-";
 275                         $file{'group'} = "-";
 276                         if ((index $file{'packages'},$product) eq -1) {
 277                                 $file{'packages'} = join(' ', $product, $file{'packages'});
 278                                 }
 279                         $path_flag = 1;
 280                         }
 281                 else {
 282                         $path_flag = "";
 283                         }
 284                 }
 285         if (/^owner\s+(.*)/ && $path_flag) {
 286                 $file{'user'} = $1;
 287                 }
 288         if (/^group\s+(.*)/ && $path_flag) {
 289                 $file{'group'} = $1;
 290                 }
 291         if (/^type\s+(.*)/ && $path_flag) {
 292                 $file{'type'} = $1 eq "f" ? 0 :
 293                                 $1 eq "d" ? 1 :
 294                                 $1 eq "s" ? 3 :
 295                                 $1 eq "h" ? 4 :
 296                                 -1;
 297                 }
 298         if (/^link_source\s+(.*)/ && $path_flag) {
 299                 $file{'link'} = $1;
 300                 }
 301         if (/^mode\s+(.*)/ && $path_flag) {
 302                 $file{'mode'} = $1;
 303                 }
 304         if (/^size\s+(.*)/ && $path_flag) {
 305                 $file{'size'} = $1;
 306                 }
 307         $file{'error'} = "\n";
 308         }
 309 close(SW);
 310
 311 if ($file{'packages'} ne "") { return 1; }
 312 else { undef(%file); return 0; }
 313 }
 314
 315 # delete_package(package)
 316 # Attempt to remove some package
 317 sub delete_package
 318 {
 319 $out = &backquote_logged("swremove $_[0] 2>&1");
 320 if ($out) { return "<pre>$out</pre>"; }
 321 return undef;
 322 }
 323
 324 sub package_system
 325 {
 326 return "HP-UX SW";
 327 }
 328
 329 sub package_help
 330 {
 331 return "swinstall swlist swremove";
 332 }
 333
 334 1;
 335