Hallo, dies ist ein Test.

PWD: /www/data-lst1/unixsoft/unixsoft/kaempfer/.public_html

Running in File Mode
Relative path: ./../../../../../data-lst1/../../sbin/projdel
Real path: /usr/sbin/projdel
Zurück

#!/usr/perl5/5.36/bin/perl -tw
#
# Copyright (c) 2000, 2023, Oracle and/or its affiliates.
#

require 5.005;
use strict;
use locale;
use Errno;
use Fcntl;
use File::Basename;
use Getopt::Long qw(:config no_ignore_case bundling);
use POSIX qw(locale_h);
use Sun::Solaris::Utils qw(textdomain gettext);
use Sun::Solaris::Project qw(:ALL :PRIVATE);

no warnings qw(taint);

#
# Print a usage message and exit.
#
sub usage
{
	my (@msg) = @_;
	my $prog = basename($0);
	print(STDERR "$prog: @msg\n") if (@msg);
	printf(STDERR gettext("Usage: %s [-f filename] project\n"), $prog);
	exit(2);
}

#
# Print a list of error messages and exit.
#
sub error
{
	my $exit = $_[0][0];
	my $prog = basename($0) . ': ';
	foreach my $err (@_) {
		my ($e, $fmt, @args) = @$err;
		printf(STDERR $prog . $fmt . "\n", @args);
	}
	exit($exit);
}

#
# Main routine of script.
#
# Set the message locale.
#
setlocale(LC_ALL, '');
textdomain("solaris_cmd_proj_cmds");

# Process command options and do some initial command-line validity checking.
my $opt_f;

GetOptions("f=s" => \$opt_f) || usage();
usage(gettext('Invalid command-line arguments')) if (@ARGV != 1);
usage(gettext('No project name specified')) if (! defined($ARGV[0]));

my $pname = $ARGV[0];

my $projfile;
my $tmpprojf;

if (defined($opt_f)) {
	$projfile = $opt_f;
} else {
	$projfile = &PROJF_PATH;
}

$tmpprojf = $projfile . "tmp";
projf_lock();
unlink($tmpprojf);

my $pfh;

# Read the project file.  sysopen() is used so we can control the file mode.
if (! sysopen($pfh, $projfile, O_RDONLY)) {
	error([10, gettext('Cannot open %s: %s'), $projfile, $!]);
}
my ($mode, $uid, $gid) = (stat($pfh))[2,4,5];

my $flags = {};
$flags->{'validate'} = 'none';

my ($ret, $pf, $err) = projf_read($pfh, $flags);
if ($ret == 1) {
	error(@$err);
}
close($pfh);

# Search for the project & remove it.
my $del = 0;
my @newpf = grep { $_->{'name'} eq $pname ? $del++ && 0 : 1 } @$pf;
error([6, gettext('Project "%s" does not exist'), $pname])
    if ($del == 0);
error([6, gettext('Duplicate project name "%s"'), $pname])
    if ($del > 1);   # Should be impossible due to projf_validate() check.

# Write out the project file.
umask(0000);
sysopen($pfh, $tmpprojf, O_WRONLY | O_CREAT | O_EXCL, $mode) ||
    error([10, gettext('Cannot create %s: %s'), $tmpprojf, $!]);
projf_write($pfh, \@newpf);
close($pfh);
if (!chown($uid, $gid, $tmpprojf)) {
	unlink($tmpprojf);
	error([10, gettext('Cannot set ownership of %s: %s'),
	    $tmpprojf, $!]);
}
if (! rename($tmpprojf, $projfile)) {
	unlink($tmpprojf);
	error([10, gettext('cannot rename %s to %s: %s'),
	    $tmpprojf, $projfile, $!]);
}

projf_unlock();

exit(0);