cc/mktriggers.pl

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4
   5 =head2 NAME $RCSfile: mktriggers.pl,v $
   6
   7 Enforce the application of triggers to vobs
   8
   9 =head2 VERSION
  10
  11 =over
  12
  13 =item Author
  14
  15 Andrew DeFaria <Andrew@ClearSCM.com>
  16
  17 =item Revision:
  18
  19 $Revision: 1.6 $
  20
  21 =item Created:
  22
  23 Sat Apr  3 09:06:11 PDT 2003
  24
  25 =item Modified:
  26
  27 $Date: 2011/03/24 22:22:00 $
  28
  29 =head2 SYNOPSIS
  30
  31  Usage: mktriggers.pl [-u|sage] [-[no]e|xec] [-[no]a|dd] [-[no]r|eplace]
  32                       [-[no]p|rivate] [ -vobs ] [-ve|rbose] [-d|ebug]
  33
  34  Where:
  35
  36   -u|sage:       Displays usage
  37   -[no]e|exec:   Execute mode (Default: Do not execute)
  38   -[no]a|dd:     Add any missing triggers (Default: Don't add)
  39   -[no]r|eplace: Replace triggers even if already present (Default:
  40                  Don't replace)
  41
  42                  Note: If neither -add nor -replace is specified then
  43                  both -add and -replace are performed.
  44
  45   -triggers:     Name of triggers.dat file (Default:
  46                  $FindBin::Bin/../etc/triggers.dat)
  47   -[no]p|rivate: Process private vobs (Default: Don't process private
  48                  vobs)
  49
  50   -ve|rbose:     Be verbose
  51   -d|ebug:       Output debug messages
  52
  53   -vob           List of vob tags to apply triggers to (default all vobs)
  54
  55 Note: You can specify -vob /vobs/vob1,/vobs/vob2 -vob /vobs/vob3 which will
  56 result in processing all of /vobs/vobs1, /vobs/vob2 and /vobs/vob3.
  57
  58 =head2 DESCRIPTION
  59
  60 This script parses triggers.dat and created trigger types in vobs. It is
  61 designed to be run periodically (cron(1)) and will add/replace triggers on
  62 all vobs by default. It can also operate on individual vobs if required. The
  63 script is driven by a data file, triggers.dat, which describes which triggers
  64 are to be enforced one which vobs.
  65
  66 =head3 triggers.dat
  67
  68 File format: Lines beginning with "#" are treated as comments Blank lines are
  69 skipped. Spaces and tabs can be used for whitespace.
  70
  71   # Globals
  72   WinTriggerPath:       \\<NAS device>\clearscm\triggers
  73   LinuxTriggerPath:     /net/<NAS device>/clearscm/triggers
  74
  75   # All vobs get the evil twin trigger
  76   Trigger: EVILTWIN
  77     Description:        Evil Twin Prevention Trigger
  78     Type:               -all -element
  79     Opkinds:            -preop lnname
  80     ScriptEngine:       Perl
  81     Script:             eviltwin.pl
  82   EndTrigger
  83
  84   # Only these vobs get this trigger to enforce a naming policy
  85   # Note the trigger script gets a parameter
  86   Trigger: STDNAMES
  87     Description:        Enforce standard naming policies
  88     Type:               -all -element
  89     Opkinds:            -preop lnname
  90     ScriptEngine:       Perl
  91     Script:             stdnames.pl -lowercase
  92     Vobs:               \dbengine, \backend
  93   EndTrigger
  94
  95   # All vobs get rmelen trigger except ours!
  96   Trigger: RMELEM
  97     Description:        Disable RMELEM
  98     Type:               -all -element
  99     Opkinds:            -preop lnname
 100     ScriptEngine:       Perl
 101     Script:             rmelem.pl
 102     Novobs:             \scm
 103   EndTrigger
 104
 105 =head2 ENVIRONMENT
 106
 107 If the environment variable VEBOSE or DEBUG are set then it's as if -verbose
 108 or -debug was specified.
 109
 110 =head2 COPYRIGHT
 111
 112 Copyright (c) 2004 Andrew DeFaria , ClearSCM, Inc.
 113 All rights reserved.
 114
 115 =cut
 116
 117 use FindBin;
 118
 119 use Getopt::Long;
 120
 121 use lib "$FindBin::Bin/../lib";
 122
 123 use Display;
 124 use OSDep;
 125
 126 # Where is the trigger source code kept?
 127 my ($windows_trig_path, $linux_trig_path);
 128
 129 # Where is the trigger definition file?
 130 my $etc_path = "$FindBin::Bin/../etc";
 131 my $triggerData = "$etc_path/triggers.dat";
 132
 133 sub Usage (;$) {
 134   my ($msg) = @_;
 135
 136   display $msg
 137     if $msg;
 138
 139   system "perldoc $FindBin::Script";
 140
 141   exit 1;
 142 } # Usage
 143
 144 sub ParseTriggerData {
 145   open my $triggerData, '<', $triggerData
 146     or error "Unable to open $triggerData - $!", 1;
 147
 148   my @triggers;
 149   my ($name, $desc, $type, $opkinds, $engine, $script, $vobs, $novobs);
 150
 151   while (<$triggerData>) {
 152     chomp; chop if /\r$/;
 153
 154     next if /^$/; # Skip blank lines
 155     next if /^\#/; # and comments
 156
 157     s/^\s+//; # ltrim
 158     s/\s+$//; # rtrim
 159
 160     if (/^\s*WinTriggerPath:\s*(.*)/i) {
 161       $windows_trig_path = $1;
 162       next;
 163     } # if
 164
 165     if (/^\s*LinuxTriggerPath:\s*(.)/i) {
 166       $linux_trig_path = $1;
 167       next;
 168     } # if
 169
 170     if (/^\s*Trigger:\s*(.*)/i) {
 171       $name = $1;
 172       next;
 173     } # if
 174
 175     if (/^\s*Description:\s*(.*)/i) {
 176       $desc = $1;
 177       next;
 178     } # if
 179
 180     if (/^\s*Type:\s*(.*)/i) {
 181       $type = $1;
 182       next;
 183     } # if
 184
 185     if (/^\s*Opkinds:\s*(.*)/i) {
 186       $opkinds = $1;
 187       next;
 188     } # if
 189
 190     if (/^\s*ScriptEngine:\s*(.*)/i) {
 191       $engine = $1;
 192       next;
 193     } # if
 194
 195     if (/^\s*Script:\s*(.*)/i) {
 196       $script = $1;
 197       next;
 198     } # if
 199
 200     if (/^\s*Vobs:\s*(.*)/i) {
 201       $vobs = $1;
 202       next;
 203     } # if
 204
 205     if (/^\s*Novobs:\s*(.*)/i) {
 206       $novobs = $1;
 207       next;
 208     } # if
 209
 210     if (/EndTrigger/) {
 211       my %trigger;
 212
 213       $trigger{name}    = $name;
 214       $trigger{desc}    = $desc;
 215       $trigger{type}    = $type;
 216       $trigger{opkinds} = $opkinds;
 217       $trigger{engine}  = $engine;
 218       $trigger{script}  = $script;
 219       $trigger{vobs}    = !$vobs  ? 'all'   : $vobs;
 220       $trigger{novobs}  = $novobs ? $novobs : '';
 221
 222       push (@triggers, \%trigger);
 223
 224       $name = $desc = $type = $opkinds = $engine = $script = $vobs = $novobs = "";
 225     } # if
 226   } # while
 227
 228   close $triggerData;
 229
 230   error 'You must define WindowsTriggerPath, LinuxTriggerPath or both', 1
 231     unless ($windows_trig_path or $linux_trig_path);
 232
 233   return @triggers;
 234 } # ParseTriggerData
 235
 236 sub RemoveVobPrefix ($) {
 237   my ($vob) = @_;
 238
 239   if ($ARCH =~ /windows/ or $ARCH =~ /cygwin/) {
 240     $vob =~ s/^\\//;
 241   } else {
 242     $vob =~ s/^\/vobs\///;
 243   } # if
 244
 245   return $vob;
 246 } # RemoveVobPrefix
 247
 248 sub MkTriggerType ($$$$%) {
 249   my ($vob, $exec, $add, $replace, %trigger) = @_;
 250
 251   my $replaceOpt = '';
 252
 253   # Need an extra set of "\\" for non Windows systems such as Cygwin
 254   # since apparently the shell if envoked, collapsing a set of "\\".
 255   my $vobtag = $ARCH =~ /cygwin/i ? "\\$vob" : $vob;
 256   my $status = system ("cleartool lstype trtype:$trigger{name}\@$vobtag > $NULL 2>&1");
 257
 258   if ($status == 0) {
 259     debug "Found pre-existing trigger $trigger{name}";
 260
 261     # If we are not replacing then skip by returning
 262     return
 263       unless $replace;
 264
 265     $replaceOpt = '-replace';
 266   } else {
 267     debug "No pre-existing trigger $trigger{name}";
 268
 269     # We need to add the trigger. However, if we are not adding then skip by
 270     # returning
 271     return
 272       unless $add;
 273   } # if
 274
 275   error "Sorry I only support ScriptEngines of Perl!" if $trigger{engine} ne "Perl";
 276
 277   my $win_engine = 'ccperl';
 278   my $linux_engine = 'Perl';
 279
 280   my ($script, $parm) = split / /, $trigger{script};
 281
 282   $parm ||= '';
 283
 284   my ($win_script, $linux_script, $execwin, $execlinux);
 285
 286   $execwin = $execlinux = '';
 287
 288   if ($windows_trig_path) {
 289     $win_script = $ARCH =~ /cygwin/i ? "\\\\$windows_trig_path\\$script"
 290                                      : "$windows_trig_path\\$script";
 291
 292     warning "Unable to find trigger script $win_script ($!)"
 293       if ($ARCH =~ /windows/i and $ARCH =~ /cygwin/) and not -e $win_script;
 294
 295     $execwin = "-execwin \"$win_engine $win_script $parm\" ";
 296   } elsif ($linux_trig_path) {
 297     $linux_script = "$linux_trig_path/$script";
 298
 299     warning "Unable to find trigger script $linux_script ($!)"
 300       if ($ARCH !~ /windows/i and $ARCH !~ /cygwin/) and not -e $linux_script;
 301
 302     $execlinux = "-execwin \"$win_engine $win_script $parm\" ";
 303   } # if
 304
 305   my $command =
 306     'cleartool mktrtype '          .
 307     "$replaceOpt "                 .
 308     "$trigger{type} "              .
 309     "$trigger{opkinds} "           .
 310     "-comment \"$trigger{desc}\" " .
 311     $execwin                       .
 312     $execlinux                     .
 313     "$trigger{name}\@$vobtag "     .
 314     "> $NULL 2>&1";
 315
 316   debug "Command: $command";
 317
 318   $vob =~ s/\\\\/\\/;
 319
 320   $status = 0;
 321   $status = system $command
 322     if $exec;
 323
 324   if ($status) {
 325     error "Unable to add trigger! Status = $status\nCommand: $command";
 326     return 1;
 327   } # if
 328
 329   if ($replaceOpt) {
 330     if ($replace) {
 331       if ($exec) {
 332         display "Replaced trigger $trigger{name} in $vob";
 333       } else {
 334         display "[noexecute] Would have replaced trigger $trigger{name} in $vob";
 335       } # if
 336     } # if
 337   } else {
 338     if ($add) {
 339       if ($exec) {
 340         display "Added trigger $trigger{name} to $vob";
 341       } else {
 342         display "[noexecute] Would have added trigger $trigger{name} to $vob";
 343       } # if
 344     } # if
 345   } # if
 346
 347   return;
 348 } # MkTriggerType
 349
 350 sub VobType ($) {
 351   my ($vob) = @_;
 352
 353   # Need an extra set of "\\" for non Windows systems such as Cygwin
 354   # since apparently the shell if envoked, collapsing a set of "\\".
 355   $vob = "\\" . $vob if $ARCH =~ /cygwin/;
 356
 357   my @lines = `cleartool describe vob:$vob`;
 358
 359   chomp @lines; chop @lines if $lines[0] =~ /\r$/;
 360
 361   foreach (@lines) {
 362     return 'ucm'
 363       if /AdminVOB \<-/;
 364   } # foreach
 365
 366   return 'base';
 367 } # VobType
 368
 369 sub MkTriggers ($$$$@) {
 370   my ($vob, $exec, $add, $replace, @triggers) = @_;
 371
 372  TRIGGER: foreach (@triggers) {
 373     my %trigger = %{$_};
 374
 375     my $vobname = RemoveVobPrefix $vob;
 376
 377     # Skip vobs on the novobs list
 378     foreach (split /[\s+|,]/, $trigger{novobs}) {
 379       my $vobtag = RemoveVobPrefix $_;
 380
 381       if ($vobname eq RemoveVobPrefix $_) {
 382         debug "Skipping $vob (on novobs list)";
 383         next TRIGGER;
 384       } # if
 385     } # foreach
 386
 387     # For triggers whose vob type is "all" or unspecified make the trigger
 388     if ($trigger{vobs} eq 'all' || $trigger{vobs} eq '') {
 389       MkTriggerType $vob, $exec, $add, $replace, %trigger;
 390     } elsif ($trigger{vobs} eq 'base' || $trigger{vobs} eq 'ucm') {
 391       # If vob type is "base" or "ucm" make sure the vob is of correct type
 392       my $vob_type = VobType ($vob);
 393
 394       if ($vob_type eq $trigger{vobs}) {
 395         MkTriggerType $vob, $exec, $add, $replace, %trigger;
 396       } else {
 397         verbose "Trigger $trigger{name} is for $trigger{vobs} vobs but $vob is a $vob_type vob - Skipping...";
 398       } # if
 399     } else {
 400       my @Vobs = split /[\s+|,]/, $trigger{vobs};
 401
 402       # Otherwise we expect the strings in $triggers{vobs} to be space or comma
 403       # separated vob tags so we make sure it matches this $vob.
 404       foreach (@Vobs) {
 405         if ($vobname eq RemoveVobPrefix $_) {
 406           MkTriggerType $vob, $exec, $add, $replace, %trigger;
 407           last;
 408         } # if
 409       } # foreach
 410     } # if
 411   } # foreach
 412
 413   return;
 414 } # MkTriggers
 415
 416 my ($exec, $add, $replace, $private, @vobs) = (0, 0, 0, 0);
 417
 418 GetOptions (
 419   usage         => sub { Usage },
 420   verbose       => sub { set_verbose },
 421   debug         => sub { set_debug },
 422   'triggers=s', \$triggerData,
 423   'exec!',      \$exec,
 424   'add!',       \$add,
 425   'replace!',   \$replace,
 426   'private!',   \$private,
 427   'vobs=s',     \@vobs,
 428 ) or Usage "Invalid parameter";
 429
 430 # This allows comma separated parms like -vob vob1,vob2,etc.
 431 @vobs = split /,/, join (',', @vobs);
 432
 433 # If the user didn't specify -add or -replace then toggle both on
 434 $add = $replace = 1
 435   unless $add or $replace;
 436
 437 # If the user didn't specify any -vobs then that means all vobs
 438 @vobs = `cleartool lsvob -short`
 439   unless @vobs;
 440
 441 chomp @vobs; chop @vobs if $vobs[0] =~ /\r/;
 442
 443 # Parse the triggers.dat file
 444 debug "Parsing trigger data ($triggerData)";
 445
 446 my @triggers = ParseTriggerData;
 447
 448 # Iterrate through the list of vobs
 449 debug 'Processing ' . scalar @vobs . ' vobs';
 450
 451 foreach (sort @vobs) {
 452   # Need an extra set of "\\" for non Windows systems such as Cygwin
 453   # since apparently the shell if envoked, collapsing a set of "\\".
 454   my $vob = $ARCH =~ /cygwin/i ? "\\$_" : $_;
 455   my $line = `cleartool lsvob $vob`;
 456
 457   # Skip private vobs
 458   unless ($private) {
 459     if ($line =~ / private/) {
 460       verbose "Skipping private vob $vob...";
 461       next;
 462     } # if
 463   } # unless
 464
 465   $vob =~ s/\\\\/\\/;
 466
 467   debug "Applying triggers to $vob...";
 468
 469   MkTriggers $_, $exec, $add, $replace, @triggers;
 470 } # foreach
 471
 472 debug 'All triggers applied';