| [ Index ] |
PHP Cross Reference of Unnamed Project |
[Summary view] [Print] [Text view]
1 use warnings; 2 use strict; 3 4 use Carp; 5 use File::Spec::Win32; 6 use File::Copy; 7 use Unattend::IniFile; 8 use Unattend::WinMedia; 9 10 # File::Spec is supposed to auto-detect the OS and adapt 11 # appropriately, but it does not recognize a $^O value of "dos". Work 12 # around this bug here. 13 my $file_spec = 'File::Spec::Win32'; 14 15 # Global variable holding unattend.txt file which we are generating. 16 use vars qw ($u); 17 $u = new Unattend::IniFile; 18 19 # We might be running on Linux now... 20 my $is_linux; 21 BEGIN { 22 if ($^O eq 'dos') { 23 $is_linux = 0; 24 } 25 elsif ($^O eq 'linux') { 26 $is_linux = 1; 27 require Unattend::HotKey; 28 import Unattend::HotKey; 29 } 30 else { 31 die "internal error"; 32 } 33 } 34 35 # ...so we have to exercise some care whenever we talk to the 36 # filesystem. This function converts DOS-style path names to 37 # Unix-style when running on Unix. 38 sub dos_to_host ($) { 39 my ($file) = @_; 40 $is_linux 41 or return $file; 42 my ($vol, $dir, $basename) = $file_spec->splitpath ($file); 43 # Convert Z: to z, C: to c, etc. 44 my ($letter) = ($vol =~ /^([a-z]):$/i); 45 defined $letter 46 or die "internal error converting path '$file'"; 47 48 # Canonicalize drive letter to lowercase. Perhaps we should do 49 # this for the entire path, but smbfs (at least) is 50 # case-insensitive so we will not bother. 51 $letter = lc $letter; 52 53 my @dirs = $file_spec->splitdir ($dir); 54 55 my $host_dir = File::Spec::Unix->catdir ('/', $letter, @dirs); 56 my $ret = File::Spec::Unix->catpath ('', $host_dir, $basename); 57 return $ret; 58 } 59 60 # Tell Unnattend::WinMedia module how to convert dos filenames to host 61 # filenames. 62 Unattend::WinMedia->set_dos_to_host (\&dos_to_host); 63 64 # Ensure prompts are printed promptly. 65 $| = 1; 66 67 ## "choice" implementation, generic between DOS and Unix. 68 sub choice ($;$) { 69 my ($prompt, $choices) = @_; 70 my $ret; 71 72 defined $choices 73 or $choices = 'YN'; 74 75 # Canonicalize stuff to uppercase 76 $choices = uc $choices; 77 78 if ($is_linux) { 79 my %choice_map; 80 foreach my $i (0 .. (length $choices) - 1) { 81 my $char = substr $choices, $i, 1; 82 $choice_map{$char} = $i; 83 } 84 print "$prompt [$choices] "; 85 my $key; 86 while (1) { 87 $key = readkey (); 88 $key = uc $key; 89 (exists $choice_map{$key}) 90 and last; 91 } 92 print "$key\n"; 93 $ret = $choice_map{$key}; 94 } 95 else { 96 system 'choice', "/c:$choices", $prompt; 97 $ret = ($? >> 8) - 1; 98 } 99 100 return $ret; 101 } 102 103 ## Handy general-purpose subroutines for asking questions. 104 105 ## patch se3-unattended : clavier fr 106 system "loadkeys fr"; 107 108 # Ask a simple question. 109 sub simple_q ($) { 110 my ($question) = @_; 111 print "\n", $question; 112 my $answer = <STDIN>; 113 chomp $answer; 114 $answer eq '' 115 and undef $answer; 116 return $answer; 117 } 118 119 # Ask a yes/no question. 120 sub yes_no_choice ($) { 121 my ($question) = @_; 122 print "\n"; 123 return (choice ($question) == 0 ? 1 : 0); 124 } 125 126 # Ask for a password. 127 sub password_q ($) { 128 my ($prompt) = @_; 129 my $ret; 130 131 if ($is_linux) { 132 while (1) { 133 print "\n", $prompt; 134 # Maximum length of Windows passwords is 14. I think. 135 $ret = read_secret (14); 136 print 'Re-enter to confirm: '; 137 my $again = read_secret (14); 138 $ret eq $again 139 and last; 140 print "*** Passwords do not match! Try again.\n"; 141 } 142 } 143 else { 144 # Passwords echo on DOS. Oh, well. 145 $ret = simple_q ($prompt); 146 } 147 148 return $ret; 149 } 150 151 # Create a menu of options. Takes an even number of arguments which 152 # are display / return pairs. For example: 153 # 154 # menu_choice ('option X' => 'foo', 'option Y' => 'bar') 155 # 156 # ...returns 'foo' if the user selects option X and 'bar' if the user 157 # selects option Y. 158 sub menu_choice (@) { 159 my @args = @_; 160 my @choice_map; 161 my $opts = { }; 162 163 # Current page 164 my $page = 0; 165 # Prompt 166 my $prompt = ''; 167 168 ref $args[0] eq 'HASH' 169 and $opts = shift @args; 170 171 # Process magic options hash. 172 foreach my $key (keys %$opts) { 173 if ($key eq 'page') { 174 $page = $opts->{$key}; 175 } 176 elsif ($key eq 'prompt') { 177 $prompt = $opts->{$key} . "\n"; 178 } 179 } 180 181 scalar @args % 2 == 0 182 or croak "menu_choice called with odd number of arguments"; 183 184 # Total number of choices 185 my $count = scalar @args / 2; 186 187 # Choices to display per page 188 my $per_page = 20; 189 190 #Array with 20 Options 191 my %hexarray = (10,'A',11,'B',12,'C',13,'D',14,'E',15,'F',16,'G',17,'H',18,'I',19,'J',20,'K'); 192 193 my $pages = int(($count + $per_page - 1) / $per_page); 194 195 my $ret; 196 LOOP: 197 while (1) { 198 print "\n$prompt"; 199 $pages > 1 200 and printf "(Page %d/%d)\n", $page+1, $pages; 201 202 my $start = $page * $per_page; 203 204 my $i = 0; 205 my $choices = ''; 206 207 # Generate current page of choices. 208 while ($i < $per_page && $start + $i < $count) { 209 my $elt = 2 * ($start + $i); 210 #my $hexd = sprintf '%X', $i+1; 211 my $hexd = $i+1; 212 if ($hexd>9) { 213 $hexd = $hexarray{$hexd}; 214 } 215 print "$hexd) $args[$elt]\n"; 216 $choices .= $hexd; 217 # Capture value for sub below 218 my $val = $args[$elt + 1]; 219 $choice_map[$i] = sub { no warnings 'exiting'; 220 $ret = $val; 221 last LOOP; 222 }; 223 $i++; 224 } 225 226 # If we have multiple pages, generate Next/Previous option. 227 if ($pages > 1) { 228 print "N/P) Next/Previous page\n"; 229 $choices .= 'N'; 230 $choice_map[$i] = sub { $page = ($page + 1) % $pages }; 231 $i++; 232 $choices .= 'P'; 233 $choice_map[$i] = sub { $page = ($page + $pages - 1) % $pages }; 234 $i++; 235 } 236 237 print "X) Exit this program\n"; 238 $choices .= 'X'; 239 $choice_map[$i] = sub { print "Exiting.\n"; exit 1; }; 240 $i++; 241 242 my $sel = choice ('Select: ', $choices); 243 244 my $func = $choice_map[$sel]; 245 &$func (); 246 } 247 248 # Record which page we ended up on 249 $opts->{'page'} = $page; 250 251 return $ret; 252 } 253 254 # Select from among zero or more strings. 255 sub multi_choice (@) { 256 my ($prompt, @strings) = @_; 257 258 scalar @strings > 0 259 or return (); 260 261 my %selected = map { $_ => 0 } @strings; 262 263 my $menu_state = { 'prompt' => $prompt }; 264 265 LOOP: 266 while (1) { 267 my @choices = 268 ('Select/deselect all' => 269 sub { my $sel = (0 < scalar grep { $selected{$_} == 0 270 } @strings); 271 # If anything is not selected, select all; else, 272 # deselect all. 273 %selected = map { $_ => $sel } @strings; 274 }, 275 'All done ; continue' => 276 sub { 277 no warnings 'exiting'; 278 last LOOP; 279 }, 280 map { 281 my $str = $_; 282 (sprintf "[%s] %s", $selected{$str} ? '*' : ' ', $str) 283 => sub { $selected{$str} = !$selected{$str} } 284 } @strings, 285 ); 286 287 my $func = menu_choice ($menu_state, @choices); 288 &$func (); 289 } 290 291 my %sort_index; 292 foreach my $i (0 .. scalar @strings - 1) { 293 $sort_index{$strings[$i]} = $i; 294 } 295 296 my @selections = grep { $selected{$_} } keys %selected; 297 return sort { $sort_index{$a} <=> $sort_index {$b} } @selections; 298 } 299 300 # Canonicalize a username with respect to a domain. If username is 301 # already in fully-qualified form DOMAIN\USER, do nothing. 302 sub canonicalize_user ($$) { 303 my ($domain, $user) = @_; 304 $user =~ /\\/ 305 or $user = "$domain\\$user"; 306 return $user; 307 } 308 309 # Read a file. Return array of its lines. 310 sub read_file ($) { 311 my ($file) = @_; 312 local *FILE; 313 314 open FILE, dos_to_host ($file) 315 or croak "Unable to open $file for reading: $^E"; 316 317 $is_linux 318 and binmode FILE, ':crlf'; 319 320 my @ret = <FILE>; 321 322 close FILE 323 or croak "Unable to close $file: $^E"; 324 325 return @ret; 326 } 327 328 # Write a bunch of lines to a file. 329 sub write_file ($@) { 330 my ($file, @lines) = @_; 331 local *FILE; 332 333 my $host_file = dos_to_host ($file); 334 335 open FILE, ">$host_file" 336 or die "Unable to open $file for writing: $^E"; 337 338 $is_linux 339 and binmode FILE, ':crlf'; 340 341 foreach my $line (@lines) { 342 print FILE $line, "\n"; 343 } 344 345 close FILE 346 or die "Unable to close $file: $^E"; 347 } 348 349 # Write a new master boot record. 350 sub linux_write_mbr ($) { 351 my ($boot_file) = @_; 352 353 $is_linux 354 or croak 'internal error'; 355 356 use bytes; 357 use Fcntl; 358 359 my $mbr_size = 446; 360 my $sect_size = 512; 361 362 my $bootsect = ''; 363 my $disk = '/dev/dsk'; 364 365 # Read the current master boot sector 366 sysopen DISK, $disk, O_RDONLY 367 or die "Unable to open $disk for reading: $^E"; 368 sysread DISK, $bootsect, $sect_size 369 or die "Unable to read from $disk: $^E"; 370 close DISK 371 or die "Unable to close $disk: $^E"; 372 373 my $new_mbr = ''; 374 # Overwrite the MBR portion 375 open BOOT, $boot_file 376 or croak "Unable to open $boot_file for reading: $^E"; 377 read BOOT, $new_mbr, $mbr_size 378 or die "Unable to read from $boot_file: $^E"; 379 close BOOT 380 or croak "Unable to close $boot_file: $^E"; 381 382 print "Installing $boot_file as MBR..."; 383 384 substr($bootsect, 0, $mbr_size, 385 substr($new_mbr, 0, $mbr_size)); 386 387 # Set the magic cookie to indicate a valid boot sector 388 substr($bootsect, -2, 1, chr 0x55); 389 substr($bootsect, -1, 1, chr 0xAA); 390 391 # Write out the new master boot sector 392 sysopen DISK, $disk, O_WRONLY 393 or die "Unable to open $disk for writing: $^E"; 394 syswrite DISK, $bootsect, $sect_size 395 or die "Unable to write boot sector to $disk: $^E"; 396 close DISK 397 or die "Unable to close write to $disk: $^E"; 398 399 print "done.\n"; 400 } 401 402 # Run a command and return the output. We need this function because 403 # pipes and backticks do not work under DJGPP Perl. 404 # Only works under DOS. 405 sub run_command ($@) { 406 my ($cmd, @expected_statuses) = @_; 407 408 $is_linux 409 and croak 'internal error'; 410 411 defined $expected_statuses[0] 412 or @expected_statuses = (0); 413 414 my %status_hash = map { $_ => undef } @expected_statuses; 415 416 my $tmpfile = $u->{'_meta'}->{'tmpdrive'}.'\\tmp.txt'; 417 418 my $ret = system "$cmd > $tmpfile < nul"; 419 my $status = $ret >> 8; 420 (exists $status_hash{$status}) 421 or die "$cmd > $tmpfile failed, unexpected status $status"; 422 423 my @ret = ""; 424 425 if (-e $tmpfile) { 426 @ret = read_file ($tmpfile); 427 } else { 428 # probably we are booting from read-only device 429 $ret = system "$cmd < nul"; 430 } 431 # Maybe we should remove $tmpfile here, but that would slow 432 # things down and hinder debugging so we don't. 433 # unlink $tmpfile 434 # or die "Unable to remove $tmpfile: $^E"; 435 436 return @ret; 437 } 438 439 # Cache return value. 440 my $_partition_table; 441 # Returns cached value unless argument is true. 442 sub partition_table (;$) { 443 my ($re_read) = @_; 444 445 if (!defined $_partition_table || $re_read) { 446 $_partition_table = ($is_linux 447 ? "\n\n" . `parted -s /dev/dsk print` 448 : join '', run_command ('fdisk /info /tech')); 449 } 450 451 return $_partition_table; 452 } 453 454 ## Functions for asking about particular settings. 455 456 # Large disk support 457 sub ask_fdisk_lba () { 458 $is_linux 459 and return undef; 460 return menu_choice 461 ('Large (>8G) disk support (normal)' => 1, 462 'No large disk support (required for some broken BIOSes)' => 0); 463 } 464 465 # Return size of disk in 512-byte sectors. 466 my $_disk_sectors; 467 sub get_disk_sectors () { 468 $is_linux 469 or croak 'internal error'; 470 471 if (!defined $_disk_sectors) { 472 my $hda = readlink ('/dev/dsk'); 473 defined $hda 474 or die "readlink /dev/dsk failed: $^E"; 475 476 # Get size of disk in sectors. 477 my $sys_hda = $hda; 478 $sys_hda =~ s/\//!/g; 479 my $size_file = "/sys/block/$sys_hda/size"; 480 open SIZE, $size_file 481 or die "Unable to open $size_file for reading: $^E"; 482 my $size = <SIZE>; 483 defined $size 484 or die "Unable to read $size_file: $^E"; 485 close SIZE 486 or die "Unable to close $size_file: $^E"; 487 chomp $size; 488 $size =~ /^0x/ 489 and $size = hex $size; 490 $_disk_sectors = $size; 491 } 492 493 return $_disk_sectors; 494 } 495 496 # Calculate end of disk in megabytes. 497 sub disk_end () { 498 $is_linux 499 or croak 'internal error'; 500 return get_disk_sectors () * 512 / 1024 / 1024; 501 } 502 503 # Find the largest interval of free space on the drive which does not 504 # overlap other partitions. If argument is true, find space for 505 # creating a logical partition (i.e., within the extended partition). 506 # Return as a pair (START, END) where each is in megabytes from start 507 # of disk. 508 sub find_free_space ($) { 509 my ($logical) = @_; 510 511 $is_linux 512 or croak 'internal error'; 513 514 my @partitions; 515 my ($ext_start, $ext_end); 516 517 # Read the current partition table. 518 my $cmd = 'parted -s /dev/dsk print'; 519 open PARTED, "$cmd|" 520 or die "Unable to fork: $^E"; 521 522 while (my $line = <PARTED>) { 523 my ($start, $end, $parttype) = 524 ($line =~ /^\d+\s+(\d+\.\d{3})\s+(\d+\.\d{3})\s+(primary|logical|extended)/); 525 defined $start && defined $end && defined $parttype 526 or next; 527 528 print "DEBUG: PARTED_VAR START:$start END:$end PARTTYPE:$parttype \n" ; 529 if ($logical && $parttype eq 'extended') { 530 # If multiple extended partitions (weird), use the first. 531 defined $ext_start && defined $ext_end 532 and next; 533 ($ext_start, $ext_end) = ($start, $end); 534 } 535 else { 536 push @partitions, [ $start, $end ]; 537 } 538 } 539 540 close PARTED 541 or die "'$cmd' failed: $^E $?"; 542 543 # Default is to search entire disk. 544 my ($search_start, $search_end) = (0, disk_end()); 545 546 # For logical partition creation, search extended partition. 547 if ($logical) { 548 defined $ext_start && defined $ext_end 549 or die 'Error: No extended partition found for logical partition'; 550 ($search_start, $search_end) = ($ext_start, $ext_end); 551 } 552 553 # Keep track of best result so far. 554 my ($best_start, $best_end) = (0, 0); 555 556 # Now loop through looking for free space. 557 LOOP: 558 foreach my $part ([0, $search_start], @partitions) { 559 # Try fitting new partition in just after this one. 560 my $start = $part->[1]; 561 my $end = $search_end; 562 foreach my $other (@partitions, [ $search_end, disk_end () ]) { 563 # Each other partition may or may not constrain us. 564 my ($other_start, $other_end) = @$other; 565 if ($start >= $other_end) { 566 # Partition ends before we start, so no worries. 567 } 568 elsif ($end > $other_start) { 569 # We must end before the other partition starts. 570 $end = $other_start; 571 } 572 } 573 574 # Keep track of the best we have found. 575 $end - $start > $best_end - $best_start 576 and ($best_start, $best_end) = ($start, $end); 577 } 578 579 return ($best_start, $best_end); 580 } 581 582 # Convert an fdisk command to a parted command, more or less. 583 sub convert_fdisk_parted ($) { 584 my ($fdisk_cmd) = @_; 585 my $ret; 586 587 # "--" is required, lest "-0" on the command line look like an 588 # option. 589 my $parted = 'parted -s /dev/dsk --'; 590 591 my ($cmd) = ($fdisk_cmd =~ /^\s*fdisk\s+(.*?)\s*\z/i); 592 defined $cmd 593 or croak "Internal error: Cannot convert '$fdisk_cmd'"; 594 595 if ($cmd =~ /^\/clear\s+1\z/i) { 596 $ret = "$parted mklabel msdos"; 597 print "DEBUG: $ret \n"; 598 } 599 elsif ($cmd =~ /^\/delete\s+\/pri:(\d+)\z/i) { 600 $ret = "$parted rm $1"; 601 print "DEBUG: $ret \n"; 602 } 603 elsif ($cmd =~ /^\/activate:(\d+)\z/i) { 604 $ret = "$parted set $1 boot on"; 605 print "DEBUG: $ret \n"; 606 } 607 elsif ($cmd =~ /^\/xo/i) { 608 $ret = 'parted /dev/dsk'; 609 print "DEBUG: $ret \n"; 610 } 611 elsif ($cmd =~ /\/(pri|log|ext)(o)?:(\d+)(,100)?(?:\s+\/spec:(\d+))?/i) { 612 my ($ptype, $fat16, $size, $is_percent, $type) = 613 ($1, $2, $3, $4, $5); 614 615 # Map partition type numbers to Parted names. 616 my %type_map = (7 => 'ntfs', 617 130 => 'linux-swap', 618 131 => 'ext2'); 619 620 my ($start, $end) = find_free_space ($ptype eq 'log'); 621 622 defined $is_percent 623 and $size = disk_end () * ($size / 100); 624 625 # If the available space is more than we need, shrink it. 626 $end - $start > $size 627 and $end = $start + $size; 628 629 # Sanity-check size of FAT16 partitions. 630 defined $fat16 && $end - $start > 2047 631 and die "Unable to execute fdisk $cmd\n" 632 . "because it would create a FAT16 partition > 2047M\n" 633 . "I suggest using /pri:XXX instead of /prio:XXX\n" 634 . 'Bailing out'; 635 636 # Magic Parted syntax for end of disk. 637 $end == disk_end () 638 and $end = '-0'; 639 640 my $fs = (defined $fat16 ? 'fat16' : 'fat32'); 641 my $parttype; 642 if (defined $type) { 643 (exists $type_map{$type}) 644 or croak "Unknown type $type in fdisk command ($fdisk_cmd)"; 645 $fs = $type_map{$type}; 646 } 647 648 if ($ptype eq 'pri') { $parttype = 'primary' } 649 elsif ($ptype eq 'log') { $parttype = 'logical' } 650 elsif ($ptype eq 'ext') { $parttype = 'extended'; $fs='' } 651 652 if (($ptype eq 'ext') or ($fs eq 'ntfs')) { 653 $ret = "$parted mkpart $parttype $fs $start $end"; 654 } else { 655 $ret = "$parted mkpartfs $parttype $fs $start $end"; 656 } 657 print "DEBUG: $ret \n"; 658 } 659 else { 660 die "Unable to convert '$fdisk_cmd' to Parted commands; bailing"; 661 } 662 663 return $ret; 664 } 665 666 # fdisk commands to run 667 sub ask_fdisk_cmds () { 668 # Read current partition table. 669 print "\nCurrent partition table:"; 670 my $partition_layout = partition_table (); 671 672 # Display it. 673 print $partition_layout; 674 print "\n"; 675 676 print "Choose partitioning scheme.\n"; 677 $is_linux 678 or print "NOTE: If partition table changes, machine will reboot.\n"; 679 # Commands to erase partition table 680 my $pre_cmds = 'fdisk /clear 1'; 681 682 # Commands to replace the first partition with a 4G FAT32 683 # partition and activate it 684 my $post_cmds = 'fdisk /delete /pri:1;fdisk /pri:4000;fdisk /activate:1'; 685 686 # Command to run fdisk interactively 687 my $interactive_cmd = 'fdisk /xo'; 688 689 my $ret = menu_choice 690 ('Do nothing (continue)' => undef, 691 'Run partitioning tool manually (experts only)' => $interactive_cmd, 692 'Whole disk C:', => 693 'fdisk /pri:100,100', 694 '12G C:, rest D:' => 695 'fdisk /pri:12288;fdisk /pri:100,100 /spec:7', 696 '12G C:, 5G D:, rest E:' => 697 'fdisk /pri:12288;fdisk /pri:5120 /spec:7;fdisk /pri:100,100 /spec:7', 698 '50% C:, 50% D:' => 699 'fdisk /pri:50,100;fdisk /pri:50,100 /spec:7', 700 ); 701 702 defined $ret 703 or return undef; 704 705 $ret eq $interactive_cmd 706 or $ret = "$pre_cmds;$ret;$post_cmds"; 707 708 return $ret; 709 } 710 711 # Check that a directory name complies with "old DOS" criteria; i.e., 712 # that it contains only 8+3 components. Particularly needed because 713 # Linux allows longer filenames, but harmless as a sanity check even 714 # under DOS. 715 sub validate_old_dos_dir ($) { 716 my ($name) = @_; 717 718 my (undef, $dirs, undef) = $file_spec->splitpath ($name, 1); 719 my @dirs = $file_spec->splitdir ($dirs); 720 721 foreach my $dir (@dirs) { 722 my $failure = ''; 723 my ($base, $ext) = $dir =~ /^(.*?)(?:\.(.*))?\z/; 724 725 # Check "impossible" cases first. 726 $base =~ /\\/ 727 || defined $ext && ($ext =~ /\\/) 728 and die 'Internal error'; 729 730 if (length $base > 8) { 731 $failure = "'$base' has more than eight characters"; 732 } 733 elsif ($ext =~ /\./) { 734 $failure = "'$dir' contains more than one dot"; 735 } 736 elsif (defined $ext) { 737 if (length $ext > 3) { 738 $failure = "Extension '$ext' has more than three characters"; 739 } 740 } 741 $failure eq '' 742 or die "'$name' is invalid because:\n$failure.\nBailing out"; 743 } 744 } 745 746 # Which OS to install 747 sub ask_os () { 748 my $os_dir = $u->{'_meta'}->{'os_dir'}; 749 750 print "Scanning for OS directories under $os_dir...\n"; 751 752 opendir OSDIR, dos_to_host ($os_dir) 753 or die "Unable to opendir $os_dir: $^E"; 754 755 my @media_objs; 756 while (my $ent = readdir OSDIR) { 757 $ent eq '.' || $ent eq '..' 758 and next; 759 760 my $full_path = $file_spec->catdir ($os_dir, $ent); 761 -d dos_to_host ($full_path) 762 or next; 763 764 my $media = Unattend::WinMedia->new ($full_path); 765 defined $media 766 or next; 767 push @media_objs, $media; 768 } 769 770 closedir OSDIR 771 or die "Unable to closedir $os_dir: $^E"; 772 773 exists $media_objs[0] 774 or die "None found! bailing"; 775 776 unless (exists $media_objs[1]) { 777 my $only = $media_objs[0]->path (); 778 $media_objs[0]->cache (); 779 print "$only is the only OS directory I found; using it.\n"; 780 return $only; 781 } 782 783 print "Please choose the OS to install:\n"; 784 my $choice = 785 menu_choice (map { $_->full_name () . ' (' . $_->path () . ')' 786 => $_ } 787 sort { $a->full_name () cmp $b->full_name () } 788 @media_objs); 789 $choice->cache (); 790 validate_old_dos_dir ($choice->path ()); 791 return $choice->path (); 792 } 793 794 # Which directories to include in OemPnPDriversPath 795 sub ask_oem_pnp_drivers_path () { 796 my $media_obj = Unattend::WinMedia->new ($u->{'_meta'}->{'OS_media'}); 797 798 my @pnp_driver_dirs = $media_obj->oem_pnp_dirs (1); 799 800 # No driver directories means no drivers path 801 scalar @pnp_driver_dirs > 0 802 or return undef; 803 804 print "...found some driver directories.\n"; 805 806 my @selected_dirs = multi_choice ('Please choose driver(s) to add.', 807 sort @pnp_driver_dirs); 808 809 my $ret = join ';', @selected_dirs; 810 811 # Setup does not like empty OemPnPDriversPath 812 $ret =~ /\S/ 813 or undef $ret; 814 815 return $ret; 816 } 817 818 # Create the "postinst.bat" script and return its full path. Do 819 # nothing and return undef if there are no post-installation commands 820 # to run. 821 sub create_postinst_bat () { 822 # Create postinst.bat script. 823 # Compute contents of postinst.bat script. 824 my @postinst_lines; 825 826 # Local admins 827 my $admins = $u->{'_meta'}->{'local_admins'}; 828 my @admins = (defined $admins ? split /;/, $admins : ()); 829 @admins = map { canonicalize_user 830 ($u->{'Identification'}->{'JoinDomain'}, 831 $_) } @admins; 832 # NTP servers 833 my $ntp_servers = $u->{'_meta'}->{'ntp_servers'}; 834 defined $ntp_servers && $ntp_servers ne '' 835 and push @postinst_lines, "net time /setsntp:\"$ntp_servers\""; 836 837 my $netinst = $u->{'_meta'}->{'netinst'}; 838 839 my $tempcred = $file_spec->catfile ($netinst, 'tempcred.bat'); 840 push @postinst_lines, 841 ('if exist %Z%\\scripts\\antivirus.bat call %Z%\\scripts\\antivirus.bat', 842 # Pour installer l'antivirus au plus vite : ci-dessus... 843 # Pour rapport se3-unattended a se3-clonage sur SE3 : ci-dessous... 844 'time /T >> %SystemDrive%\\netinst\\finwin.txt', 845 'call %Z%\\scripts\\perl.bat', 846 'PATH=%Z%\\bin;%PATH%', 847 # Last step is always a reboot. 848 'todo.pl .reboot', 849 # Penultimate step is to disable automatic logon. 850 'todo.pl "' . $u->{'_meta'}->{'autolog'} . '"', 851 # Antepenultimate step is to delete credentials file. 852 "todo.pl \"del $tempcred\"", 853 # After installing, re-enable System Restore. 854 'todo.pl "srconfig.pl --enable"', 855 # Before that, add users to the local Administrators group. 856 (map { "todo.pl \"net localgroup \\\"%%Administrateurs%%\\\" \\\"$_\\\" /add\"" } @admins)); 857 858 # Leveled installation scripts 859 my $top = $u->{'_meta'}->{'top'}; 860 my $middle = $u->{'_meta'}->{'middle'}; 861 my $bottom = $u->{'_meta'}->{'bottom'}; 862 my @top_scripts = split /;/, $top; 863 my @middle_scripts = split /;/, $middle; 864 my @bottom_scripts = split /;/, $bottom; 865 push @postinst_lines, 866 # Before that, run the "cleanup" scripts. 867 (map { "todo.pl %Z%\\scripts\\$_" } reverse @bottom_scripts), 868 # Before that, run the optional scripts. 869 (map { "todo.pl %Z%\\scripts\\$_" } reverse @middle_scripts), 870 # First step is to perform top-level install of master and 871 # optional scripts. 872 (map { "todo.pl %Z%\\scripts\\$_" } reverse @top_scripts); 873 874 push @postinst_lines, 875 # Before installing disable System Restore. 876 'todo.pl "srconfig.pl --disable"', 877 # First thing is to clean up installation mess. 878 'todo.pl hidepw.pl bootini.pl fixtz.pl', 879 '', 880 'todo.pl --go'; 881 882 my $postinst; 883 884 $postinst = $file_spec->catfile ($netinst, 'postinst.bat'); 885 print "Creating $postinst..."; 886 write_file ($postinst, @postinst_lines); 887 print "done.\n"; 888 889 return $postinst; 890 } 891 892 # Cache for remembering first lines of .bat files under scripts 893 # directory. 894 my $_batfile_first_lines; 895 896 # Routine to fetch hash mapping batfiles to first lines. 897 sub batfile_first_lines () { 898 if (!defined $_batfile_first_lines) { 899 $_batfile_first_lines = { }; 900 my $dos_zdrv = $u->{'_meta'}->{'dos_zdrv'}; 901 my $script_dir = "$dos_zdrv\\scripts"; 902 opendir SCRIPTS, dos_to_host ($script_dir) 903 or die "Unable to opendir $script_dir: $^E"; 904 while (my $ent = readdir SCRIPTS) { 905 # Skip special files 906 $ent eq '.' || $ent eq '..' 907 and next; 908 # Skip non-bat files 909 $ent =~ /\.bat\z/i 910 or next; 911 # Skip non-ordinary filess 912 my $full_path = $file_spec->catfile ($script_dir, $ent); 913 -f dos_to_host ($full_path) 914 or next; 915 open FILE, dos_to_host ($full_path) 916 or die "Unable to open $full_path for reading: $^E"; 917 $is_linux 918 and binmode FILE, ':crlf'; 919 my $line = <FILE>; 920 chomp $line; 921 $_batfile_first_lines->{$ent} = $line; 922 close FILE 923 or die "Unable to close $full_path: $^E"; 924 } 925 closedir SCRIPTS 926 or die "Unable to closedir $script_dir: $^E"; 927 } 928 929 return $_batfile_first_lines; 930 } 931 932 my $_dhcp_settings; 933 934 # Get the DHCP settings into an associative array (linux only). 935 sub dhcp_settings () { 936 $is_linux 937 or croak 'Internal error'; 938 if (!defined $_dhcp_settings) { 939 $_dhcp_settings = { }; 940 my $dhcp = '/tmp/dhcp.out'; 941 if (open DHCP, $dhcp) { 942 while (my $line = <DHCP>) { 943 chomp $line; 944 my ($var, $val) = $line =~ /^(\w+)=(.+)\z/; 945 defined $var 946 or die "Could not parse line in$dhcp:\n $line\n..."; 947 $_dhcp_settings->{$var} = $val; 948 } 949 close DHCP 950 or die "Unable to close $dhcp: $^E"; 951 } 952 else { 953 warn "Unable to open $dhcp: $^E"; 954 } 955 } 956 957 return $_dhcp_settings; 958 } 959 960 $u->comments ('_meta') = 961 ['This section is for informational purposes.', 962 'Windows Setup does not use it.']; 963 964 $u->comments ('_meta', 'autolog') = 965 ['Command to disable (or modify) autologon when installation finishes']; 966 967 # Default setting for automatic logon is to disable it, but retain 968 # default setting of last user who logged on. 969 $u->{'_meta'}->{'autolog'} = 'autolog.pl --logon=1 --user=Administrateur --password=wawa'; 970 971 $u->comments ('_meta', 'doit_cmds') = ['Contents of doit.bat script']; 972 $u->{'_meta'}->{'doit_cmds'} = 973 sub { 974 my $unattend_txt = $file_spec->catfile ($u->{'_meta'}->{'netinst'}, 975 'unattend.txt'); 976 my $src_tree = $u->{'_meta'}->{'OS_media'}; 977 my $media_obj = Unattend::WinMedia->new ($src_tree); 978 my @lang_dirs = $media_obj->lang_dirs (1); 979 my $lang_opts = join ' ', map { "/rx:$_" } @lang_dirs; 980 981 # Yes, it is annoying to call this twice. But we really must 982 # call it now, and it would be even more annoying not to catch 983 # the problem right away during the interactive section above. 984 validate_old_dos_dir ($src_tree); 985 $src_tree =~ /\\$/ 986 or $src_tree .= '\\'; 987 my $dos_zdrv = $u->{'_meta'}->{'dos_zdrv'}; 988 my $cmpnents = ""; 989 my $winnt_path = "winnt"; 990 my $winnt_opts = ""; 991 992 # Create the correct string for the cmpnents directory. This will 993 # either be Z:\os... or /z/os... depending on the boot disk. 994 if ($is_linux) { 995 (my $linux_tree = $src_tree) =~ s#\\#/#g; 996 $linux_tree =~ s#$dos_zdrv#/z#g; 997 998 $cmpnents = $linux_tree . "cmpnents"; 999 } else { 1000 $cmpnents = $src_tree . "cmpnents"; 1001 } 1002 1003 # Test to see if the cmpnents directory exists - if so we have 1004 # XP Tablet and need to call the installer with different arguments. 1005 if ( -e $cmpnents ) { 1006 $winnt_path = "i386\\winnt"; 1007 $winnt_opts = "/2"; 1008 } else { 1009 $src_tree .= 'i386'; 1010 } 1011 1012 return "$dos_zdrv;cd $src_tree;$winnt_path $winnt_opts $lang_opts /s:$src_tree /u:$unattend_txt"; 1013 }; 1014 1015 $u->comments ('_meta', 'edit_files') = 1016 ['Display prompt for final edits?']; 1017 1018 $u->{'_meta'}->{'edit_files'} = '1'; 1019 1020 $u->comments ('_meta', 'fdisk_lba') = 1021 ['Use extended INT13 BIOS calls for fdisk?']; 1022 1023 $u->{'_meta'}->{'fdisk_lba'} = \&ask_fdisk_lba; 1024 1025 $u->{'_meta'}->{'fdisk_cmds'} = \&ask_fdisk_cmds; 1026 1027 $u->comments ('_meta', 'fdisk_confirm') = 1028 ['Prompt for confirmation before running fdisk_cmds?']; 1029 1030 $u->{'_meta'}->{'fdisk_confirm'} = 1; 1031 1032 $u->comments ('_meta', 'ntinstall_cmd') = 1033 ['System command to run in place of winnt under dosemu? (linuxboot only)']; 1034 $u->{'_meta'}->{'ntinstall_cmd'} = 1035 sub { 1036 return (yes_no_choice ('Use nt5x-install script - (DOSEMU alternative)') 1037 ? 'nt5x-install' 1038 : undef); 1039 }; 1040 1041 $u->{'_meta'}->{'format_cmd'} = 1042 sub { 1043 if (defined $u->{'_meta'}->{'ntinstall_cmd'}) { 1044 return undef; 1045 } 1046 return (yes_no_choice ('Format C: drive') 1047 ? 'format /y /z:seriously /q /u /a /v: c:' 1048 : undef); 1049 }; 1050 1051 $u->{'_meta'}->{'ipaddr'} = 1052 sub { 1053 my $ret; 1054 if ($is_linux) { 1055 my $dhcp_settings = dhcp_settings (); 1056 $ret = $dhcp_settings->{'ip'}; 1057 } 1058 else { 1059 # Parse file written by autoexec.bat 1060 my $ipconfig = '\\ipconfig.txt'; 1061 if (-e $ipconfig) { 1062 foreach my $line (read_file ($ipconfig)) { 1063 $line =~ /^\s*IP Address\s+:\s+([\d.]+)\r?$/ 1064 or next; 1065 $ret=$1; 1066 last; 1067 } 1068 } 1069 defined $ret 1070 or warn "Unable to get IP address from $ipconfig"; 1071 } 1072 return $ret; 1073 }; 1074 1075 1076 $u->{'_meta'}->{'local_admins'} = 1077 ['Accounts added to local Administrators group']; 1078 $u->{'_meta'}->{'local_admins'} = 1079 sub { 1080 my $dom = $u->{'Identification'}->{'JoinDomain'}; 1081 defined $dom 1082 or return undef; 1083 print "Enter users to add to local Administrators group.\n"; 1084 return simple_q 1085 ("Type 0 or more usernames, separated by spaces:\n"); 1086 }; 1087 1088 $u->{'_meta'}->{'macaddr'} = 1089 sub { 1090 my $ret; 1091 if ($is_linux) { 1092 # Get the interface we are using. 1093 my $dhcp_settings = dhcp_settings (); 1094 my $interface = $dhcp_settings->{'interface'}; 1095 # Run ifconfig to get MAC address for interface. 1096 open IFCONFIG, "ifconfig $interface|" 1097 or die "Could not fork: $^E"; 1098 my @lines = <IFCONFIG>; 1099 close IFCONFIG 1100 or die "ifconfig $interface exited with status $?"; 1101 foreach my $line (@lines) { 1102 chomp $line; 1103 if ($line =~ /HWaddr (..:..:..:..:..:..)/) { 1104 $ret = $1; 1105 # Remove colons, to convert to form used by "net 1106 # diag /status" 1107 $ret =~ s/://g; 1108 } 1109 } 1110 defined $ret 1111 or warn "Unable to get MAC address from ifconfig $interface"; 1112 } 1113 else { 1114 # Parse file written by autoexec.bat. 1115 my $netdiag = '\\netdiag.txt'; 1116 foreach my $line (read_file ($netdiag)) { 1117 $line =~ /^Permanent node name: ([0-9A-F]+)\r?$/ 1118 or next; 1119 $ret = $1; 1120 last; 1121 } 1122 defined $ret 1123 or warn "Unable to get MAC address from $netdiag"; 1124 } 1125 return $ret; 1126 }; 1127 1128 $u->{'_meta'}->{'netinst'} = 'c:\\netinst'; 1129 1130 $u->comments ('_meta', 'ntp_servers') = 1131 ['NTP servers, separated by commas or spaces']; 1132 1133 $u->{'_meta'}->{'ntp_servers'} = 1134 sub { 1135 return simple_q 1136 ("Enter NTP servers, separated by spaces (default=none):"); 1137 }; 1138 1139 $u->comments ('_meta', 'tmpdrive') = [ 'Drive used for temporary files in DOS' ]; 1140 (defined $ENV{'TMPDRIVE'}) 1141 or $ENV{'TMPDRIVE'}=''; 1142 $u->{'_meta'}->{'tmpdrive'} = $ENV{'TMPDRIVE'}; 1143 1144 $u->comments ('_meta', 'dos_zdrv') = [ 'Install share drive letter in DOS' ]; 1145 (defined $ENV{'DOS_ZDRV'}) 1146 or $ENV{'DOS_ZDRV'}='Z:'; 1147 $u->{'_meta'}->{'dos_zdrv'} = $ENV{'DOS_ZDRV'}; 1148 1149 my $dos_zdrv = $u->{'_meta'}->{'dos_zdrv'}; 1150 1151 $u->comments ('_meta', 'OS_dir') = ['Directory holding OS media directories']; 1152 $u->{'_meta'}->{'OS_dir'} = 1153 sub { return $file_spec->catdir ("$dos_zdrv", 'os'); }; 1154 1155 $u->{'_meta'}->{'OS_media'} = \&ask_os; 1156 1157 $u->{'_temp'}->{'postinst'} = \&create_postinst_bat; 1158 1159 $u->{'_meta'}->{'replace_mbr'} = 1160 sub { 1161 return yes_no_choice 1162 ('Replace Master Boot Record (if unsure, say yes)'); 1163 }; 1164 1165 $u->comments ('_meta', 'top') = ['First script run by postinst.bat']; 1166 $u->sort_index ('_meta', 'top') = 1; 1167 $u->comments ('_meta', 'middle') = ['Optional script(s) run by postinst.bat']; 1168 $u->sort_index ('_meta', 'middle') = 2; 1169 $u->comments ('_meta', 'bottom') = ['Last script(s) run by postinst.bat']; 1170 $u->sort_index ('_meta', 'bottom') = 3; 1171 1172 # Go through the first line (head) of each script and slurp out the 1173 # line matching the desired token. 1174 sub _script_sel_helper ($$) { 1175 my ($token, $heads) = @_; 1176 my %ret; 1177 1178 foreach my $script (sort keys %$heads) { 1179 $heads->{$script} =~ /^::\s*$token(?!\w)\W*(.*)\z/ 1180 or next; 1181 my $desc = $1; 1182 my $key = "$script ($desc)"; 1183 (exists $ret{$key}) 1184 and die "Internal error (duplicate key in _top_helper)"; 1185 $ret{"$script ($desc)"} = $script; 1186 } 1187 1188 return %ret; 1189 } 1190 1191 $u->{'_meta'}->{'top'} = 1192 sub { 1193 my $bat_heads = batfile_first_lines (); 1194 my %master_choices = _script_sel_helper ('MASTER', $bat_heads); 1195 my $master = ''; 1196 1197 if (scalar keys %master_choices > 0) { 1198 my @choices = (map { ($_ => $master_choices{$_}) } 1199 sort keys %master_choices); 1200 print "Choose master post-installation script to run.\n"; 1201 $master = menu_choice (@choices, 'none' => ''); 1202 } 1203 1204 return $master; 1205 }; 1206 1207 $u->{'_meta'}->{'middle'} = 1208 sub { 1209 my $bat_heads = batfile_first_lines (); 1210 my %optional_choices = _script_sel_helper ('OPTIONAL', $bat_heads); 1211 my @options = multi_choice ('Choose optional scripts to run.', 1212 sort keys %optional_choices); 1213 return join ';', map { $optional_choices{$_} } @options; 1214 }; 1215 1216 $u->{'_meta'}->{'bottom'} = ''; 1217 1218 # Default is to fetch these from environment set up by autoexec.bat. 1219 $u->comments ('_meta', 'z_path') = ['UNC path to install share']; 1220 (defined $ENV{'Z_PATH'}) 1221 or die "autoexec.bat failed to set Z_PATH; bailing"; 1222 $u->{'_meta'}->{'z_path'} = $ENV{'Z_PATH'}; 1223 1224 $u->comments ('_meta', 'z_user') = ['Username for mapping install share']; 1225 (defined $ENV{'Z_USER'}) 1226 or die "autoexec.bat failed to set Z_USER; bailing"; 1227 $u->{'_meta'}->{'z_user'} = 1228 sub { 1229 my $user = $ENV{'Z_USER'}; 1230 my $domain = $ENV{'Z_DOMAIN'}; 1231 return (defined $domain && $domain =~ /\S/ 1232 ? canonicalize_user ($domain, $user) 1233 : $user); 1234 }; 1235 1236 $u->comments ('_meta', 'z_password') = ['Password for mapping install share']; 1237 (defined $ENV{'Z_PASS'}) 1238 or die "autoexec.bat failed to set Z_PASS; bailing"; 1239 $u->{'_meta'}->{'z_password'} = $ENV{'Z_PASS'}; 1240 1241 $u->comments ('_meta', 'z_drive') = [ 'Install share drive letter' ]; 1242 $u->{'_meta'}->{'z_drive'} = 'Z:'; 1243 1244 $u->{'UserData'}->{'FullName'} = 1245 sub { 1246 # patch se3-unattended : en francais 1247 #return simple_q ("Enter the user's full name for this machine:\n"); 1248 return simple_q ("Entrer le nom complet de cette machine:\n"); 1249 }; 1250 1251 $u->{'UserData'}->{'OrgName'} = 1252 sub { 1253 return simple_q ("Enter the organization name for this machine:\n"); 1254 }; 1255 1256 $u->{'UserData'}->{'ComputerName'} = 1257 sub { 1258 # patch se3-unattended : en francais 1259 # my $name = simple_q ("Enter computer name (* == autogenerate):\n"); 1260 my $name = simple_q ("Entrer le nom de l ordinateur (* == autogenerate):\n"); 1261 return $name; 1262 }; 1263 1264 $u->comments ('GuiRunOnce', 'Command0') = 1265 ["Command which runs after OS installation finishes"]; 1266 1267 $u->{'GuiRunOnce'}->{'Command0'} = 1268 sub { 1269 return $u->{'_temp'}->{'guirunonce'}; 1270 }; 1271 1272 $u->{'_temp'}->{'guirunonce'} = 1273 sub { 1274 my $ret; 1275 my $postinst = $u->{'_temp'}->{'postinst'}; 1276 1277 if (!defined $postinst) { 1278 undef $ret; 1279 } 1280 elsif (!defined $u->{'_meta'}->{'top'}) { 1281 # No toplevel script means no invocation of todo.pl, 1282 # so no need to use mapznrun.bat. 1283 $ret = $postinst; 1284 } 1285 else { 1286 my $netinst = $u->{'_meta'}->{'netinst'}; 1287 # Basic framework for mapping Z: drive 1288 my $dos_zdrv = $u->{'_meta'}->{'dos_zdrv'}; 1289 my $mapznrun = $file_spec->catfile ($netinst, 'mapznrun.bat'); 1290 print "Copying $mapznrun..."; 1291 copy (dos_to_host ("$dos_zdrv\\bin\\mapznrun.bat"), 1292 dos_to_host ($mapznrun)) 1293 or die "Unable to copy $dos_zdrv\\bin\\mapznrun.bat to $mapznrun"; 1294 1295 my $mapcd = $file_spec->catfile ($netinst, 'mapcd.js'); 1296 print "Copying $mapcd..."; 1297 copy (dos_to_host ("$dos_zdrv\\bin\\mapcd.js"), 1298 dos_to_host ($mapcd)) 1299 or die "Unable to copy $dos_zdrv\\bin\\mapcd.js to $mapcd"; 1300 print "done.\n"; 1301 1302 # "Permanent" credentials (drive letter, UNC path) 1303 my $z = $u->{'_meta'}->{'z_drive'}; 1304 my $z_path = $u->{'_meta'}->{'z_path'}; 1305 my $netlogon_dir = $u->{'_meta'}->{'netlogon_dir'}; 1306 my $permcred = $file_spec->catfile ($netinst, 'permcred.bat'); 1307 print "Creating $permcred..."; 1308 write_file ($permcred, 1309 "\@SET Z=$z", 1310 "\@SET Z_PATH=$z_path", 1311 "\@SET NETLOGON_DIR=$netlogon_dir"); 1312 print "done.\n"; 1313 1314 # "Temporary" credentials (username, password) 1315 my $z_user = $u->{'_meta'}->{'z_user'}; 1316 my $z_pass = $u->{'_meta'}->{'z_password'}; 1317 my $tempcred = $file_spec->catfile ($netinst, 'tempcred.bat'); 1318 print "Creating $tempcred..."; 1319 write_file ($tempcred, 1320 "\@SET Z_USER=\"$z_user\"", 1321 "\@SET Z_PASS=\"$z_pass\""); 1322 print "done.\n"; 1323 1324 $ret = "$mapznrun $postinst"; 1325 } 1326 1327 return $ret; 1328 }; 1329 1330 $u->{'GuiUnattended'}->{'AdminPassword'} = 1331 sub { 1332 return password_q ('Enter password for local administrator account: '); 1333 }; 1334 1335 $u->{'GuiUnattended'}->{'AutoLogon'} = 1336 sub { 1337 my $runonce_cmd = $u->{'GuiRunOnce'}->{'Command0'}; 1338 return (defined $runonce_cmd 1339 ? 'Yes' 1340 : undef); 1341 }; 1342 1343 $u->{'Identification'}->{'JoinDomain'} = 1344 sub { 1345 # Mutual recursion. IniFile object takes care of it. 1346 my $join_workgroup = $u->{'Identification'}->{'JoinWorkgroup'}; 1347 # If we are joining a workgroup, then we are not joining a 1348 # domain. 1349 defined $join_workgroup 1350 and return undef; 1351 return simple_q 1352 ('Join workstation to what domain (default = none)? '); 1353 }; 1354 1355 $u->{'Identification'}->{'JoinWorkgroup'} = 1356 sub { 1357 # Mutual recursion. IniFile object takes care of it. 1358 my $join_domain = $u->{'Identification'}->{'JoinDomain'}; 1359 # If we are joining a domain, then we are not joining a 1360 # workgroup. 1361 defined $join_domain 1362 and return undef; 1363 return simple_q 1364 ('Join workstation to what workgroup (default = none)? '); 1365 }; 1366 1367 # Ask about domain before workgroup, ceteris paribus. 1368 $u->sort_index ('Identification', 'JoinWorkgroup') 1369 = $u->sort_index ('Identification', 'JoinDomain') + 1; 1370 1371 $u->{'Identification'}->{'DomainAdmin'} = 1372 sub { 1373 my $dom = $u->{'Identification'}->{'JoinDomain'}; 1374 defined $dom or return undef; 1375 my $user = simple_q ("DomainAdmin account for joining $dom domain? "); 1376 return canonicalize_user ($dom, $user); 1377 }; 1378 1379 $u->{'Identification'}->{'DomainAdminPassword'} = 1380 sub { 1381 my $admin = $u->{'Identification'}->{'DomainAdmin'}; 1382 defined $admin 1383 or return undef; 1384 return password_q 1385 ("Enter DomainAdminPassword for $admin account: "); 1386 }; 1387 1388 $u->{'Unattended'}->{'OemPnPDriversPath'} = \&ask_oem_pnp_drivers_path; 1389 1390 my $product_key_q = 1391 "Enter your product key now.\n" 1392 . "This is the 25-character code from your software license\n" 1393 . "(like 12345-6789A-BCDEF-GHIJK-LMNOP)\n\n" 1394 . "Enter key: "; 1395 1396 $u->{'UserData'}->{'ProductID'} = 1397 sub { 1398 my $media_obj = 1399 Unattend::WinMedia->new ($u->{'_meta'}->{'OS_media'}); 1400 my $name = $media_obj->name (); 1401 1402 # Only ask for ProductID for win2k or winnt. 1403 $name =~ /Windows 2000/ || $name =~ /Windows NT/ 1404 or return undef; 1405 1406 print "OS-ProductID:", $name ,"\n"; 1407 return simple_q ($product_key_q); 1408 }; 1409 1410 $u->{'UserData'}->{'ProductKey'} = 1411 sub { 1412 my $media_obj = 1413 Unattend::WinMedia->new ($u->{'_meta'}->{'OS_media'}); 1414 my $name = $media_obj->name (); 1415 1416 # ProductKey is never used by win2k nor winnt. 1417 $name =~ /Windows 2000/ || $name =~ /Windows NT/ 1418 and return undef; 1419 1420 print "OS-ProductKey:", $name ,"\n"; 1421 # Only ask for ProductKey if we lack a ProductID. 1422 my $product_id = $u->{'UserData'}->{'ProductID'}; 1423 defined $product_id 1424 and return undef; 1425 return simple_q ($product_key_q); 1426 }; 1427 1428 $u->comments ('MassStorageDrivers') = 1429 ['See <http://support.microsoft.com/?kbid=288344>']; 1430 1431 $u->{'MassStorageDrivers'} = 1432 sub { 1433 my $media_obj = Unattend::WinMedia->new ($u->{'_meta'}->{'OS_media'}); 1434 1435 my @oem_drivers = 1436 multi_choice ('Select OEM drivers for [MassStorageDrivers]:', 1437 sort $media_obj->textmode_oem_drivers (1)); 1438 1439 scalar @oem_drivers > 0 1440 or return undef; 1441 1442 # OK, adding some OEM drivers. Add the retail ones while we 1443 # are at it. 1444 my @retail_drivers = 1445 multi_choice ('Select RETAIL drivers for [MassStorageDrivers]:', 1446 sort $media_obj->textmode_retail_drivers (1)); 1447 1448 my %ret = ((map { $_ => 'RETAIL' } @retail_drivers), 1449 (map { $_=> 'OEM' } @oem_drivers)); 1450 return \%ret; 1451 }; 1452 1453 $u->comments ('OEMBootFiles') = 'See comments for [MassStorageDrivers]'; 1454 $u->{'OEMBootFiles'} = 1455 sub { 1456 (defined $u->{'MassStorageDrivers'}) 1457 or return undef; 1458 my $media_obj = Unattend::WinMedia->new ($u->{'_meta'}->{'OS_media'}); 1459 my %ret = (map { $_ => $u->no_value () } 1460 $media_obj->textmode_files ()); 1461 return \%ret; 1462 }; 1463 1464 # Make [_meta] section sort last in the file. 1465 $u->sort_index ('_meta') = 999999; 1466 1467 ## Now the meat of the script. 1468 1469 # Compare Z:\version.txt file to VERSION environment variable. 1470 my $version_file = "$dos_zdrv\\version.txt"; 1471 if (! -f dos_to_host ($version_file)) { 1472 print "Warning: $version_file not found (old install share?)\n"; 1473 } 1474 elsif (!defined $ENV{'VERSION'}) { 1475 print "Warning: VERSION variable is empty (old boot disk?)\n" 1476 } 1477 else { 1478 my ($share_ver) = read_file ($version_file); 1479 chomp $share_ver; 1480 my $boot_ver = $ENV{'VERSION'}; 1481 $share_ver eq $boot_ver 1482 or print "Warning: Boot disk version ($boot_ver) does not match install share version ($share_ver)\n"; 1483 } 1484 1485 # Read master unattend.txt. 1486 $u->read (dos_to_host ("$dos_zdrv\\lib\\unattend.txt")); 1487 1488 # Read site-specific unattend.txt, if it exists. 1489 if (1) { 1490 my $site_unattend_txt = dos_to_host ("$dos_zdrv\\site\\unattend.txt"); 1491 -e ($site_unattend_txt) 1492 and $u->read ($site_unattend_txt); 1493 } 1494 1495 # Output some interesting info. 1496 my $ipaddr = $u->{'_meta'}->{'ipaddr'}; 1497 defined $ipaddr 1498 and print "IP address: $ipaddr\n"; 1499 my $macaddr = $u->{'_meta'}->{'macaddr'}; 1500 defined $macaddr 1501 and print "MAC address: $macaddr\n"; 1502 1503 # Read site-specific Perl configuration file. 1504 if (1) { 1505 my $site_conf = dos_to_host ("$dos_zdrv\\site\\config.pl"); 1506 1507 if (-e $site_conf) { 1508 my $result = do $site_conf; 1509 $@ 1510 and die "do $site_conf failed: $@"; 1511 defined $result 1512 or die "Could not do $site_conf: $^E"; 1513 } 1514 } 1515 1516 # On Linux, we may need to correct the kernel's notion of the disk 1517 # geometry. Otherwise the disk partitioning tool will have the wrong 1518 # idea about how to create the partition, and dosemu will present the 1519 # wrong geometry to the Windows installer (resulting in a partition 1520 # which does not boot). 1521 if ($is_linux) { 1522 my $bios_head = $ENV{'LEGACY_BIOS_HEAD'}; 1523 my $bios_sect = $ENV{'LEGACY_BIOS_SECT'}; 1524 1525 if (defined $bios_head && defined $bios_sect) { 1526 my $hda = readlink ('/dev/dsk'); 1527 defined $hda 1528 or die "readlink /dev/dsk failed: $^E"; 1529 1530 my $sectors = get_disk_sectors (); 1531 1532 my $cylinders = int ($sectors / $bios_head / $bios_sect); 1533 1534 $sectors == $cylinders * $bios_head * $bios_sect 1535 or print "Odd. C/H/S does not multiply out to $sectors.\n"; 1536 1537 $cylinders > 65535 1538 and $cylinders = 65535; 1539 1540 my $sys_hda = $hda; 1541 $sys_hda =~ s/\//!/g; 1542 my $settings_file = "/proc/ide/$sys_hda/settings"; 1543 1544 if (-e $settings_file) { 1545 print "\nSetting C/H/S for $hda to $cylinders/$bios_head/$bios_sect..."; 1546 open SETTINGS, ">$settings_file" 1547 or die "Unable to open $settings_file for writing: $^E"; 1548 printf SETTINGS "bios_cyl:%d bios_head:%d bios_sect:%d\n", 1549 $cylinders, $bios_head, $bios_sect; 1550 close SETTINGS 1551 or die "Unable to close $settings_file: $^E"; 1552 print "done.\n"; 1553 # Disk geometry is now fixed, no need to hack disk geo into the partition: 1554 $u->{'_meta'}->{'fix_disk_geo_heads'} = ""; 1555 $u->{'_meta'}->{'fix_disk_geo_sectors'} = ""; 1556 } 1557 else { 1558 # Non-IDE disk. Should probably sanity-check kernel 1559 # geometry against legacy BIOS geometry here. FIXME. 1560 # Send partition geometry via unatted.txt so we can 1561 # hack it into partition after the dosemu run. 1562 # FIXME Should we ask the user before we do this? 1563 if (not defined $u->{'_meta'}->{'fix_disk_geo_heads'}) { 1564 $u->{'_meta'}->{'fix_disk_geo_heads'} = $bios_head; 1565 } 1566 if (not defined $u->{'_meta'}->{'fix_disk_geo_sectors'}) { 1567 $u->{'_meta'}->{'fix_disk_geo_sectors'} = $bios_sect; 1568 } 1569 } 1570 } 1571 } 1572 1573 # Set environment variable controlling fdisk's use of INT13 extensions. 1574 $is_linux || ($u->{'_meta'}->{'fdisk_lba'}) 1575 or $ENV{'FFD_VERSION'}=6; 1576 1577 # Read current partition table. 1578 my $partition_table = partition_table (); 1579 1580 my $fdisk_cmds; 1581 # Partition the disk. 1582 while (1) { 1583 $fdisk_cmds = $u->{'_meta'}->{'fdisk_cmds'}; 1584 defined $fdisk_cmds 1585 or $fdisk_cmds = ''; 1586 1587 $fdisk_cmds =~ /\S/ 1588 or last; 1589 1590 ($u->{'_meta'}->{'fdisk_confirm'}) 1591 or last; 1592 1593 print "\n"; 1594 print "ABOUT TO PARTITION THE FIRST HARD DRIVE!\n"; 1595 print "WARNING: This operation erases the disk!"; 1596 yes_no_choice ("Are you sure") 1597 and last; 1598 1599 $u->{'_meta'}->{'fdisk_cmds'} = \&ask_fdisk_cmds; 1600 } 1601 1602 # Run the fdisk commands. 1603 my $is_fdisk; 1604 1605 foreach my $cmd (split /;/, $fdisk_cmds) { 1606 $is_fdisk = 1; 1607 system ($is_linux 1608 ? convert_fdisk_parted ($cmd) 1609 : $cmd); 1610 } 1611 1612 if ($is_linux) { 1613 # On Linux, we (re-)create the device nodes after modifying the 1614 # partition table. 1615 my $hda = readlink ('/dev/dsk'); 1616 defined $hda 1617 or die "readlink /dev/dsk failed: $^E"; 1618 0 == system 'make-blkdev-nodes', $hda 1619 or die "make-blkdev-nodes $hda failed: $?"; 1620 } 1621 else { 1622 # If partition table has changed, reboot. 1623 print "\nRe-checking partition table..."; 1624 if ($partition_table ne partition_table (1) || 1625 ($partition_table eq '' && defined $is_fdisk)) { 1626 print "changed. Rebooting...\n"; 1627 sleep 2; 1628 system ('fdisk /reboot'); 1629 die "Internal error"; 1630 } 1631 else { 1632 print "no change. Continuing.\n"; 1633 } 1634 } 1635 1636 # Run formatting command, if any. 1637 my $format_cmd = $u->{'_meta'}->{'format_cmd'}; 1638 # On DOS, format now. 1639 # On Linux, take care of it later. 1640 my @doit_cmds; 1641 if (defined $format_cmd) { 1642 if ($is_linux) { 1643 print "(Deferring format command to run under DOSEMU)\n"; 1644 push @doit_cmds, $format_cmd; 1645 push @doit_cmds, 'if errorlevel 1 exit 1'; 1646 } 1647 else { 1648 system $format_cmd; 1649 } 1650 } 1651 1652 # Overwrite MBR, if desired. 1653 if ($u->{'_meta'}->{'replace_mbr'}) { 1654 if ($is_linux) { 1655 linux_write_mbr ('/usr/lib/freedos-mbr.bin'); 1656 # linux_write_mbr ('/usr/lib/booteasy.bin'); 1657 } 1658 else { 1659 system ('fdisk /mbr'); 1660 } 1661 } 1662 1663 # Create C:\netinst and subdirectories. 1664 my $netinst = $u->{'_meta'}->{'netinst'}; 1665 foreach my $dir ($netinst, "$netinst\\logs") { 1666 -d dos_to_host ($dir) 1667 and next; 1668 print "Creating $dir..."; 1669 mkdir dos_to_host ($dir) 1670 or die "FAILED: $^E"; 1671 print "done.\n"; 1672 } 1673 1674 # At this point, force everything else. 1675 $u->generate (); 1676 1677 # Batch script to run after this script exits. 1678 my $doit = "$netinst\\doit.bat"; 1679 if($is_linux) { 1680 # xcopy will copy a file that will prevent a cycling of DOSemu 1681 # this is tested as the first command 1682 # The filename itself 1683 my $noCycling = "$netinst\\" . int(rand(10000000)) . ".tmp"; 1684 # First of all, if the checkpoint file exist, leave DOSEmu 1685 unshift @doit_cmds, "IF EXIST $noCycling EXITEMU"; 1686 push @doit_cmds, 'xcopy /s /e /y Y:\\ C:\\'; 1687 # have the XCOPY command copy over the checkpoint file 1688 write_file($noCycling, 'prevent cycling of DOSemu'); 1689 } 1690 1691 push @doit_cmds, split /;/, $u->{'_meta'}->{'doit_cmds'}; 1692 print "Creating $doit..."; 1693 write_file ($doit, @doit_cmds); 1694 print "done.\n"; 1695 1696 # Patch se3-unattended : remontée rapport se3-clonage : macaddr et heure de debut d'install windows 1697 my $macaddrfile = $file_spec->catfile ($netinst, 'macaddr.txt'); 1698 my $macadresse = $u->{'_meta'}->{'macaddr'}; 1699 print "Creating $macaddrfile..."; 1700 write_file ($macaddrfile,$macadresse); 1701 print "done.\n"; 1702 1703 my $heuredebut = localtime; 1704 my @heure = split(/ /,$heuredebut); 1705 # pour avoir l'annee par exemple ajouter ,$heure[4] 1706 my $debutwinfile = $file_spec->catfile ($netinst, 'debutwin.txt'); 1707 print "Heure de debut d'install : $heure[3]\n"; 1708 print "Creation du fichier debutwin.txt..."; 1709 write_file ($debutwinfile,$heure[3]); 1710 print "done.\n"; 1711 1712 1713 # Create list of files to offer for editing. 1714 my $unattend_txt = "$netinst\\unattend.txt"; 1715 1716 my @edit_choices; 1717 1718 push @edit_choices, ("Edit $unattend_txt" => $unattend_txt); 1719 1720 my $postinst = $u->{'_temp'}->{'postinst'}; 1721 defined $postinst 1722 and push (@edit_choices, 1723 "Edit $postinst (will run after OS install is done)" 1724 => $postinst); 1725 1726 push @edit_choices, ("Edit $doit (will run when you select Continue)" 1727 => $doit); 1728 1729 # Create unattend.txt file. 1730 print "Creating $unattend_txt..."; 1731 1732 # Remove [_temp] section. Since it holds subroutines with 1733 # side-effects, including it in unattend.txt would almost certainly be 1734 # an error. 1735 delete $u->{'_temp'}; 1736 1737 my @unattend_contents = $u->generate (); 1738 1739 write_file ($unattend_txt, @unattend_contents); 1740 print "done.\n"; 1741 1742 while ($u->{'_meta'}->{'edit_files'}) { 1743 my $file = menu_choice (@edit_choices, 1744 'Continue' => undef); 1745 defined $file 1746 or last; 1747 if ($is_linux) { 1748 system 'nano', '--nowrap', dos_to_host ($file); 1749 } 1750 else { 1751 system 'pico', '-w', $file; 1752 } 1753 } 1754 1755 # Return control to master script, which will run doit.bat. 1756 exit 0;
title
Description
Body
title
Description
Body
title
Description
Body
title
Body
| Generated: Tue Mar 17 22:47:18 2015 | Cross-referenced by PHPXref 0.7.1 |