delmmlist.in 2.82 KB
Newer Older
1
2
3
#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
4
# Copyright (c) 2005-2007 University of Utah and the Flux Group.
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
# All rights reserved.
#
use English;
use Getopt::Std;

#
# Delete a mailman list.
#
sub usage()
{
    print STDOUT "Usage: addmmlist [-a | -u] <listname>\n";
    exit(-1);
}
my $optlist = "dau";
my $debug   = 0;
my $listtype;
my $listname;
my $listowner;
my $listowner_email;
my $listpasswd;

#
# Configure variables
#
my $TB		= "@prefix@";
my $TBOPS       = "@TBOPSEMAIL@";
my $TBAUDIT	= "@TBAUDITEMAIL@";
my $CONTROL     = "@USERNODE@";
my $BOSSNODE	= "@BOSSNODE@";
my $OURDOMAIN   = "@OURDOMAIN@";
my $MAILMANSUPPORT= @MAILMANSUPPORT@;
my $SSH         = "$TB/bin/sshtb";
my $MMPROXY     = "$TB/sbin/mailmanproxy";

# Protos
sub fatal($);

#
# Untaint the path
# 
$ENV{'PATH'} = "/bin:/usr/bin";
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

#
# Turn off line buffering on output
#
$| = 1;

#
# Load the Testbed support stuff. 
#
use lib "@prefix@/lib";
use libdb;
use libtestbed;
59
use User;
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86

#
# We don't want to run this script unless its the real version.
#
if ($EUID != 0) {
    die("*** $0:\n".
	"    Must be setuid! Maybe its a development version?\n");
}

#
# This script is setuid, so please do not run it as root. Hard to track
# what has happened.
# 
if ($UID == 0) {
    die("*** $0:\n".
	"    Please do not run this as root! Its already setuid!\n");
}

#
# If no mailman support, just exit. 
#
if (! $MAILMANSUPPORT) {
    print "MailMan support is not enabled. Exit ...\n";
    exit(0);
}

#
87
# Verify user and get his DB uid and other info for later.
88
#
89
90
91
my $this_user = User->ThisUser();
if (! defined($this_user)) {
    tbdie("You ($UID) do not exist!");
92
}
93
my $user_uid   = $this_user->uid();
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145

#
# Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments.
#
%options = ();
if (! getopts($optlist, \%options)) {
    usage();
}
if (defined($options{"d"})) {
    $debug = 1;
}
if (defined($options{"a"})) {
    $listtype = "admin";
}
if (defined($options{"u"})) {
    $listtype = "user";
}
usage()
    if (@ARGV != 1);
usage()
    if (! (defined($options{"a"}) || defined($options{"u"})));
usage()
    if (defined($options{"a"}) && defined($options{"u"}));

$listname = $ARGV[0];

#
# Untaint args.
#
if ($listname =~ /^([-\w]+)$/) {
    $listname = $1;
}
else {
    die("Bad data in listname: $listname");
}

#
# For ssh.
#
$UID = $EUID;

if ($CONTROL ne $BOSSNODE) {
    my $optarg = ($debug ? "-d" : "");

    print "Deleting mailman list $listname ($listtype) on $CONTROL.\n";

    if (system("$SSH -host $CONTROL $MMPROXY dellist $listname")) {
	fatal("$MMPROXY failed on $CONTROL!");
    }
    
    SENDMAIL($TBAUDIT, "Mailman list deleted",
146
	     "Mailman list '$listname' has been deleted by '$user_uid'",
147
148
149
150
151
152
153
154
155
156
157
	     $TBOPS);
}
exit(0);

sub fatal($)
{
    my($mesg) = $_[0];

    die("*** $0:\n".
	"    $mesg\n");
}