usr/src/cmd/projadd/projdel.pl

   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
  30 require 5.005;
  31 use strict;
  32 use locale;
  33 use Errno;
  34 use Fcntl;
  35 use File::Basename;
  36 use Getopt::Long qw(:config no_ignore_case bundling);
  37 use POSIX qw(locale_h);
  38 use Sun::Solaris::Utils qw(textdomain gettext);
  39 use Sun::Solaris::Project qw(:ALL :PRIVATE);
  40
  41 #
  42 # Print a usage message and exit.
  43 #
  44 sub 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 #
  56 sub 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 #
  72 setlocale(LC_ALL, '');
  73 textdomain(TEXT_DOMAIN);
  74
  75 # Process command options and do some initial command-line validity checking.
  76 my $opt_f;
  77
  78 GetOptions("f=s" => \$opt_f) || usage();
  79 usage(gettext('Invalid command-line arguments')) if (@ARGV != 1);
  80 usage(gettext('No project name specified')) if (! defined($ARGV[0]));
  81
  82 my $pname = $ARGV[0];
  83
  84 my $projfile;
  85 my $tmpprojf;
  86
  87 if (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
  96 my $pfh;
  97
  98 # Read the project file.  sysopen() is used so we can control the file mode.
  99 if (! sysopen($pfh, $projfile, O_RDONLY)) {
 100         error([10, gettext('Cannot open %s: %s'), $projfile, $!]);
 101 }
 102 my ($mode, $uid, $gid) = (stat($pfh))[2,4,5];
 103
 104 my $flags = {};
 105 $flags->{'validate'} = 'false';
 106 $flags->{'res'} = 'true';
 107 $flags->{'dup'} = 'true';
 108
 109 my ($ret, $pf) = projf_read($pfh, $flags);
 110 if ($ret != 0) {
 111         error(@$pf);
 112 }
 113 close($pfh);
 114
 115 # Search for the project & remove it.
 116 my $del = 0;
 117 my @newpf = grep { $_->{'name'} eq $pname ? $del++ && 0 : 1 } @$pf;
 118 error([6, gettext('Project "%s" does not exist'), $pname])
 119     if ($del == 0);
 120 error([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.
 124 umask(0000);
 125 sysopen($pfh, $tmpprojf, O_WRONLY | O_CREAT | O_EXCL, $mode) ||
 126     error([10, gettext('Cannot create %s: %s'), $tmpprojf, $!]);
 127 projf_write($pfh, \@newpf);
 128 close($pfh);
 129 if (!chown($uid, $gid, $tmpprojf)) {
 130         unlink($tmpprojf);
 131         error([10, gettext('Cannot set ownership of %s: %s'),
 132             $tmpprojf, $!]);
 133 }
 134 if (! rename($tmpprojf, $projfile)) {
 135         unlink($tmpprojf);
 136         error([10, gettext('cannot rename %s to %s: %s'),
 137             $tmpprojf, $projfile, $!]);
 138 }
 139 exit(0);