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