#!/usr/bin/perl ######################################################################### # # trig_restrict.pl # # Description: # This trigger is invoked when trying to perform the rmelem, rmver, or # rmbranch functions. The trigger checks for these actions and returns # a message and a bad status so that the action in ClearCase fails. # # This trigger also has a self install feature. # ######################################################################### use strict; my $TRIGGER_NAME = "trig_restrict"; my $WINPERL = "c:/program files/rational/clearcase/bin/ccperl"; my $UNIX_TRIG_EXE = "/net/MACHINE/PATH/trig_restrict.pl"; my $WIN_TRIG_EXE = "$WINPERL //MACHINE/PATH/trig_restrict.pl"; my $ADMIN_EMAIL = "clearcase_admins\@x.com"; my $EXCLUDED_USERS = "vobadmin"; my $OS = (eval{Win32::IsWinNT();},$@) ? "UNIX" : "NT"; my $ATRIAHOME; my $CT; if ($OS eq "NT") { $ATRIAHOME = $ENV{"ATRIA_HOME"} || 'c:/program files/rational/clearcase'; $CT = "$ATRIAHOME/bin/cleartool.exe"; (-x $CT) || die "Cannot find an executable cleartool"; $CT = "\"$CT\""; } else { $ATRIAHOME = "/opt/rational/clearcase"; $CT = "$ATRIAHOME/bin/cleartool"; (-x $CT) || die "Cannot find an executable cleartool"; } # subroutine determines the basename of the object sub basename { my ($pname) = @_; $_ = $pname; # The whole thing is the basename if there are no slashes return $pname unless /[\\\/]/; /(.*)[\\\/](.*)/; # $2 is the base name return $2; } my $me = &basename($0); my $usage = "Usage: $me [-i/nstall] [-r/eplace] [-v/ob vob-tag]\n" . " $me [-h]\n" . " $me\n"; my $install; my $replace; my $vob; while ($_ = shift(@ARGV)) { if (/^-i/) { $install = 1; next; } if (/^-r/) { $replace = "-replace"; next; } if (/^-v/) { $vob = shift(@ARGV); next; } if (/^-h/) { print($usage); exit 1; } } if ($install) { unless ($vob) { print ("Error: Vob not specified.\n"); exit 1; } # Check to see that it is a valid vob. my @voblist = `$CT lsvob -short $vob`; (my $vob_vf) = @voblist; chomp($vob_vf); if ($vob ne $vob_vf) { print ("Error: Invalid vob specified.\n"); exit 1; } # If the replace flag is not set, check to see if the trigger type # already exists on the vob. Fail if it already exists. if (! $replace) { my @triglist = `$CT lstype -short trtype:${TRIGGER_NAME}\@${vob}`; (my $trig) = @triglist; chomp($trig); if ($trig eq "${TRIGGER_NAME}") { print ("Error: Trigger already exists and -replace option not specified.\n"); exit 1; } } my $cmd = "$CT mktrtype " . " -c \"Prevent dangerous operations.\" " . " -element -all ${replace} " . " -nusers ${EXCLUDED_USERS} " . " -preop rmelem,rmver,rmbranch " . " -execunix ${UNIX_TRIG_EXE} " . " -execwin \"${WIN_TRIG_EXE}\" " . " ${TRIGGER_NAME}\@${vob} "; my @response = `${cmd}`; if (grep(/Error:/,@response)) { print ("Error: Trigger creation failed.\n"); exit 1; } print ("OK: Trigger successfully installed.\n"); exit 0; } my $pn = $ENV{"CLEARCASE_PN"}; my $user = $ENV{'CLEARCASE_USER'}; my $branch = $ENV{'CLEARCASE_BRTYPE'}; my $op = $ENV{'CLEARCASE_OP_KIND'}; # prevent unauthorized version and element removal. if ($op eq "rmver" || $op eq "rmelem") { print STDERR "\nERROR: You are not allowed to remove elements/versions\n\n"; print STDERR "Please contact a ClearCase administrator with questions.\n"; print STDERR "Administrators can be emailed at \"${ADMIN_EMAIL}\".\n\n"; exit 1; } # prevent unauthorized branch removal... my $branch_dir; my $branch_ver; if ($op eq "rmbranch") { my @br_array = split(/[\\\/]/, $ENV{"CLEARCASE_XPN"}); if ($OS eq "NT") { $branch_dir = join("\\", @br_array); $branch_ver = "${branch_dir}\\0"; } else { $branch_dir = join("/", @br_array); $branch_ver = "${branch_dir}/0"; } # Check to see if there are any versions besides LATEST and 0 my @vers = `$CT ls -short $branch_dir`; chomp(@vers); my $stat = $?; foreach (@vers) { $_ = &basename($_); next if $_ eq "LATEST"; next if $_ eq "0"; #something other than "LATEST, 0, ., ..": print STDERR "ERROR: Branch ${branch_ver} not removed. Other versions exist.\n\n"; print STDERR "Please contact a ClearCase administrator with questions.\n"; print STDERR "Administrators can be emailed at \"${ADMIN_EMAIL}\".\n\n"; exit 1; } my @status = `$CT describe -ahlink -all -aattr -all ${branch_ver}`; chomp(@status); $stat = $?; if ($stat) { print STDERR "\nERROR: Branch ${branch_ver} not removed. Cleartool error.\n\n"; print STDERR "Please contact a ClearCase administrator with questions.\n"; print STDERR "Administrators can be emailed at \"${ADMIN_EMAIL}\".\n\n"; exit 1; } foreach (@status) { if (/^\s*Hyperlinks:/) { print STDERR "\nERROR: Branch ${branch_ver} not removed. Hyperlinks exist.\n\n"; print STDERR "Please contact a ClearCase administrator with questions.\n"; print STDERR "Administrators can be emailed at \"${ADMIN_EMAIL}\".\n\n"; exit 1; } if (/^\s*Attributes:$/) { print STDERR "ERROR: Branch ${branch_ver} not removed. Attributes exist.\n\n"; print STDERR "Please contact a ClearCase administrator with questions.\n"; print STDERR "Administrators can be emailed at \"${ADMIN_EMAIL}\".\n\n"; exit 1; } } } exit 0;