1#!/usr/perl5/bin/perl -w
2#
3# CDDL HEADER START
4#
5# The contents of this file are subject to the terms of the
6# Common Development and Distribution License, Version 1.0 only
7# (the "License").  You may not use this file except in compliance
8# with the License.
9#
10# You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
11# or http://www.opensolaris.org/os/licensing.
12# See the License for the specific language governing permissions
13# and limitations under the License.
14#
15# When distributing Covered Code, include this CDDL HEADER in each
16# file and include the License file at usr/src/OPENSOLARIS.LICENSE.
17# If applicable, add the following below this CDDL HEADER, with the
18# fields enclosed by brackets "[]" replaced with your own identifying
19# information: Portions Copyright [yyyy] [name of copyright owner]
20#
21# CDDL HEADER END
22#
23#
24# Copyright 2004 Sun Microsystems, Inc.  All rights reserved.
25# Use is subject to license terms.
26#
27#ident	"%Z%%M%	%I%	%E% SMI"
28#
29
30require 5.005;
31use strict;
32use locale;
33use Errno;
34use Fcntl;
35use File::Basename;
36use Getopt::Long qw(:config no_ignore_case bundling);
37use POSIX qw(locale_h);
38use Sun::Solaris::Utils qw(textdomain gettext);
39use Sun::Solaris::Project qw(:ALL :PRIVATE);
40
41#
42# Print a usage message and exit.
43#
44sub usage
45{
46	my (@msg) = @_;
47	my $prog = basename($0);
48	print(STDERR "$prog: @msg\n") if (@msg);
49	printf(STDERR gettext("Usage: %s [-f filename] project\n"), $prog);
50	exit(2);
51}
52
53#
54# Print a list of error messages and exit.
55#
56sub error
57{
58	my $exit = $_[0][0];
59	my $prog = basename($0) . ': ';
60	foreach my $err (@_) {
61		my ($e, $fmt, @args) = @$err;
62		printf(STDERR $prog . $fmt . "\n", @args);
63	}
64	exit($exit);
65}
66
67#
68# Main routine of script.
69#
70# Set the message locale.
71#
72setlocale(LC_ALL, '');
73textdomain(TEXT_DOMAIN);
74
75# Process command options and do some initial command-line validity checking.
76my $opt_f;
77
78GetOptions("f=s" => \$opt_f) || usage();
79usage(gettext('Invalid command-line arguments')) if (@ARGV != 1);
80usage(gettext('No project name specified')) if (! defined($ARGV[0]));
81
82my $pname = $ARGV[0];
83
84my $projfile;
85my $tmpprojf;
86
87if (defined($opt_f)) {
88	$projfile = $opt_f;
89} else {
90	$projfile = &PROJF_PATH;
91}
92
93# Fabricate an unique temporary filename.
94$tmpprojf = $projfile . ".tmp.$$";
95
96my $pfh;
97
98# Read the project file.  sysopen() is used so we can control the file mode.
99if (! sysopen($pfh, $projfile, O_RDONLY)) {
100	error([10, gettext('Cannot open %s: %s'), $projfile, $!]);
101}
102my ($mode, $uid, $gid) = (stat($pfh))[2,4,5];
103
104my $flags = {};
105$flags->{'validate'} = 'false';
106$flags->{'res'} = 'true';
107$flags->{'dup'} = 'true';
108
109my ($ret, $pf) = projf_read($pfh, $flags);
110if ($ret != 0) {
111	error(@$pf);
112}
113close($pfh);
114
115# Search for the project & remove it.
116my $del = 0;
117my @newpf = grep { $_->{'name'} eq $pname ? $del++ && 0 : 1 } @$pf;
118error([6, gettext('Project "%s" does not exist'), $pname])
119    if ($del == 0);
120error([6, gettext('Duplicate project name "%s"'), $pname])
121    if ($del > 1);   # Should be impossible due to projf_validate() check.
122
123# Write out the project file.
124umask(0000);
125sysopen($pfh, $tmpprojf, O_WRONLY | O_CREAT | O_EXCL, $mode) ||
126    error([10, gettext('Cannot create %s: %s'), $tmpprojf, $!]);
127projf_write($pfh, \@newpf);
128close($pfh);
129if (!chown($uid, $gid, $tmpprojf)) {
130	unlink($tmpprojf);
131	error([10, gettext('Cannot set ownership of %s: %s'),
132	    $tmpprojf, $!]);
133}
134if (! rename($tmpprojf, $projfile)) {
135	unlink($tmpprojf);
136	error([10, gettext('cannot rename %s to %s: %s'),
137	    $tmpprojf, $projfile, $!]);
138}
139exit(0);
140