ClearCase-Wrapper-DSB
view release on metacpan or search on metacpan
- Minor formatting improvements.
- Added -needed flag to setcs.
1.07 Fri Oct 18 12:10:40 EDT 2002
- Override 'rmelem' to flush the view cache when done.
- Override 'update' to add -quiet flag (suppress "Loading ..." msgs)
- New 'protectview' command by analogy with 'protectvob'.
Doesn't yet support -chown or -chgrp, just -add and -delete.
1.08 Tue Feb 4 21:10:35 EST 2003
- Added -chown/chgrp/-chmod plus -tag and -replace to protectview.
1.09 Tue Jul 22 10:56:06 EDT 2003
- Fixed contact data.
1.10 Thu Mar 10 11:30:00 EST 2005
- Added "describe -par/ents" feature.
1.11 Mon Mar 14 00:00:51 EST 2005
- Cleanups occasioned by port to new environment.
Worked around an apparent bug in 5.6.1: the statement
# Usage messages for pseudo cleartool commands that we implement here.
# Note: we used to localize $0 but that turns out to trigger a bug
# in perl 5.6.1.
my $z = (($ARGV[0] eq 'help') ? $ARGV[1] : $ARGV[0]) || '';
$comment = "$z [-new] [-element] object-selector ...";
$diffcs = "$z view-tag-1 [view-tag-2]";
$eclipse = "$z element ...";
$edattr = "$z [-view [-tag view-tag]] | [-element] object-selector ...";
$grep = "$z [grep-flags] pattern element";
$protectview = "$z [-force] [-replace]"
. "\n[-chown login-name] [-chgrp group-name] [-chmod permissions]"
. "\n[-add_group group-name[,...]]"
. "\n[-delete_group group-name[,...]]"
. "\n{-tag view-tag | view-storage-dir-pname ...}";
$recheckout = "$z [-keep|-rm] pname ...";
$winkout = "$z [-dir|-rec|-all] [-f file] [-pro/mote] [-do]"
. "\n[-meta file [-print] file ...";
$workon = "$z [-me] [-login] [-exec command-invocation] view-tag";
}
#############################################################################
gives the view's permissions a "clean start"; in particular, any grants
of access to other groups will be removed.
This operation will not work on a running view. Views must be
manually stopped with C<endview -server> before reprotection may proceed.
B<Warning>: this is an experimental interface which has not been tested
in all scenarios. It cannot destroy any data, so there's nothing it
could break which could't be fixed with an administrator's help, but it
should still be used with care. In particular, it's possible to
specify values to B<-chmod> which will confuse the view greatly.
=cut
sub protectview {
die Msg('E', "not yet supported on Windows") if MSWIN;
my %opt;
GetOptions(\%opt, qw(force replace tag=s add_group=s delete_group=s
chown=s chgrp=s chmod=s));
my $cmd = shift @ARGV;
if ($opt{tag}) {
Assert(@ARGV == 0); # -tag and vws area are mutually exclusive
my($vws) = (split ' ', ClearCase::Argv->lsview($opt{tag})->qx)[-1];
push(@ARGV, $vws);
}
Assert(@ARGV > 0); # die with usage msg if no vws area specified
Assert(scalar %opt, 'no options specified');
die Msg('E', "$cmd -chown requires administrative privileges")
if $opt{chown} && $> != 0;
$tag ||= ClearCase::Argv->lsview([qw(-s -storage)], $vws)->qx;
chomp $tag;
ClearCase::Argv->endview([qw(-server)], $tag)->system;
}
if (-e "$vws/.pid") {
warn Msg('W', "cannot protect running view $vws");
$rc = 1;
next;
}
}
if ($opt{chown} || $opt{chgrp} || $opt{chmod}) {
my $uid = $opt{chown} || (stat "$idedir/uid")[4];
$uid = (getpwnam($uid))[2] unless $uid =~ /^\d+$/;
my $gid = $opt{chgrp} || (stat "$idedir/gid")[5];
$gid = (getgrnam($gid))[2] unless $gid =~ /^\d+$/;
if ($opt{replace}) {
my $fp = Argv->new('/usr/atria/etc/utils/fix_prot');
$fp->opts(qw(-root -recurse));
$fp->opts($fp->opts, '-force') if $opt{force};
$fp->opts($fp->opts, '-chown', $uid);
$fp->opts($fp->opts, '-chgrp', $gid);
$fp->opts($fp->opts, '-chmod', $opt{chmod}) if $opt{chmod};
$fp->args($vws);
if ($fp->system) {
$rc = 1;
next;
}
} else {
if ($opt{chown} || $opt{chgrp}) {
unlink("$idedir/group.$gid") if $opt{chgrp};
if (Argv->chown([qw(-R -h)], "$uid:$gid", $vws)->system) {
$rc = 1;
next;
}
}
if ($opt{chmod}) {
if (Argv->chmod(['-R'], $opt{chmod}, $vws)->system) {
$rc = 1;
next;
}
for my $grp (glob("$idedir/group.*")) {
chmod(0102410, $grp) || warn Msg('W', "$grp: $!");
}
}
chmod(0104400, "$idedir/uid") ||
warn Msg('W', "$idedir/uid: $!");
chmod(0102410, "$idedir/gid") ||
warn Msg('W', "$idedir/gid: $!");
}
}
if ($opt{delete_group}) {
for (split ',', $opt{delete_group}) {
my $gid = /^\d+$/ ? $_ : (getgrnam($_))[2];
if (! $gid) {
warn Msg('W', "no such group: $_");
$rc = 1;
next;
next;
}
my $grp = "$idedir/group.$gid";
unlink($grp);
if (! open(GID, ">$grp")) {
warn Msg('W', "$vws: unable to add group $_");
$rc = 1;
next;
}
close(GID);
if (! chown(-1, $gid, $grp) || ! chmod(0102410, $grp)) {
warn Msg('W', "$vws: unable to add group $_: $!");
$rc = 1;
next;
}
}
}
}
exit($rc);
}
if (! -w $_) {
warn Msg('W', "$_: not checked out");
next;
}
my $pred = Pred($_, 1);
my $keep = "$_.reco";
unlink $keep;
if (rename($_, $keep)) {
if (File::Copy::copy($pred, $_)) {
my $mode = (stat $keep)[2];
chmod $mode, $_;
} else {
die Msg('E', (-r $_ ? $keep : $_) . ": $!");
}
} else {
die Msg('E', "cannot rename $_ to $keep: $!");
}
unlink $keep if $opt{rm};
}
exit 0;
}
# Shared DO's should be g+w!
(my $egid = $)) =~ s%\s.*%%;
for (keys %set) {
my($mode, $uid, $gid) = (stat($_))[2,4,5];
if (!defined($mode)) {
warn Msg('W', "no such file: $_");
delete $set{$_};
next;
}
next if $uid != $> || ($mode & 0222) || ($mode & 0220 && $gid == $egid);
chmod(($mode & 07777) | 0220, $_);
}
my @dolist = sort keys %set;
# Add the -meta file to the list of DO's if specified.
if ($opt{meta}) {
if ($dbg) {
my $num = @dolist;
print STDERR "+ associating $num files with $opt{meta} ...\n";
}
open(META, ">$opt{meta}") || die Msg('E', "$opt{meta}: $!");
for (@dolist) { print META $_, "\n" }
( run in 0.399 second using v1.01-cache-2.11-cpan-496ff517765 )