[Summary view] [Print] [Text view]

   1  # Object which contains knowledge about Windows installation media.
   2  
   3  package Unattend::WinMedia;
   4  
   5  use warnings;
   6  use strict;
   7  use Unattend::IniFile;
   8  use File::Spec::Win32;
   9  use File::Spec::Unix;
  10  use fields qw (txtsetup setupp prodspec path);
  11  
  12  # File::Spec is supposed to auto-detect the OS and adapt
  13  # appropriately, but it does not recognize a $^O value of "dos".  Work
  14  # around this bug here.
  15  my $file_spec = 'File::Spec::Win32';
  16  
  17  my %cache;
  18  
  19  # Function which translates DOS path names to host form.  Defaults to
  20  # identity.
  21  my $dos_to_host = sub ($) { return @_; };
  22  
  23  sub new ($$) {
  24      my ($proto, $path) = @_;
  25  
  26      my $class = ref $proto || $proto;
  27  
  28      (exists ($cache{$path}))
  29          and return $cache{$path};
  30  
  31      my Unattend::WinMedia $self = fields::new ($class);
  32  
  33      my $txtsetup;
  34      my $setupp;
  35      my $prodspec;
  36  
  37      if (-d &$dos_to_host ($file_spec->catfile( $path, 'amd64'))) {
  38          $txtsetup = $file_spec->catfile ($path, 'amd64', 'txtsetup.sif');
  39          $setupp = $file_spec->catfile ($path, 'amd64', 'setupp.ini');
  40          $prodspec = $file_spec->catfile ($path, 'amd64', 'prodspec.ini');
  41      }
  42      else {
  43          $txtsetup = $file_spec->catfile ($path, 'i386', 'txtsetup.sif');
  44          $setupp = $file_spec->catfile ($path, 'i386', 'setupp.ini');
  45          $prodspec = $file_spec->catfile ($path, 'i386', 'prodspec.ini');
  46      }
  47      -f &$dos_to_host ($txtsetup) && -f &$dos_to_host($setupp)
  48          && -f &$dos_to_host ($prodspec)
  49          or return undef;
  50  
  51      # Remember the path to this media
  52      $self->{path} = $path;
  53  
  54      # Read the relevant sections of TXTSETUP.SIF
  55      $self->{txtsetup} = Unattend::IniFile->new 
  56          (&$dos_to_host ($txtsetup), 'Strings|SCSI|SCSI\.Load');
  57  
  58      # Read SETUPP.INI
  59      $self->{setupp} = Unattend::IniFile->new (&$dos_to_host ($setupp));
  60  
  61      # Read PRODSPEC.INI
  62      $self->{prodspec} = Unattend::IniFile->new (&$dos_to_host ($prodspec));
  63  
  64      return $self;       # Already blessed by fields::new
  65  }
  66  
  67  sub set_dos_to_host ($$) {
  68      my (undef, $func) = @_;
  69  
  70      $dos_to_host = $func;
  71  }
  72  
  73  # Handy optimization
  74  sub cache ($) {
  75      my Unattend::WinMedia ($self) = @_;
  76  
  77      $cache{$self->{path}} = $self;
  78      return 1;
  79  }
  80  
  81  sub path ($) {
  82      my Unattend::WinMedia ($self) = @_;
  83      return $self->{path};
  84  }
  85  
  86  # Grovel around to find the common name of this media.
  87  sub name ($) {
  88      my Unattend::WinMedia ($self) = @_;
  89      my $ret = 'UNKNOWN OS';
  90  
  91      my $strings = $self->{txtsetup}->{'Strings'};
  92  
  93      # productname appears to be canonical, but first appeared in XP
  94      if (exists $strings->{'productname'}) {
  95          $ret = $strings->{'productname'};
  96      }
  97      else {
  98          my $cdname;
  99          # Windows 2000 Workstation, Server, and Advanced Server each
 100          # use different keys here.
 101          foreach my $key ('wkscd', 'srvcd', 'entcd') {
 102              (exists $strings->{$key})
 103                  or next;
 104              $cdname = $strings->{"$key"};
 105          }
 106          if (defined $cdname) {
 107              # $cdname is something like "Windows 2000 Professional CD"
 108              # (English) or "CD Windows 2000 Professional" (French).
 109              # Get rid of the "CD" string and surrounding whitespace.
 110              $cdname =~ s/\s*CD(-ROM)?\s*//;
 111              $ret = $cdname;
 112          }
 113      }
 114  
 115      return $ret;
 116  }
 117  
 118  sub localization ($) {
 119      my Unattend::WinMedia ($self) = @_;
 120      return $self->{prodspec}->{'Product Specification'}->{'Localization'};
 121  }
 122  
 123  sub service_pack ($) {
 124      my Unattend::WinMedia ($self) = @_;
 125      my $ret = '';
 126  
 127      my $strings = $self->{txtsetup}->{'Strings'};
 128  
 129      my $spcdname;
 130  
 131      # NT did not support slipstreaming.
 132      # 2000 puts this string in "spcd".
 133      # XP puts it in "spcdname".
 134      foreach my $key ('spcdname', 'spcd') {
 135          (exists $strings->{$key})
 136              or next;
 137          $spcdname = $strings->{$key};
 138          last;
 139      }
 140  
 141      defined $spcdname
 142          and ($ret) = $spcdname =~ /Service Pack (\S+)/;
 143  
 144      return $ret;
 145  }
 146  
 147  my %pid_table =
 148      (
 149       # Windows Server 2003, Standard x64 Edition
 150       '76869270' => 'Volume',
 151       # Windows Server 2003
 152       '69763000' => 'Trial',
 153       '69753000' => 'Retail',
 154       '69712270' => 'Volume',
 155       # Windows Server 2003, Enterprise Edition
 156       '69713000' => 'Retail',
 157       '69713270' => 'Volume',
 158       # XP
 159       # See <http://www.thetechguide.com/howto/setuppini.html>
 160       '55274OEM' => 'Dell OEM',
 161       '55274000' => 'Retail',
 162       '55274270' => 'Volume',
 163       '51882335' => 'Retail',
 164       '51883270' => 'Volume',
 165       '82503OEM' => 'OEM',
 166       # 2k Adv Server
 167       '51879000' => 'Retail',
 168       '51879270' => 'Volume',
 169       # 2k
 170       '51873OEM' => 'OEM',
 171       '51873000' => 'Retail',
 172       '51873270' => 'Volume',
 173       # Windows 2000 Professional, Spanish
 174       '52339270' => 'Volume',
 175       # Windows 2000 Professional, Russian
 176       '52882000' => 'Retail',
 177       # 2k server
 178       '51876000' => 'Retail',
 179       '51876270' => 'Volume',
 180       # NT
 181       '50036' => 'Retail',
 182       '50382' => 'Retail'
 183       );
 184  
 185  sub type ($) {
 186      my Unattend::WinMedia ($self) = @_;
 187      my $ret = 'UNKNOWN PID';
 188  
 189      # Get product id string
 190      my $pid = $self->{setupp}->{'Pid'}->{'Pid'};
 191  
 192      if ( defined $pid ) {
 193          if ( exists $pid_table{$pid} ) {
 194              $ret = $pid_table{$pid};
 195          } 
 196          elsif ( $pid =~ /^.....270$/ ) {
 197              $ret = 'Volume??';
 198          } 
 199          elsif ( $pid =~ /^.....000$/ ) {
 200              $ret = 'Retail??';
 201          } 
 202          elsif ( $pid =~ /^.....OEM$/ ) {
 203              $ret = 'OEM??';
 204          }
 205          else {
 206              $ret = "UNKNOWN PID $pid";
 207          }
 208      }
 209  
 210      return $ret;
 211  }
 212  
 213  sub full_name ($) {
 214      my Unattend::WinMedia ($self) = @_;
 215  
 216      my $name = $self->name ();
 217      my $sp = $self->service_pack ();
 218      $sp ne ''
 219          and $sp = " SP$sp";
 220      my $type = $self->type ();
 221      my $localization = $self->localization();
 222      return "$name$sp ($type, $localization)";
 223  }
 224  
 225  # Find the .inf files below a given directory.  Allow .inf files in
 226  # one directory to "mask" the presence of .inf files below it.  This
 227  # is useful for computing the OemPnPDriversPath.
 228  sub _find_inf_files ($);
 229  sub _find_inf_files ($) {
 230      my ($dir) = @_;
 231      my @results;
 232  
 233      # Read the directory.
 234      opendir DIR, &$dos_to_host ($dir)
 235          or die "Unable to opendir $dir: $^E";
 236  
 237      my @entries = sort readdir DIR;
 238  
 239      closedir DIR
 240          or die "Unable to closedir $dir: $^E";
 241  
 242      # Loop through it once, looking for .inf files.
 243      foreach my $entry (@entries) {
 244          my $full_path = $file_spec->catfile ($dir, $entry);
 245  
 246          if ($entry =~ /\.inf\z/i) {
 247              push @results, $full_path;
 248          }
 249      }
 250  
 251      # If we found any .inf files, we are done.  Otherwise, loop
 252      # through directory again, calling ourselves on each subdirectory
 253      # and accumulating the results.
 254      if (scalar @results == 0) {
 255          foreach my $entry (@entries) {
 256              $entry eq '.' || $entry eq '..'
 257                  and next;
 258  
 259              my $full_path = $file_spec->catdir ($dir, $entry);
 260  
 261              -d &$dos_to_host ($full_path)
 262                  and push @results, _find_inf_files ($full_path);
 263          }
 264      }
 265  
 266      return (@results);
 267  }
 268  
 269  # Like find_inf_files above, but return only the directory portions,
 270  # relative to the base path provided as argument.
 271  sub _find_oem_pnp_dirs ($) {
 272      my ($base) = @_;
 273  
 274      my @files = _find_inf_files ($base);
 275      my %dirs;
 276  
 277      foreach my $file (@files) {
 278          my $rel_path = $file_spec->abs2rel ($file, $base);
 279          my (undef, $rel_dir) = $file_spec->splitpath ($rel_path);
 280          # Remove trailing slash
 281          $rel_dir = $file_spec->catdir ($rel_dir);
 282          $dirs{$rel_dir} = undef;
 283      }
 284  
 285      return keys %dirs;
 286  }
 287  
 288  sub oem_pnp_dirs ($;$$) {
 289      my Unattend::WinMedia $self = shift;
 290      my $verbose = shift;
 291      my $oem_system_dir = shift;
 292  
 293      if (not defined $oem_system_dir) {
 294      if (-d &$dos_to_host ($file_spec->catfile($self->path (), 'amd64'))) {
 295          $oem_system_dir = $file_spec->catdir ($self->path (), 'amd64', '$oem$', '$1');
 296      } else {
 297          $oem_system_dir = $file_spec->catdir ($self->path (), 'i386', '$oem$', '$1');
 298      }
 299      }
 300  
 301      $verbose
 302          and print "Looking for drivers under $oem_system_dir...\n";
 303  
 304      my @ret = (-d &$dos_to_host ($oem_system_dir)
 305                 ? _find_oem_pnp_dirs ($oem_system_dir)
 306                 : ());
 307  
 308      $verbose && scalar @ret == 0
 309          and print "...no driver directories found.\n";
 310  
 311      return @ret;
 312  }
 313  
 314  sub _textmode_dir ($) {
 315      my Unattend::WinMedia ($self) = @_;
 316      
 317      if (-d &$dos_to_host ($file_spec->catfile( $self->path (), 'amd64'))) {
 318        return $file_spec->catdir ($self->path, 'amd64', '$oem$','textmode');
 319      } else {
 320        return $file_spec->catdir ($self->path, 'i386', '$oem$','textmode');
 321      }
 322  }
 323  
 324  # Return the names of drivers from the [scsi] section of txtsetup.oem.
 325  # See <http://support.microsoft.com/?kbid=288344>.
 326  
 327  sub textmode_oem_drivers ($;$) {
 328      my Unattend::WinMedia ($self) = shift;
 329      my $verbose = shift;
 330  
 331      my $txtsetup_oem_file =
 332          $file_spec->catfile ($self->_textmode_dir (), 'txtsetup.oem');
 333  
 334      $verbose
 335          and print "Trying to parse $txtsetup_oem_file...\n";
 336  
 337      unless (-f &$dos_to_host ($txtsetup_oem_file)) {
 338          $verbose
 339              and print "...file not found\n";
 340          return ();
 341      }
 342  
 343      my $txtsetup_oem =
 344          Unattend::IniFile->new (&$dos_to_host ($txtsetup_oem_file),
 345                                  'scsi');
 346  
 347      my @ret;
 348  
 349      # Grab first component of each value in [scsi] section.
 350      my $scsi = $txtsetup_oem->{'scsi'};
 351      foreach my $key (keys %$scsi) {
 352          my $value = $scsi->{$key};
 353          ref $value eq 'ARRAY'
 354              or $value = [ $value ] ;
 355          push @ret, $value->[0];
 356      }
 357  
 358      $verbose
 359          and print "...done\n";
 360      return @ret;
 361  }
 362  
 363  # Return a list of all files in the $OEM$/TEXTMODE directory
 364  sub textmode_files ($) {
 365      my Unattend::WinMedia ($self) = @_;
 366      my @ret = ();
 367  
 368      my $textmode = $self->_textmode_dir ();
 369  
 370      if (-d &$dos_to_host ($textmode)) {
 371          opendir TEXTMODE, &$dos_to_host ($textmode)
 372              or die "Unable to opendir $textmode: $^E";
 373          while (my $ent = readdir TEXTMODE) {
 374              $ent eq '.' || $ent eq '..'
 375                  and next;
 376              my $full_path = $file_spec->catfile ($textmode, $ent);
 377              if (! -f &$dos_to_host ($full_path)) {
 378                  warn "$full_path is not a file; ignoring.\n";
 379                  next;
 380              }
 381              push @ret, $ent;
 382          }
 383          closedir TEXTMODE, $textmode
 384              or die "Unable to closedir $textmode: $^E";
 385      }
 386  
 387      return @ret;
 388  }
 389  
 390  sub textmode_retail_drivers ($;$) {
 391      my Unattend::WinMedia ($self) = shift;
 392      # This should probably do something.  FIXME.
 393      my $verbose = shift;
 394  
 395      my @ret;
 396  
 397      # Iterate through entries in [SCSI] section of txtsetup.sif
 398      my $scsi = $self->{txtsetup}->{'SCSI'};
 399      foreach my $key (keys %$scsi) {
 400          # Skip this key unless it is listed in the [SCSI.Load] section.
 401          (defined $self->{txtsetup}->{'SCSI.Load'}->{$key})
 402              or next;
 403          my $value = $scsi->{$key};
 404          ref $value eq 'ARRAY'
 405              or $value = [ $value ] ;
 406          push @ret, $value->[0];
 407      }
 408  
 409      return @ret;
 410  }
 411  
 412  # Return the subdirectories of i386 or amd64 which exist and hold language
 413  # files.
 414  sub lang_dirs ($;$) {
 415      my Unattend::WinMedia ($self) = shift;
 416      my $verbose = shift;
 417      my @ret;
 418      
 419      my $dir = 'lang';
 420      my $full_path;
 421      if (-d &$dos_to_host ($file_spec->catfile( $self->path (), 'amd64'))) {
 422          $full_path = $file_spec->catdir ($self->path (), 'amd64', $dir);
 423      } else {
 424          $full_path = $file_spec->catdir ($self->path (), 'i386', $dir);
 425      }
 426      $verbose
 427          and print "Looking for $full_path...\n";
 428  
 429      if (-d &$dos_to_host ($full_path)) {
 430          $verbose
 431              and print "...found.\n";
 432          push @ret, $dir;
 433      }
 434      else {
 435          $verbose
 436              and print "...not found.\n";
 437      }
 438  
 439      return @ret;
 440  }