Leaked source code of windows server 2003
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

211 lines
6.2 KiB

  1. $script_db = "C:\\nt\\private\\windows\\setup\\bom\\scripts.dat";
  2. @script_fields = ( "time", "script", "lang", "machine", "status", "eta", "build", "error", "state" );
  3. sub LOCK_SH { 1 }
  4. sub LOCK_EX { 2 }
  5. sub LOCK_NB { 4 }
  6. sub LOCK_UN { 8 }
  7. sub script_status_update {
  8. my ( $state, $status, $time, $script, $script_id, $lang, $build, $date, $products, $machine, $new ) = 0;
  9. $state = shift @_;
  10. $time = shift @_;
  11. $machine = shift @_;
  12. $status = shift @_;
  13. @args = split ' ', $_[0];
  14. $script = shift @args;
  15. $script =~ s/(\w+)\.bat/$1/i;
  16. foreach $arg ( @args ) {
  17. SWITCH: {
  18. if ( $sup_lang{uc $arg} ) { $lang = uc $arg; last SWITCH; }
  19. if ( is_build($arg) ) { $build = uc $arg; last SWITCH; }
  20. if ( is_date($arg) ) { $date = $arg; last SWITCH; }
  21. if ( $sup_prod{uc $arg} ) { $products{uc $arg} = 1; last SWITCH; }
  22. }
  23. }
  24. $lang = USA unless $lang;
  25. ### Load the DB.
  26. &read_script_dat();
  27. if ( $Scripts{time}{$time} ) {
  28. $script_id = $time;
  29. } else {
  30. if ( $Scripts{script}{$script} ) {
  31. foreach $key ( keys %{ $Scripts{script}{$script} } ) {
  32. $new = 0;
  33. foreach $sub_key ( "script", "lang", "build", "machine" ) {
  34. unless ( eval "\$Scripts{script}{\$script}{\$key}{\$sub_key} =~ /\$$sub_key/i" ) {
  35. $new = 1;
  36. next;
  37. }
  38. }
  39. $script_id = $key;
  40. last unless $new;
  41. }
  42. } else {
  43. $new = 1;
  44. }
  45. }
  46. if ( $script_id and $state =~ /START/i ) {
  47. my $new_id = $time;
  48. foreach $sort_method ( @script_fields ) {
  49. eval "\$Scripts{time}{\$new_id}{\$new_id}{\$sort_method} = $Scripts{time}{\$script_id}{\$script_id}{\$sort_method}";
  50. }
  51. delete $Scripts{time}{$script_id};
  52. $script_id = $new_id;
  53. }
  54. ### Make new script ID;
  55. $script_id = $time if $new;
  56. foreach $sort_method ( @script_fields ) {
  57. eval "\$Scripts{time}{\$script_id}{\$script_id}{\$sort_method} = \$$sort_method";
  58. }
  59. $Scripts{time}{$script_id}{$script_id}{error} = "NO" unless $Scripts{time}{$script_id}{$script_id}{error} or $Scripts{time}{$script_id}{$script_id}{error} =~ /YES/i;
  60. write_script_dat();
  61. }
  62. sub clear_script_hash {
  63. foreach $sort_method ( @script_fields ) {
  64. delete $Scripts{$sort_method};
  65. }
  66. }
  67. sub read_script_dat {
  68. ### Clear out the Scripts hash.
  69. clear_script_hash;
  70. open (DB, $script_db) || die "Can't read $script_db: $!\n";
  71. unless ( flock ( DB, LOCK_EX | LOCK_NB ) ) {
  72. print "$$: Can't read during write update! Waiting for read lock ($!) ....";
  73. unless ( flock ( DB, LOCK_EX)) { print "ERROR: flock: $!" }
  74. }
  75. while (<DB>) {
  76. chomp;
  77. my ($time, $script, $lang, $machine, $status, $last_err, $eta, $build, $state) = split(/\|/);
  78. ### Strip .bat from $script
  79. $script =~ s/(\w+)\.bat/$1/i;
  80. foreach $sort_method ( @script_fields ) {
  81. eval "\$Scripts{\$sort_method}{\$$sort_method}{$time}{script} = \$script";
  82. eval "\$Scripts{\$sort_method}{\$$sort_method}{$time}{lang} = \$lang";
  83. eval "\$Scripts{\$sort_method}{\$$sort_method}{$time}{machine} = \$machine";
  84. eval "\$Scripts{\$sort_method}{\$$sort_method}{$time}{status} = \$status";
  85. eval "\$Scripts{\$sort_method}{\$$sort_method}{$time}{error} = \$last_err";
  86. eval "\$Scripts{\$sort_method}{\$$sort_method}{$time}{eta} = \$eta";
  87. eval "\$Scripts{\$sort_method}{\$$sort_method}{$time}{time} = \$time";
  88. eval "\$Scripts{\$sort_method}{\$$sort_method}{$time}{build} = \$build";
  89. eval "\$Scripts{\$sort_method}{\$$sort_method}{$time}{state} = \$state";
  90. }
  91. }
  92. flock ( DB, LOCK_UN );
  93. close (DB);
  94. }
  95. sub write_script_dat {
  96. my $Script_Save;
  97. ### Make sure we can get an exclusive lock
  98. open (DB, "$script_db") || die "Can't read $script_db: $!\n";
  99. unless ( flock (DB, LOCK_EX | LOCK_NB ) ) {
  100. print "$$: Must have exclusive lock! - $!\n";
  101. unless ( flock ( DB, LOCK_EX ) ) {die "flock: $!\n" }
  102. }
  103. close DB;
  104. ### Open DB.
  105. open (DB, ">$script_db") || die "Can't read $script_db: $!\n";
  106. ### Lock the DB.
  107. for ( $x = 0; $x <= 10; $x++ ) {
  108. my $success = 0;
  109. if ( flock (DB, LOCK_EX | LOCK_NB ) ) {
  110. $success = 1;
  111. } else {
  112. print "\n$$: Must have exclusive lock! - $!\n";
  113. }
  114. last if $success;
  115. }
  116. # unless ( flock (DB, LOCK_EX | LOCK_NB ) ) {
  117. # $bogus = 1;
  118. # print "$$: Must have exclusive lock! - $!\n";
  119. # unless ( flock ( DB, LOCK_EX ) ) {print "ERROR: flock: $!\n" }
  120. # }
  121. # }
  122. ### Create the new DB file.
  123. foreach $key ( sort bykey keys %{ $Scripts{time} } ) {
  124. $Script_Save .= "$key|$Scripts{time}{$key}{$key}{script}|$Scripts{time}{$key}{$key}{lang}|$Scripts{time}{$key}{$key}{machine}|$Scripts{time}{$key}{$key}{status}|$Scripts{time}{$key}{$key}{error}|$Scripts{time}{$key}{$key}{eta}|$Scripts{time}{$key}{$key}{build}|$Scripts{time}{$key}{$key}{state}\n" if $Scripts{time}{$key}{$key}{script};
  125. }
  126. ### Write out the DB.
  127. print DB $Script_Save;
  128. close DB;
  129. flush;
  130. }
  131. sub time {
  132. my ($tm, $short) = @_;
  133. my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst)
  134. = localtime($tm);
  135. my $ampm;
  136. if ( $hour >= 12 ) {
  137. $ampm = "p";
  138. $hour = $hour - 12;
  139. } else {
  140. $ampm = "a";
  141. }
  142. if ( $short =~ /short/i ) {
  143. return ( sprintf( "%d:%0.2d%s", $hour, $min, $ampm ) );
  144. } else {
  145. return ( sprintf( "[%d/%0.2d] %d:%0.2d%s", $mon, $wday, $hour, $min, $ampm ) );
  146. }
  147. }
  148. sub bykey {
  149. lc($a) cmp lc($b);
  150. }
  151. sub bykey_rev {
  152. lc($b) cmp lc($a);
  153. }
  154. sub bynum {
  155. $a <=> $b;
  156. }
  157. sub bynum_rev {
  158. $b <=> $a;
  159. }
  160. 1;