[Summary view] [Print] [Text view]

   1  # Manage the to-do list.
   2  
   3  use warnings;
   4  use strict;
   5  use Getopt::Long;
   6  use Pod::Usage;
   7  use Win32API::Registry qw(:Func :SE_);
   8  my %reg;
   9  use Win32::TieRegistry (Delimiter => '/', TiedHash => \%reg);
  10  use Win32::NetResource; # for get_drive_path
  11  use Win32::Console;
  12  
  13  (exists $ENV{'SystemDrive'})
  14      or die "Internal error";
  15  
  16  my $c = $ENV{'SystemDrive'};
  17  
  18  # Location of the "to do" list.
  19  my $todo = "$c\\netinst\\todo.txt";
  20  
  21  # Location of "mapznrun" script
  22  my $mapznrun = "$c\\netinst\\mapznrun.bat";
  23  
  24  # Determine alternate letter for z: drive and store it in Z
  25  # environment variable (unless it is already set).
  26  unless (exists $ENV{'Z'}) {
  27      # Try to get drive letter from the path to this script.
  28      use File::Spec;
  29      my ($vol, undef, undef) = File::Spec->splitpath ($0);
  30      $ENV{'Z'} = $vol;
  31  }
  32  
  33  my $z = $ENV{'Z'};
  34  
  35  unless (-e $mapznrun) {
  36      print "Hm, no $mapznrun file.  Attempting to copy from $z\\bin...";
  37      use File::Copy;
  38      copy "$z\\bin\\mapznrun.bat", $mapznrun
  39          or die "copy failed ($^E); bailing";
  40  }
  41  
  42  # Your usual option-processing sludge.
  43  my %opts;
  44  GetOptions (\%opts, 'help', 'user', 'go')
  45      or pod2usage (2);
  46  
  47  (exists $opts{'help'})
  48      and pod2usage ('-exitstatus' => 0, -verbose => 2);
  49  
  50  sub stop () {
  51      while (1) {
  52          sleep 3600;
  53      }
  54  }
  55  
  56  # Since this is the top-level "driver" script, stop if we encounter
  57  # any problems.
  58  END {
  59      $? == 0
  60          and return;
  61  
  62      print "$0 exiting with status $? ; halting...\n";
  63      stop ();
  64  }
  65  
  66  sub reboot ($) {
  67      my ($timeout) = @_;
  68      AllowPriv (SE_SHUTDOWN_NAME, 1)
  69          or die "Unable to AllowPriv SE_SHUTDOWN_NAME: $^E";
  70  
  71      print "$0 is bouncing the system\n";
  72      InitiateSystemShutdown ('', "$0: Rebooting...", $timeout, 1, 1)
  73          or die "Unable to InitiateSystemShutdown: $^E";
  74      stop ();
  75  }
  76  
  77  # Check if we have administrative privileges.
  78  sub are_we_administrator () {
  79      # See if we can enable the "take ownership" privilege.  This is
  80      # just a poor approximation to what we really want to know, which
  81      # is (usually) whether we can install software.
  82      return AllowPriv (SE_TAKE_OWNERSHIP_NAME, 1)
  83          && AllowPriv (SE_TAKE_OWNERSHIP_NAME, 0);
  84  }
  85  
  86  # Read a file.  Return an empty list if file does not exist.
  87  sub read_file ($) {
  88      my ($file) = @_;
  89  
  90      -e $file
  91          or return ();
  92  
  93      open FILE, $file
  94          or die "Unable to open $file for reading: $^E";
  95      my @ret = <FILE>;
  96      close FILE
  97          or die "Unable to close $file: $^E";
  98      map { chomp } @ret;
  99  
 100      # Cull empty lines
 101      return grep { /./ } @ret;
 102  }
 103  
 104  # Write some lines to a file.
 105  sub write_file ($@) {
 106      my ($file, @lines) = @_;
 107  
 108      if (scalar @lines > 0) {
 109          my $tmp = "$file.tmp.$$";
 110          open TMP, ">$tmp"
 111              or die "Unable to open $tmp for writing: $^E";
 112          foreach my $line (@lines) {
 113              print TMP "$line\n";
 114          }
 115          close TMP
 116              or die "Unable to close $tmp: $^E";
 117  
 118          rename $tmp, $file
 119              or die "Unable to rename $tmp to $file: $^E";
 120      }
 121      else {
 122          # When file becomes empty, remove it.
 123          unlink $file
 124              or die "Unable to unlink $file: $^E";
 125      }
 126  }
 127  
 128  
 129  # Push one or more commands onto the to-do list.
 130  sub push_todo (@) {
 131      my @new_cmds = @_;
 132  
 133      my @old_cmds = read_file ($todo);
 134      write_file ($todo, @new_cmds, @old_cmds);
 135  }
 136  
 137  # Pop the next command off of the to-do list.  With arg, just peek at
 138  # the next command; do not really pop it off.
 139  sub pop_todo (;$) {
 140      my ($peek) = @_;
 141      my @cmds = read_file ($todo);
 142  
 143      scalar @cmds > 0
 144          or return undef;
 145  
 146      my $ret = shift @cmds;
 147  
 148      $peek
 149          or write_file ($todo, @cmds);
 150  
 151      return $ret;
 152  }
 153  
 154  sub peek_todo () {
 155      return pop_todo (1);
 156  }
 157  
 158  # Add registry entry to make a command run at next logon of current
 159  # user.  If arg is undef, remove the registry entry.
 160  sub run_at_logon (;$) {
 161      my ($cmd) = @_;
 162      my $run_subkey = 'Software/Microsoft/Windows/CurrentVersion/Run/';
 163      my $run_key = (exists $opts{'user'}
 164                     ? "CUser/$run_subkey" : "LMachine/$run_subkey");
 165      my $todocmd = '/ToDoCmd';
 166  
 167      if ($cmd) {
 168          (exists $reg{$run_key})
 169              or $reg{$run_key} = { }
 170                  or die "Unable to create $run_key: $^E";
 171          $reg{$run_key}->{$todocmd} = $cmd
 172              or die "Unable to set $run_key$todocmd to $cmd: $^E";
 173      }
 174      elsif (exists $reg{$run_key}) {
 175          (delete $reg{$run_key}->{$todocmd})
 176              or die "Unable to delete $run_key$todocmd: $^E";
 177      }
 178  }
 179  
 180  # Get Windows version as a canonical string, like "win2ksp4".
 181  sub get_windows_version () {
 182      my $ver_key = "LMachine/SOFTWARE/Microsoft/Windows NT/CurrentVersion";
 183  
 184      my $pn_key = "$ver_key//ProductName";
 185      my $product_name = $reg{$pn_key};
 186      defined $product_name
 187          or die "Unable to get $pn_key: $^E";
 188      my $csd_key = "$ver_key//CSDVersion";
 189      my $csd_version = (exists $reg{$csd_key} ? $reg{$csd_key} : '');
 190      defined $csd_version
 191          or die "Unable to get $csd_key: $^E";
 192  
 193      my $os;
 194      if ($product_name eq 'Microsoft Windows 2000') {
 195          $os = 'win2k';
 196      }
 197      elsif ($product_name eq 'Microsoft Windows XP') {
 198          $os = 'winxp';
 199      }
 200      elsif ($product_name eq 'Microsoft Windows Server 2003') {
 201          $os = 'ws2k3';
 202      }
 203      elsif ($product_name eq 'Microsoft Windows Server 2003 R2') {
 204          $os = 'ws2k3';
 205      }
 206      elsif ($product_name eq 'Windows Vista (TM) Business') {
 207          $os = 'vista';
 208      }
 209      elsif ($product_name eq 'Windows Vista (TM) Ultimate') {
 210          $os = 'vista';
 211      }
 212      else {
 213          die "Unrecognized $pn_key: $product_name";
 214      }
 215  
 216      my $sp;
 217      if ($csd_version eq '') {
 218          $sp = '';
 219      }
 220      # Get a version number (only works up to 9)
 221      elsif ($csd_version =~ /(\d+)/) {
 222          $sp = "sp$1";
 223      }
 224      else {
 225          die "Unrecognized $csd_key: $csd_version";
 226      }
 227  
 228      return "$os$sp";
 229  }
 230  
 231  # Get a handle to the SWbemServices object for this machine.
 232  my $wmi = Win32::OLE->GetObject ('WinMgmts:');
 233  
 234  # Get the three-letter acronym for the language of the running OS.
 235  sub get_windows_language () {
 236      use Win32::OLE;
 237      # Bomb out completely if COM engine encounters any trouble.
 238      Win32::OLE->Option ('Warn' => 3);
 239  
 240      # Get the SWbemObjectSet of Win32_OperatingSystem instances.
 241      my $os_instances = $wmi->InstancesOf ('Win32_OperatingSystem');
 242  
 243      # Convert set to Perl array.
 244      my @oses = Win32::OLE::Enum->All ($os_instances);
 245  
 246      scalar @oses == 1
 247          or die "Internal error (too many OS objects in get_windows_language)";
 248  
 249      # See OSLanguage property in
 250      # <http://msdn.microsoft.com/library/en-us/wmisdk/wmi/win32_operatingsystem.asp>.
 251      # See also <http://www.microsoft.com/globaldev/nlsweb> and
 252      # <http://www.microsoft.com/globaldev/reference/winxp/langtla.mspx>.
 253  
 254      my %lang_table = (
 255                        0x0401 => 'ara',
 256                        0x0404 => 'cht',
 257                        0x0405 => 'csy',
 258                        0x0406 => 'dan',
 259                        0x0407 => 'deu',
 260                        0x0408 => 'ell',
 261                        0x0409 => 'enu',
 262                        0x040a => 'esp',
 263                        0x040b => 'fin',
 264                        0x040c => 'fra',
 265                        0x040d => 'heb',
 266                        0x040e => 'hun',
 267                        0x0410 => 'ita',
 268                        0x0411 => 'jpn',
 269                        0x0412 => 'kor',
 270                        0x0413 => 'nld',
 271                        0x0414 => 'nor',
 272                        0x0415 => 'plk',
 273                        0x0416 => 'ptb',
 274                        0x0418 => 'rom',
 275                        0x0419 => 'rus',
 276                        0x041d => 'sve',
 277                        0x041f => 'trk',
 278                        0x0804 => 'chs',
 279                        0x0816 => 'ptg',
 280                        0x0c0a => 'esn',
 281                        );
 282  
 283      my $langid = $oses[0]->OSLanguage;
 284      (defined $lang_table{$langid})
 285          or die sprintf "Unknown language ID 0x%04X", $langid;
 286  
 287      return $lang_table{$langid};
 288  }
 289  
 290  # Get the name of the local Administrators group, which varies by
 291  # language.
 292  sub get_administrators_group () {
 293      # Lookup by well-known SID.  See
 294      # <http://support.microsoft.com/?id=243330> and
 295      # <http://msdn.microsoft.com/library/en-us/wmisdk/wmi/win32_sid.asp>.
 296  
 297      my $admin_sid = $wmi->Get ('Win32_SID.SID="S-1-5-32-544"');
 298      return $admin_sid->{'AccountName'};
 299  }
 300  
 301  # For input letter X, return the UNC path to which X: is connected.
 302  # If X is a not a networked drive, return "X:".
 303  use constant ERROR_NOT_CONNECTED => 2250;
 304  sub get_drive_path ($) {
 305      my ($drive) = @_;
 306      my $ret;
 307  
 308      $drive =~ /^[a-z]:?$/i
 309          or die "Invalid drive specification $drive";
 310  
 311      # Add colon if needed.
 312      $drive =~ /:$/
 313          or $drive .= ':';
 314  
 315      if (Win32::NetResource::GetUNCName ($ret, $drive)) {
 316          # all done
 317      }
 318      elsif ($^E == ERROR_NOT_CONNECTED) {
 319          # Not a network drive, so just return the drive letter itself.
 320          $ret = $drive;
 321      }
 322      else {
 323          die "Unable to GetUNCName for $drive: $^E";
 324      }
 325  
 326      return $ret;
 327  }
 328  
 329  # Arrange to run ourselves at next logon.
 330  sub run_ourselves_at_logon () {
 331      my $user_arg = (exists $opts{'user'} ? ' --user' : '');
 332      run_at_logon ("$mapznrun $0" . $user_arg . ' --go');
 333  }
 334  
 335  # Set up console for single-character input and autoflush output.
 336  my $console = new Win32::Console (STD_INPUT_HANDLE)
 337      or die "Unable to create STDIN console: $^E";
 338  
 339  $| = 1;
 340  
 341  # Run a command, including handling of pseudo-commands (like .reboot).
 342  # If second arg is true, return exit status ($?) instead of bombing if
 343  # non-zero.
 344  sub do_cmd ($;$);
 345  sub do_cmd ($;$) {
 346      my ($cmd, $no_bomb) = @_;
 347      my $ret;
 348  
 349      if ($cmd =~ /^\./) {
 350          if ($cmd eq '.reboot') {
 351              # If the to-do list is not empty, arrange to run ourselves
 352              # after reboot.
 353              my $next_cmd = peek_todo ();
 354              defined $next_cmd
 355                  and run_ourselves_at_logon ();
 356              reboot (5);
 357              die 'Internal error';
 358          }
 359          elsif ($cmd =~ /^\.expect-reboot\s+(.*)$/) {
 360              my $new_cmd = $1;
 361              # If the to-do list is not empty, arrange to run ourselves
 362              # after reboot.
 363              my $next_cmd = peek_todo ();
 364              defined $next_cmd
 365                  and run_ourselves_at_logon ();
 366              do_cmd ($new_cmd);
 367              print "Expecting previous command to reboot; exiting.\n";
 368              exit 0;
 369          }
 370          elsif ($cmd =~ /^\.reboot-on\s+(\d+)\s+(.*)$/) {
 371              my ($err_to_reboot, $new_cmd) = ($1, $2);
 372              my $status = do_cmd ($new_cmd, 1);
 373  
 374              if ($status == $err_to_reboot << 8) {
 375                  print "$new_cmd exited status $err_to_reboot; rebooting.\n";
 376                  do_cmd ('.reboot');
 377                  die 'Internal error';
 378              }
 379  
 380              $ret = $status;
 381          }
 382          elsif ($cmd =~ /^\.missing-ok\s+(.*)$/) {
 383              my $new_cmd = $1;
 384              my $status = do_cmd ($new_cmd, 1);
 385  
 386              $status == 1 << 8
 387                  and $status = 0;
 388  
 389              $ret = $status;
 390          }
 391          elsif ($cmd =~ /^\.ignore-err\s+(\d+)\s+(.*)$/) {
 392              my ($err_to_ignore, $new_cmd) = ($1, $2);
 393              my $status = do_cmd ($new_cmd, 1);
 394  
 395              $status == $err_to_ignore << 8
 396                  and $status = 0;
 397  
 398              $ret = $status;
 399          }
 400          elsif ($cmd =~ /^\.ignore-all-err\s+(.*)$/) {
 401              my $new_cmd = $1;
 402              my $status = do_cmd ($new_cmd, 1);
 403              my $real_status = $status >> 8;
 404  
 405              if ($real_status == 0) {
 406                  $ret = 0;
 407              } elsif ($real_status == 1) {
 408                  $ret = 1;
 409              } else {
 410                  $ret = 0;
 411              }
 412          }
 413          elsif ($cmd =~ /^\.sleep\s+(\d+)$/) {
 414              my ($secs) = $1;
 415              print "Sleeping $secs seconds...";
 416              sleep $secs;
 417              print "done.\n";
 418              $ret = 0;
 419          }
 420          else {
 421              die "Unrecognized pseudo-command $cmd";
 422          }
 423      }
 424      else {
 425          print "Running: $cmd\n";
 426          my $status = system $cmd;
 427          $ret = $status;
 428      }
 429  
 430      defined $ret
 431          or die 'Internal error';
 432  
 433      unless ($no_bomb) {
 434          while ($ret != 0) {
 435              print "$cmd failed, status ", $ret >> 8, ' (', $ret % 256, ')', "\n";
 436              print "A)bort R)etry I)gnore ? ";
 437              my $old_mode = $console->Mode (ENABLE_PROCESSED_INPUT);
 438              defined $old_mode
 439                  or die "Unable to set mode on console: %^E";
 440  
 441              my $key = $console->InputChar (1);
 442              defined $key
 443                  or die "InputChar failed: $^E";
 444  
 445              defined $console->Mode ($old_mode)
 446                  or die "Unable to reset mode on console: %^E";
 447  
 448              $key = uc $key;
 449              if ($key eq 'A') {
 450                  die "Aborting.\n";
 451              }
 452              elsif ($key eq 'R') {
 453                  print "\nRetrying...\n";
 454                  return do_cmd ($cmd);
 455              }
 456              elsif ($key eq 'I') {
 457                  print "\nIgnoring.\n";
 458                  $ret = 0;
 459              }
 460          }
 461      }
 462  
 463      return $ret;
 464  }
 465  
 466  exists $opts{'user'} || are_we_administrator ()
 467      or die 'Error: Not Administrator and --user not supplied';
 468  
 469  if (exists $opts{'go'}) {
 470      @ARGV == 0
 471          or pod2usage (2);
 472  
 473      # Prevent re-entrancy.
 474      (exists $ENV{'_IN_TODO'})
 475          and exit 0;
 476      $ENV{'_IN_TODO'} = 'yes';
 477  
 478      # Add "bin" and "scripts" directories to PATH.
 479      $ENV{'PATH'} = "$z\\bin;$z\\scripts;$ENV{'PATH'}";
 480  
 481      # Set handy "WINVER" environment variable.
 482      $ENV{'WINVER'} = get_windows_version ();
 483  
 484      # Set handy "WINLANG" environment variable.
 485      $ENV{'WINLANG'} = get_windows_language ();
 486  
 487      # Set handy "Z_PATH" environment variable.
 488      $ENV{'Z_PATH'} = get_drive_path ($z);
 489  
 490      # Set "Administrators" environment variable to local
 491      # Administrators group.
 492      $ENV{'Administrators'} = get_administrators_group ();
 493  
 494      # Disable running ourselves after reboot.
 495      run_at_logon ();
 496  
 497      while (defined (my $cmd = pop_todo ())) {
 498          do_cmd ($cmd);
 499      }
 500  }
 501  else {
 502      # Default behavior is to push one or more commands onto the todo
 503      # list.
 504      @ARGV > 0
 505          or pod2usage (2);
 506      push_todo (@ARGV);
 507  }
 508  
 509  exit 0;
 510  
 511  __END__
 512  
 513  =head1 NAME
 514  
 515  todo.pl - Manage the to-do list
 516  
 517  =head1 SYNOPSIS
 518  
 519  todo.pl [ options ] <commands...>
 520  
 521  =head1 OPTIONS
 522  
 523  --help          Display help and exit
 524  --go            Process the to-do list
 525  --user          Run in "per user" mode
 526  
 527  =head1 DESCRIPTION
 528  
 529  todo.pl manages the "to do" list, a plain-text file in
 530  %SystemDrive%\netinst\todo.txt.
 531  
 532  Normally, it simply prepends its arguments to the list.
 533  
 534  If invoked with --go, it removes commands from the list one at a time
 535  and executes them in a controlled environment.  If todo.pl encounters
 536  a ".reboot" command which is not the final command, it hooks the
 537  registry to run itself at next logon and reboots the machine.
 538  
 539  If invoked without --user, todo.pl hooks HKEY_LOCAL_MACHINE to run
 540  itself at next logon.  So no matter who logs on next, todo.pl will be
 541  invoked.  If invoked with --user, todo.pl hooks HKEY_CURRENT_USER
 542  instead, so it will only run when the same user logs on next.
 543  
 544  =head1 SEE ALSO
 545  L<http://unattended.sourceforge.net/apps.html#todo>