view release on metacpan or  search on metacpan

DSB.pm  view on Meta::CPAN

tool to completely replace any pre-existing identity information. This
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;
    my $rc = 0;
    for my $vws (@ARGV) {
	my $idedir = "$vws/.identity";
	if (! -f "$vws/config_spec" || ! -d $idedir) {
	    warn Msg('W', "not a view storage area: $vws");
	    $rc = 1;
	    next;
	}
	if (! $opt{force}) {
	    my $prompt = qq(Protect view "$vws"?);
	    require ClearCase::ClearPrompt;
	    next if ClearCase::ClearPrompt::clearprompt(
			    qw(yes_no -def n -type ok -pro), $prompt);
	}
	if (-e "$vws/.pid") {
	    if ($opt{force}) {
		my $tag = $opt{tag};
		$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;
		}
		my $grp = "$idedir/group.$gid";
		unlink($grp);
	    }
	}
	if ($opt{add_group}) {
	    for (split ',', $opt{add_group}) {
		my $gid = /^\d+$/ ? $_ : (getgrnam($_))[2];
		if (! $gid) {
		    warn Msg('W', "no such group: $_");
		    $rc = 1;
		    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);
}

=item * RECO/RECHECKOUT

Redoes a checkout without the database operations by simply copying the
contents of the existing checkout's predecessor over the view-private
checkout file. The previous contents are moved aside to "<element>.reco".
The B<-keep> and B<-rm> options are honored by analogy with I<uncheckout>.

=cut

sub recheckout {
    my %opt;
    GetOptions(\%opt, qw(keep rm));
    shift @ARGV;
    require File::Copy;
    for (@ARGV) {
	$_ = readlink if -l && defined readlink;
	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;
}

=item * RMELEM

It appears that when elements are removed with I<rmelem> they often
remain visible for quite a while due to some kind of view cache,
though attempts to actually open them result in an I/O error. Running
I<cleartool setcs -current> clears this up. Thus I<rmelem> is
overridden here to add an automatic view refresh when done.

=cut

sub rmelem {
    my $rc = ClearCase::Argv->new(@ARGV)->system;

DSB.pm  view on Meta::CPAN

	ct winkout -meta .WINKSET X Y Z

will make them into derived objects and create a 4th DO ".WINKSET"
containing references to the others. A subsequent

	ct winkin -recurse -adirs /view/extended/path/to/.WINKSET

from a different view will wink all four files into the current view.

The list of files to convert may be derived via
B<-dir/-rec/-all/-avobs>, provided in a file containing a list of files
with B<-flist>, or specified as a literal list of view-private files.
When using B<-dir/-rec/-all/-avobs> to derive the file list only the
output of C<lsprivate -other> is considered unless B<-do> is used;
B<-do> causes existing DO's to be re-converted. Use B<-do> with care as
it may convert a useful CR to a meaningless one.

The B<"-flist -"> flag can be used to read the file list from stdin,
which may be useful in a script.

=cut

sub winkout {
    warn Msg('E', "this may work on &%@# Windows but I haven't tried") if MSWIN;
    my %opt;
    GetOptions(\%opt, qw(directory recurse all avobs flist=s
					do meta=s print promote));
    my $ct = ClearCase::Argv->new({-autochomp=>1, -syfail=>1});

    my $dbg = Argv->dbglevel;

    my $cmd = shift @ARGV;
    my @list;
    if (my @scope = grep /^(dir|rec|all|avo|f)/, keys %opt) {
	die Msg('E', "mutually exclusive flags: @scope") if @scope > 1;
	if ($opt{flist}) {
	    open(LIST, $opt{flist}) || die Msg('E', "$opt{flist}: $!");
	    @list = <LIST>;
	    close(LIST);
	} else {
	    my @type = $opt{'do'} ? qw(-other -do) : qw(-other);
	    @list = Argv->new([$^X, '-S', $0, 'lsp'],
		    ['-s', @type, "-$scope[0]"])->qx;
	}
    } else {
	@list = @ARGV;
    }
    chomp @list;
    my %set = map {$_ => 1} grep {-f}
		    grep {!m%\.(?:mvfs|nfs)\d+|cmake\.state%} @list;
    exit 0 if ! %set;
    if ($opt{'print'}) {
	for (keys %set) {
	    print $_, "\n";
	}
	print $opt{meta}, "\n" if $opt{meta};
	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" }
	close(META);
	push(@dolist, $opt{meta});
    }
    # Convert regular view-privates into DO's by opening them
    # under clearaudit control.
    {
	my $clearaudit = MSWIN ? 'clearaudit' : '/usr/atria/bin/clearaudit';
	local $ENV{CLEARAUDIT_SHELL} = $^X;
	my $ecmd = 'chomp; open(DO, ">>$_") || warn "Error: $_: $!\n"';
	my $cmd = qq($clearaudit -n -e '$ecmd');
	$cmd = "set -x; $cmd" if $dbg && !MSWIN;
	open(AUDIT, "| $cmd") || die Msg('E', "$cmd: $!");
	for (@dolist) {
	    print AUDIT $_, "\n";
	    print STDERR $_, "\n" if $dbg;
	}
	close(AUDIT) || die Msg('E', $! ?
				"Error closing clearaudit pipe: $!" :
				"Exit status @{[$?>>8]} from clearaudit");
    }
    if ($opt{promote}) {
	my $scrubber = MSWIN ? 'view_scrubber' : '/usr/atria/etc/view_scrubber';
	my $cmd = "$scrubber -p";
	$cmd = "set -x; $cmd" if $dbg && !MSWIN;
	open(SCRUBBER, "| $cmd") || die Msg('E', "$scrubber: $!");
	for (@dolist) { print SCRUBBER $_, "\n" }
	close(SCRUBBER) || die Msg('E', $! ?
				"Error closing $scrubber pipe: $!" :
				"Exit status $? from $scrubber");
    }
    exit 0;
}

=item * WORKON

New command, similar to I<setview> but provides hooks to cd to a
preferred I<initial working directory> within the view and to set
up any required environment variables. The I<initial working directory>
is defined as the output of B<ct catcs -start> (see).

If a file called I<.viewenv.pl> exists in the I<initial working
directory>, it's read before starting the user's shell. This file uses
Perl syntax and must end with a "1;" like any C<require-d> file.  Any
unrecognized arguments given to I<workon> following the view name will
be passed on to C<.viewenv.pl> in C<@ARGV>. Environment variables
required for builds within the setview may be set here.

=cut