| 1 |
#!/home/jsoc/bin/linux_x86_64/activeperl |
| 2 |
|
| 3 |
# This script maintains the 'production' set of JSOC binaries, which are located in |
| 4 |
# /home/jsoc/cvs/Development/JSOC/bin. It works as follows: |
| 5 |
# |
| 6 |
# 1. It runs "make MACH='waystation_<arch>' <target1> <target2> ..." This will create binary files in |
| 7 |
# /home/jsoc/cvs/Development/JSOC/_waystation_<arch>. There will be links created from |
| 8 |
# /home/jsoc/cvs/Development/JSOC/bin/waystation_<arch> and |
| 9 |
# /home/jsoc/cvs/Development/JSOC/lib/waystation_<arch> to the just-created binaries. |
| 10 |
# 2. It then follows all these links to identify all the newly created files. Each of these files |
| 11 |
# is going to replace a file in /home/jsoc/cvs/Development/JSOC/_<arch>. However, these original |
| 12 |
# files may be in use, so each is first moved to a "save" directory, which is named |
| 13 |
# /home/jsoc/cvs/Development/JSOC/_<arch>_YYYYMMDDHHMMSS. This save directory |
| 14 |
# must be created every time this script is run. At regular intervals, these save directories |
| 15 |
# must be deleted (a one-day retention time is good). Each original file is first moved to the save |
| 16 |
# directory, then its replacement (in /home/jsoc/cvs/Development/JSOC/_waystation_<arch>) |
| 17 |
# is moved into place in the production directory, /home/jsoc/cvs/Development/JSOC/_<arch>. |
| 18 |
# 3. The links to the files in /home/jsoc/cvs/Development/JSOC/_waystation_<arch> will now be dead. |
| 19 |
# This script therefore deletes those links. |
| 20 |
# 4. /home/jsoc/cvs/Development/JSOC/waystation_<arch> is now the repository for all the object and dependency files. |
| 21 |
# make will use these files when it builds binaries, so we must maintain this directory. |
| 22 |
|
| 23 |
use strict; |
| 24 |
use warnings; |
| 25 |
use Cwd qw(getcwd realpath chdir); |
| 26 |
use File::Spec; |
| 27 |
use File::stat; |
| 28 |
use IO::Dir; |
| 29 |
use Data::Dumper; |
| 30 |
use FindBin qw($Bin); |
| 31 |
use lib "$Bin/../../../base/libs/perl"; |
| 32 |
use drmsLocks; |
| 33 |
use drmsArgs; |
| 34 |
use drmsRunProg; |
| 35 |
|
| 36 |
# Required arguments |
| 37 |
use constant kArgMods => "mods"; # modules to build (comma-separated list) |
| 38 |
use constant kArgFiles => "files"; # source files to first update (comma-separated list) |
| 39 |
|
| 40 |
# Optional arguments |
| 41 |
# If clean is specified, then the required arguments above are ignored. In this case, the $bindir is cleaned, |
| 42 |
# just like 'make clean' will do. And $builddir is cleaned too. |
| 43 |
use constant kArgClean => "clean"; # clean $bindir (i.e., _linux_x86_64) AND $builddir (i.e., _waystation_$bindir) |
| 44 |
use constant kArgBinDir => "bindir"; # _waystation_<value> is the directory where the binaries are saved |
| 45 |
# (defaults to _waystation_$JSOC_MACHINE) |
| 46 |
|
| 47 |
# Lockfile |
| 48 |
use constant kLockFile => "/home/jsoc/locks/prodbuildlck.txt"; |
| 49 |
use constant kJSOCtreeRoot => "JSOC"; |
| 50 |
|
| 51 |
# Return values |
| 52 |
use constant kRetSuccess => 0; |
| 53 |
use constant kRetNoLock => 1; |
| 54 |
use constant kRetInvalidArgs => 2; |
| 55 |
use constant kRetDlSource => 3; |
| 56 |
use constant kRetInvalidWD => 4; |
| 57 |
use constant kRetConfigure => 5; |
| 58 |
use constant kRetMake => 6; |
| 59 |
use constant kRetMove => 7; |
| 60 |
use constant kRetDelLinks => 8; |
| 61 |
|
| 62 |
my($rv); |
| 63 |
my($argsinH); |
| 64 |
my($optsinH); |
| 65 |
my($lock); |
| 66 |
my($args); |
| 67 |
my($opts); |
| 68 |
my(@mods); |
| 69 |
my($bindir); |
| 70 |
my($cmd); |
| 71 |
my($basetime); |
| 72 |
my(@srcdirs); |
| 73 |
my($wdir); # working dir (which must be a JSOC root directory) |
| 74 |
my(@relspecs); |
| 75 |
my($specstr); |
| 76 |
my($usewaystation); |
| 77 |
my($builddir); |
| 78 |
my($clean); |
| 79 |
|
| 80 |
$rv = &kRetSuccess; |
| 81 |
|
| 82 |
# Required arguments |
| 83 |
$argsinH = |
| 84 |
{ |
| 85 |
&kArgMods => 's', |
| 86 |
&kArgFiles => 's', |
| 87 |
}; |
| 88 |
|
| 89 |
$optsinH = |
| 90 |
{ |
| 91 |
&kArgClean => 'noval', |
| 92 |
&kArgBinDir => 's' |
| 93 |
}; |
| 94 |
|
| 95 |
# Lock this script |
| 96 |
$lock = new drmsNetLocks(&kLockFile); |
| 97 |
|
| 98 |
if (defined($lock)) |
| 99 |
{ |
| 100 |
$rv = &kRetSuccess; |
| 101 |
|
| 102 |
$basetime = time(); |
| 103 |
|
| 104 |
$opts = new drmsArgs($optsinH, 0); |
| 105 |
|
| 106 |
$clean = 0; |
| 107 |
if (defined($opts)) |
| 108 |
{ |
| 109 |
$clean = $opts->Get(&kArgClean); |
| 110 |
} |
| 111 |
else |
| 112 |
{ |
| 113 |
$clean = 0; |
| 114 |
} |
| 115 |
|
| 116 |
if ($clean) |
| 117 |
{ |
| 118 |
$bindir = $opts->Get(&kArgBinDir); |
| 119 |
if (!defined($bindir)) |
| 120 |
{ |
| 121 |
$bindir = $ENV{JSOC_MACHINE}; |
| 122 |
} |
| 123 |
|
| 124 |
if (!defined($bindir)) |
| 125 |
{ |
| 126 |
print STDERR "Binary directory not specified.\n"; |
| 127 |
$rv = &kRetInvalidArgs; |
| 128 |
} |
| 129 |
else |
| 130 |
{ |
| 131 |
$cmd = "make 'MACH=$bindir' clean"; |
| 132 |
print "running $cmd\n"; |
| 133 |
|
| 134 |
if (drmsSysRun::RunCmd($cmd) != 0) |
| 135 |
{ |
| 136 |
print STDERR "Unable to clean $bindir.\n"; |
| 137 |
$rv = &kRetMake; |
| 138 |
} |
| 139 |
else |
| 140 |
{ |
| 141 |
$builddir = "waystation_$bindir"; |
| 142 |
$cmd = "make 'MACH=$builddir' clean"; |
| 143 |
print "runnning $cmd\n"; |
| 144 |
|
| 145 |
if (drmsSysRun::RunCmd($cmd) != 0) |
| 146 |
{ |
| 147 |
print STDERR "Unable to clean $builddir.\n"; |
| 148 |
$rv = &kRetMake; |
| 149 |
} |
| 150 |
} |
| 151 |
} |
| 152 |
} |
| 153 |
else |
| 154 |
{ |
| 155 |
$args = new drmsArgs($argsinH, 1); |
| 156 |
|
| 157 |
if (!defined($args)) |
| 158 |
{ |
| 159 |
$rv = &kRetInvalidArgs; |
| 160 |
} |
| 161 |
else |
| 162 |
{ |
| 163 |
# kArgMods must be defined (otherwise new drmsArgs would have failed). |
| 164 |
@mods = split(qr(,), $args->Get(&kArgMods)); |
| 165 |
@relspecs = split(qr(,), $args->Get(&kArgFiles)); |
| 166 |
$bindir = $opts->Get(&kArgBinDir); |
| 167 |
if (!defined($bindir)) |
| 168 |
{ |
| 169 |
$bindir = $ENV{JSOC_MACHINE}; |
| 170 |
} |
| 171 |
|
| 172 |
if (!defined($bindir)) |
| 173 |
{ |
| 174 |
print STDERR "Binary directory not specified.\n"; |
| 175 |
$rv = &kRetInvalidArgs; |
| 176 |
} |
| 177 |
} |
| 178 |
|
| 179 |
if ($rv == &kRetSuccess) |
| 180 |
{ |
| 181 |
$wdir = getcwd(); |
| 182 |
|
| 183 |
# Make sure that the current directory is a JSOC-tree root. |
| 184 |
# I'm probably going to regret this, but to ensure that the working directory is the root of |
| 185 |
# a JSOC tree, let's consider this a valid tree if it contains base/jsoc_version.h. Let's not |
| 186 |
# count of the current directory being "JSOC" (even though this is a requirement, I know |
| 187 |
# Rick renames his tree root directory to DRMS). |
| 188 |
if (!(-f "$wdir/base/jsoc_version.h")) |
| 189 |
{ |
| 190 |
print STDERR "The current directory is the root of a valid JSOC source-code tree.\n"; |
| 191 |
$rv = kRetInvalidWD; |
| 192 |
} |
| 193 |
} |
| 194 |
|
| 195 |
if ($rv == &kRetSuccess) |
| 196 |
{ |
| 197 |
|
| 198 |
# Update source files. |
| 199 |
$specstr = join(',', @relspecs); |
| 200 |
|
| 201 |
$cmd = "/home/jsoc/dlsource.pl -o update -s $specstr"; |
| 202 |
if (drmsSysRun::RunCmd($cmd) != 0) |
| 203 |
{ |
| 204 |
print STDERR "Unable to update source files.\n"; |
| 205 |
$rv = &kRetDlSource; |
| 206 |
} |
| 207 |
} |
| 208 |
|
| 209 |
# Build modules. |
| 210 |
if ($rv == &kRetSuccess) |
| 211 |
{ |
| 212 |
my($targetstr); |
| 213 |
|
| 214 |
$targetstr = join(' ', @mods); |
| 215 |
|
| 216 |
# Run configure, just to be sure (but this assurance, which is necessary, will trigger a |
| 217 |
# rebuild of pretty much all binaries since it, in essence, updates the timestamps on all |
| 218 |
# headers. I need to make the configure script smarter so that it doesn't re-create |
| 219 |
# all header links. Instead it should simply make a link to a header if the link does |
| 220 |
# not already exist). |
| 221 |
$cmd = "./configure"; |
| 222 |
if (drmsSysRun::RunCmd($cmd) != 0) |
| 223 |
{ |
| 224 |
print STDERR "'configure' falied to run properly.\n"; |
| 225 |
$rv = &kRetConfigure; |
| 226 |
} |
| 227 |
|
| 228 |
# Run make. If the $bindir already exists, then we need to build in waystation_$bindir, and |
| 229 |
# then copy the resulting binaries back to $bindir. But if $bindir does NOT exist, then |
| 230 |
# we simply build in $bindir. |
| 231 |
|
| 232 |
if ($rv == &kRetSuccess) |
| 233 |
{ |
| 234 |
print "bindir is $bindir\n"; |
| 235 |
if (-d "_$bindir") |
| 236 |
{ |
| 237 |
$usewaystation = 1; |
| 238 |
$builddir = "waystation_$bindir"; |
| 239 |
} |
| 240 |
else |
| 241 |
{ |
| 242 |
$usewaystation = 0; |
| 243 |
$builddir = $bindir; |
| 244 |
} |
| 245 |
} |
| 246 |
|
| 247 |
if ($rv == &kRetSuccess) |
| 248 |
{ |
| 249 |
$cmd = "make 'MACH=$builddir' $targetstr"; |
| 250 |
print "runnning $cmd\n"; |
| 251 |
|
| 252 |
if (drmsSysRun::RunCmd($cmd) != 0) |
| 253 |
{ |
| 254 |
print STDERR "Unable to update source files.\n"; |
| 255 |
$rv = &kRetMake; |
| 256 |
} |
| 257 |
} |
| 258 |
} |
| 259 |
|
| 260 |
exit; |
| 261 |
|
| 262 |
# Move the old binaries to a save location, and move the new binaries into locations vacated by |
| 263 |
# the old binaries. |
| 264 |
if ($rv == &kRetSuccess) |
| 265 |
{ |
| 266 |
# $basetime is the time (number of secs since the epoch) when the script started running. |
| 267 |
# For each binary that was created by this script, the binary that will be replaced |
| 268 |
# by this new binary needs to be MOVED into a save directory. Then, the new binary |
| 269 |
# needs to be MOVED into the production tree. |
| 270 |
|
| 271 |
# Binaries whose timestamps are newer than $basetime are considered binaries that |
| 272 |
# were created by this script. |
| 273 |
push(@srcdirs, "$wdir/bin/waystation_$bindir"); |
| 274 |
|
| 275 |
if (MoveFiles($basetime, \@srcdirs) != 0) |
| 276 |
{ |
| 277 |
print STDERR "Unable to move newly created binaries into place.\n"; |
| 278 |
$rv = &kRetMove; |
| 279 |
} |
| 280 |
|
| 281 |
if ($rv == &kRetSuccess) |
| 282 |
{ |
| 283 |
# Remove the links from bin/$builddir to _$builddir. |
| 284 |
if (RemoveLinks() != 0) |
| 285 |
{ |
| 286 |
print STDERR "Unable to remove dead links.\n"; |
| 287 |
$rv = &kRetDelLinks; |
| 288 |
} |
| 289 |
} |
| 290 |
} |
| 291 |
} |
| 292 |
} |
| 293 |
else |
| 294 |
{ |
| 295 |
print STDERR "This script is already running; bailing out.\n"; |
| 296 |
$rv = &kRetNoLock; |
| 297 |
} |
| 298 |
|
| 299 |
exit $rv; |
| 300 |
|
| 301 |
|
| 302 |
sub FormSpecs |
| 303 |
{ |
| 304 |
my($wdir) = $_[0]; |
| 305 |
my($spec) = $_[1]; |
| 306 |
my($fspec); |
| 307 |
my(@rv) = (); |
| 308 |
|
| 309 |
$fspec = File::Spec->catfile($wdir, $spec); |
| 310 |
|
| 311 |
if (-e $fspec) |
| 312 |
{ |
| 313 |
# Strip off the JSOC root prefix. |
| 314 |
if ($fspec =~ /.+\/JSOC\/(.+)/) # 'greedy' algorithm |
| 315 |
{ |
| 316 |
push(@rv, $1); |
| 317 |
} |
| 318 |
} |
| 319 |
else |
| 320 |
{ |
| 321 |
print STDERR "Warning: Invalid file specification '$spec'; skipping.\n"; |
| 322 |
} |
| 323 |
|
| 324 |
return @rv; |
| 325 |
} |
| 326 |
|
| 327 |
sub FilterFile |
| 328 |
{ |
| 329 |
my($afile) = shift; |
| 330 |
|
| 331 |
if ($afile !~ /^\.$/ && $afile !~ /^\.\.$/ && $afile !~ /\.o\.d$/ && $afile !~ /\.o$/) |
| 332 |
{ |
| 333 |
return $afile; |
| 334 |
} |
| 335 |
else |
| 336 |
{ |
| 337 |
return (); |
| 338 |
} |
| 339 |
} |
| 340 |
|
| 341 |
sub GetNewFiles |
| 342 |
{ |
| 343 |
my($basetime) = shift; |
| 344 |
my($dir) = shift; |
| 345 |
my(@files) = @_; |
| 346 |
|
| 347 |
my($timestamp); |
| 348 |
my($tinfo); |
| 349 |
my(@newfiles); |
| 350 |
my($realfile); |
| 351 |
|
| 352 |
@files = map(FilterFile($_), @files); |
| 353 |
|
| 354 |
foreach my $afile (@files) |
| 355 |
{ |
| 356 |
# Resolve links |
| 357 |
$realfile = realpath("$dir/$afile"); |
| 358 |
|
| 359 |
# Now skip files that were not just created. |
| 360 |
$tinfo = stat($realfile); |
| 361 |
|
| 362 |
if (!$tinfo) |
| 363 |
{ |
| 364 |
print STDERR "Unable to stat file $realfile.\n"; |
| 365 |
next; |
| 366 |
} |
| 367 |
|
| 368 |
$timestamp = $tinfo->mtime; |
| 369 |
if ($timestamp < $basetime) |
| 370 |
{ |
| 371 |
next; |
| 372 |
} |
| 373 |
|
| 374 |
if (-f $realfile) |
| 375 |
{ |
| 376 |
# Not a subdirectory. |
| 377 |
push(@newfiles, $realfile); |
| 378 |
} |
| 379 |
elsif (-d $realfile) |
| 380 |
{ |
| 381 |
# A subdirectory. |
| 382 |
my(@dirfiles); |
| 383 |
|
| 384 |
tie(my(%dirH), "IO::Dir", "$realfile"); |
| 385 |
@dirfiles = keys(%dirH); |
| 386 |
push(@newfiles, GetNewFiles($basetime, "$realfile", @dirfiles)); |
| 387 |
untie(%dirH); |
| 388 |
} |
| 389 |
else |
| 390 |
{ |
| 391 |
print STDERR "Invalid file type, file $realfile.\n"; |
| 392 |
} |
| 393 |
} |
| 394 |
|
| 395 |
return @newfiles; |
| 396 |
} |
| 397 |
|
| 398 |
sub GetOldFile |
| 399 |
{ |
| 400 |
my($afile) = shift; |
| 401 |
my($oldfile); |
| 402 |
|
| 403 |
if ($afile =~ /\/_waystation_\S+\//) |
| 404 |
{ |
| 405 |
$oldfile = $afile; |
| 406 |
$oldfile =~ s/_waystation//; |
| 407 |
return $oldfile; |
| 408 |
} |
| 409 |
else |
| 410 |
{ |
| 411 |
print STDERR "Unsupported source file $afile\n"; |
| 412 |
return ""; |
| 413 |
} |
| 414 |
} |
| 415 |
|
| 416 |
# Move newly built files from the _waystation_<arch> directory to the _<arch> directory. |
| 417 |
# First, move the to-be-replaced files in the _<arch> directory to the save directory. |
| 418 |
sub MoveFiles |
| 419 |
{ |
| 420 |
my($basetime) = $_[0]; |
| 421 |
my($srcdirsR) = $_[1]; |
| 422 |
|
| 423 |
my($rv) = 1; |
| 424 |
my($savedir); |
| 425 |
my(%tree); |
| 426 |
my(@allfiles); |
| 427 |
my(@newfiles); |
| 428 |
my(@oldfiles); |
| 429 |
my($srcfile); |
| 430 |
my($tgtfile); |
| 431 |
my($timestamp); |
| 432 |
|
| 433 |
# Collect a list of binary files that were created during the build phase. |
| 434 |
foreach my $dir (@$srcdirsR) |
| 435 |
{ |
| 436 |
if (-d $dir) |
| 437 |
{ |
| 438 |
tie(%tree, "IO::Dir", $dir); |
| 439 |
|
| 440 |
# @allfiles contains base file names (not paths). |
| 441 |
@allfiles = keys(%tree); |
| 442 |
# @newfiles contains full paths. |
| 443 |
push(@newfiles, GetNewFiles($basetime, $dir, @allfiles)); |
| 444 |
untie(%tree); |
| 445 |
} |
| 446 |
else |
| 447 |
{ |
| 448 |
print STDERR "Binary directory $dir does not exist.\n"; |
| 449 |
last; |
| 450 |
} |
| 451 |
} |
| 452 |
|
| 453 |
# Find the original files that these new files will replace |
| 454 |
foreach $srcfile (@newfiles) |
| 455 |
{ |
| 456 |
$tgtfile = GetOldFile($srcfile); |
| 457 |
print "new file $srcfile, old file $tgtfile\n"; |
| 458 |
|
| 459 |
# Move old file to save directory. |
| 460 |
# ART |
| 461 |
} |
| 462 |
|
| 463 |
|
| 464 |
# for now, print new files |
| 465 |
exit; |
| 466 |
|
| 467 |
|
| 468 |
# Must create link from JSOC/bin/$bindir to each binary installed, and from JSOC/lib/$bindir to each |
| 469 |
# library installed. |
| 470 |
return $rv; |
| 471 |
} |
