Commit a64593f3 authored by Leigh Stoller's avatar Leigh Stoller

The bulk of the mailman support. Still not turned on by default (cause

Jay has "comments"), but I do not want it hanging around in my source
tree. Here is my mail message:

* The "My Mailing Lists" is context sensitive (copied from Tim's
  changes to the My Bug Databases). It takes you to the *archives* for
  the current project (or subgroup) list. Or it takes you to your
  first joined project.

* The showproject and showgroup pages have direct links to the project
  and group specific archives. If you are in reddot mode, you also
  get a link to the admin page for the list. Note that project and
  group leaders are just plain members of these lists.

* The interface to create a new "user" list is:

	https://www.emulab.net/dev/stoller/newmmlist.php3

  We do not store the password, but just fire it over in the list
  creation process.

  Anyone can create their own mailing lists. They are not associated
  with projects, but just the person creating the list. That person
  is the list administrator and is given permission to access the
  configuration page.

  This page is not hooked in yet; not sure where.

* Once you have your own lists, you user profile page includes a link
  in the sub menu: Show Mailman Lists. From this page you can delete
  lists, zap to the admin page, or change the admin password (which is
  really just a subpage of the admin page).

* As usual, in reddot mode you can mess with anyone else's mailman lists,
  (via the magic of mailman cookies).

* Note on cross machine login. The mailman stuff has a really easy way
  to generate the right kind of cookie to give users access. You can
  generate a cookie to give user access, or to the admin interface for
  a list (a different cookie). Behind the scenes, I ssh over and get
  the cookie, and set it in the user's browser from boss. When the
  browser is redirected over to ops, that cookie goes along and gives
  the user the requested access. No passwords need be sent around,
  since we do the authentication ourselves.
parent 9275c851
......@@ -26,7 +26,7 @@ include Makeconf
SUBDIRS = lib db assign www @optional_subdirs@ ipod security sensors \
pxe tbsetup account tmcd utils tip capture ipod vis \
sensors os xmlrpc install/newnode_sshkeys mote tools/whol \
wiki bugdb
wiki bugdb collab
all: all-subdirs
......@@ -62,6 +62,7 @@ endif
@$(MAKE) -C tools post-install
@$(MAKE) -C wiki post-install
@$(MAKE) -C bugdb post-install
@$(MAKE) -C collab/mailman post-install
@$(MAKE) -C utils post-install
#
......
#
# EMULAB-COPYRIGHT
# Copyright (c) 2005 University of Utah and the Flux Group.
# All rights reserved.
#
SRCDIR = @srcdir@
TESTBED_SRCDIR = @top_srcdir@
OBJDIR = ..
SUBDIR = collab
include $(OBJDIR)/Makeconf
SUBDIRS = mailman
all: all-subdirs
include $(TESTBED_SRCDIR)/GNUmakerules
control-install:
@$(MAKE) -C mailman control-install
install: install-subdirs
clean: clean-subdirs
boss-install: install
# How to recursively descend into subdirectories to make general
# targets such as `all'.
%.MAKE:
@$(MAKE) -C $(dir $@) $(basename $(notdir $@))
%-subdirs: $(addsuffix /%.MAKE,$(SUBDIRS)) ;
.PHONY: $(SUBDIRS)
......@@ -11,7 +11,9 @@ SUBDIR = collab/mailman
include $(OBJDIR)/Makeconf
SBIN_SCRIPTS = addmmlist setmmlistmembers mmsetup
SBIN_SCRIPTS = addmmlist delmmlist setmmlistmembers mmsetup \
setmmpasswd
LIBEXEC_SCRIPTS = webaddmmlist webdelmmlist websetmmpasswd mmxlogin
CTRL_LIBEXEC_SCRIPTS = genaliases
CTRL_LIB_FILES = mmscript.py
......@@ -22,11 +24,12 @@ CTRL_SBIN_SCRIPTS = mailmanproxy
# configure if the .in file is changed.
#
all: $(SBIN_SCRIPTS) $(CTRL_SBIN_SCRIPTS) $(CTRL_LIBEXEC_SCRIPTS) \
$(CTRL_LIB_FILES)
$(CTRL_LIB_FILES) $(LIBEXEC_SCRIPTS)
include $(TESTBED_SRCDIR)/GNUmakerules
install: $(addprefix $(INSTALL_SBINDIR)/, $(SBIN_SCRIPTS)) \
$(addprefix $(INSTALL_LIBEXECDIR)/, $(LIBEXEC_SCRIPTS)) \
$(addprefix $(INSTALL_DIR)/opsdir/libexec/mailman/, $(CTRL_LIBEXEC_SCRIPTS)) \
$(addprefix $(INSTALL_DIR)/opsdir/sbin/, $(CTRL_SBIN_SCRIPTS)) \
$(addprefix $(INSTALL_DIR)/opsdir/lib/mailman/, $(CTRL_LIB_FILES))
......@@ -36,8 +39,14 @@ boss-install: install
post-install:
chown root $(INSTALL_SBINDIR)/addmmlist
chmod u+s $(INSTALL_SBINDIR)/addmmlist
chown root $(INSTALL_SBINDIR)/delmmlist
chmod u+s $(INSTALL_SBINDIR)/delmmlist
chown root $(INSTALL_SBINDIR)/setmmlistmembers
chmod u+s $(INSTALL_SBINDIR)/setmmlistmembers
chown root $(INSTALL_SBINDIR)/setmmpasswd
chmod u+s $(INSTALL_SBINDIR)/setmmpasswd
chown root $(INSTALL_LIBEXECDIR)/mmxlogin
chmod u+s $(INSTALL_LIBEXECDIR)/mmxlogin
#
# Control node installation (okay, plastic)
......
......@@ -20,6 +20,7 @@ sub usage()
}
my $optlist = "dau";
my $debug = 0;
my $dbuid;
my $listtype;
my $listname;
my $listowner;
......@@ -31,6 +32,7 @@ my $listpasswd;
#
my $TB = "@prefix@";
my $TBOPS = "@TBOPSEMAIL@";
my $TBAUDIT = "@TBAUDITEMAIL@";
my $CONTROL = "@USERNODE@";
my $BOSSNODE = "@BOSSNODE@";
my $OURDOMAIN = "@OURDOMAIN@";
......@@ -85,11 +87,11 @@ if (! $MAILMANSUPPORT) {
}
#
# Only testbed admins.
# Get user DB uid.
#
if (!TBAdmin($UID)) {
if (! UNIX2DBUID($UID, \$dbuid)) {
die("*** $0:\n".
" Must be a testbed admin to run this script\n");
" You do not exist in the Emulab Database!\n");
}
#
......@@ -112,8 +114,6 @@ if (defined($options{"a"})) {
$listname = $ARGV[0];
}
if (defined($options{"u"})) {
my $listowner;
$listtype = "user";
usage()
......@@ -139,12 +139,11 @@ if (defined($options{"u"})) {
die("Bad data in listpasswd: $listpasswd");
}
}
usage()
if (! (defined($options{"a"}) || defined($options{"u"})));
usage()
if (defined($options{"a"}) && defined($options{"u"}));
#
# Untaint args.
#
......@@ -185,6 +184,18 @@ if ($CONTROL ne $BOSSNODE) {
"$SSH -host $CONTROL $MMPROXY addlist $listname $listtype")) {
fatal("$MMPROXY failed on $CONTROL!");
}
SENDMAIL($TBAUDIT, "Mailman list created",
"Mailman list '$listname' has been created by '$dbuid'",
$TBOPS);
#
# Generate an initial message to the list so that the archive is not
# empty.
#
SENDMAIL("${listname}\@${OURDOMAIN}", "Mailman list created",
"Mailman list '$listname' has been created by '$dbuid'",
$TBOPS);
}
exit(0);
......
#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
# Copyright (c) 2005 University of Utah and the Flux Group.
# 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 $dbuid;
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;
#
# 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);
}
#
# Get user DB uid.
#
if (! UNIX2DBUID($UID, \$dbuid)) {
die("*** $0:\n".
" You do not exist in the Emulab Database!\n");
}
#
# 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",
"Mailman list '$listname' has been deleted by '$dbuid'",
$TBOPS);
}
exit(0);
sub fatal($)
{
my($mesg) = $_[0];
die("*** $0:\n".
" $mesg\n");
}
......@@ -15,7 +15,9 @@ sub usage()
{
print "Usage: mailmanproxy addlist <listname> <listtype> or\n";
print " mailmanproxy setlistmembers <listname> or\n";
print " mailmanproxy modifymember <email>\n";
print " mailmanproxy modifymember <email> or\n";
print " mailmanproxy setadminpassword <listname>\n";
print " mailmanproxy dellist <listname>\n";
exit(-1);
}
my $optlist = "dn";
......@@ -111,9 +113,15 @@ if ($action eq "addlist") {
elsif ($action eq "setlistmembers") {
exit(SetListMembers(@ARGV));
}
elsif ($action eq "dellist") {
exit(DeleteList(@ARGV));
}
elsif ($action eq "modifymember") {
exit(ModifyMember(@ARGV));
}
elsif ($action eq "setadminpassword") {
exit(SetAdminPassword(@ARGV));
}
elsif ($action eq "xlogin") {
exit(xLogin(@ARGV));
}
......@@ -148,9 +156,15 @@ sub AddList(@)
fatal("AddList: Bad line in input: $_");
}
# Step 1: Create the list.
# Step 1: Create the list. For a "user" list, we want to mail out
# the welcome message to the list admin. But, the silly script wants
# a carriage return!
#
if (! -d "$MMLISTDIR/" . lc($name)) {
system("$MMBINDIR/newlist -q $name $owneremail $password") == 0 or
my $optarg = ($listtype eq "admin" ? "-q" : "");
system("echo '' | ".
"$MMBINDIR/newlist $optarg $name $owneremail $password") == 0 or
fatal("AddList: Could not create mailing list!");
}
......@@ -166,8 +180,8 @@ sub AddList(@)
#
print CONFIG "real_name = '$name'\n";
print CONFIG "owner = ['$owneremail']\n";
print CONFIG "description = 'Emulab Mail list: $name'\n";
print CONFIG "subject_prefix = '[Emulab Mail List: $name] '\n";
print CONFIG "description = 'Emulab Mailman List: $name'\n";
print CONFIG "subject_prefix = '[$name] '\n";
print CONFIG "reply_goes_to_list = 1\n";
print CONFIG "send_reminders = False\n";
print CONFIG "send_welcome_msg = False\n";
......@@ -204,9 +218,9 @@ sub AddList(@)
unlink($tempfile);
# Step 3: Regen the aliases. We use an external script for this.
# $EUID = $UID = 0;
# system("$GENALIASES") == 0 or
# fatal("AddList: Could not generate a new aliases file!");
$EUID = $UID = 0;
system("$GENALIASES") == 0 or
fatal("AddList: Could not generate a new aliases file!");
return 0;
}
......@@ -469,16 +483,91 @@ sub ModifyMember(@)
}
}
#
# Set admin password (and email) for a list. Data comes from STDIN
#
sub SetAdminPassword(@)
{
usage()
if (@_ != 1);
my ($listname) = @_;
my ($owneremail, $password) = ();
# Other info for list comes in from STDIN.
$_ = <STDIN>;
usage()
if (!defined($_));
if ($_ =~ /^(.*) (.*)$/) {
$owneremail = $1;
$password = $2;
}
else {
fatal("SetAdminPassword: Bad line in input: $_");
}
system("$MMBINDIR/withlist -l -q ".
"-r mmscript.setadmin $listname $owneremail $password") == 0
or fatal("SetAdminPassword: ".
"Could not modify admin password for $listname!");
return 0;
}
#
# Delete a list.
#
sub DeleteList(@)
{
usage()
if (@_ != 1);
my ($listname) = @_;
my $lcname = lc($listname);
#
# We want to back up the mbox file just in case. We can regen the
# archive from the mbox if needed later ... Use bin/arch command.
#
my $pubarchive = "$MAILMANDIR/archives/public/${lcname}.mbox";
my $privarchive = "$MAILMANDIR/archives/private/${lcname}.mbox";
my $extension = TBDateTimeFSSafe();
if (-e $pubarchive) {
system("/bin/mv $pubarchive ${pubarchive}.${extension}") == 0 or
fatal("DeleteList: Could not rename $pubarchive!");
}
if (-e $privarchive) {
system("/bin/mv $privarchive ${privarchive}.${extension}") == 0 or
fatal("DeleteList: Could not rename $privarchive!");
}
if (-d "$MMLISTDIR/$lcname") {
system("$MMBINDIR/rmlist -a $listname") == 0 or
fatal("DeleteList: Could not delete mailing list!");
}
return 0;
}
#
# Backdoor Login
#
sub xLogin(@)
{
usage()
if (@_ != 2);
if (@_ != 3);
my ($user, $secretkey) = @_;
my ($email, $cookietype, $listname) = @_;
#
# Generate a cookie and send it back.
#
system("$MMBINDIR/withlist -l -q ".
"-r mmscript.getcookie $listname $email $cookietype") == 0
or fatal("xlogin: ".
"Could not get xlogin cookie for $email/$listname!");
return 0;
}
......
from Mailman import mm_cfg
from Mailman import MailList
from Mailman import Utils
from Mailman import Message
from Mailman import Errors
from Mailman import UserDesc
import sha
def addmember(mlist, addr, name, passwd):
userdesc = UserDesc.UserDesc(address=addr, fullname=name, password=passwd)
......@@ -37,8 +39,31 @@ def modmember(mlist, addr, name, passwd):
pass
pass
def setadmin(mlist, addr, passwd):
try:
mlist.owner = [addr]
mlist.password = sha.new(passwd).hexdigest()
mlist.Save()
except:
print 'Error resetting name/password for list'
sys.exit(1);
pass
pass
def findmember(mlist, addr):
if mlist.isMember(addr):
print mlist.internal_name();
pass
pass
def getcookie(mlist, addr, cookietype):
# If we want the admin interface, we do not care if the addr is
# a member of the list.
if cookietype == "admin":
print mlist.MakeCookie(mm_cfg.AuthListAdmin, addr)
return
if mlist.isMember(addr):
print mlist.MakeCookie(mm_cfg.AuthUser, addr)
pass
pass
......@@ -107,10 +107,6 @@ my $optarg = ($debug ? "-d" : "");
#
system("$ADDMMLIST $optarg -a emulab-users") == 0
or fatal("Could not create emulab-users list");
system("$ADDMMLIST $optarg -a emulab-project-leaders") == 0
or fatal("Could not create emulab-project-leaders list");
system("$ADDMMLIST $optarg -a emulab-widearea-users") == 0
or fatal("Could not create emulab-widearea-users list");
#
# Add project (and group) lists.
......@@ -119,8 +115,8 @@ my @projects = ();
$query_result =
DBQueryFatal("select pid,gid from groups where 1 ".
"and (pid='testbed' or pid='emulab-ops' or pid='tbres' or ".
" pid='utahstud')" .
# "and (pid='testbed' or pid='emulab-ops' or pid='tbres' or ".
# " pid='utahstud')" .
"");
while (my ($pid,$gid) = $query_result->fetchrow_array()) {
......
#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
# Copyright (c) 2005 University of Utah and the Flux Group.
# All rights reserved.
#
use English;
use Getopt::Std;
#
# Cross machine login for a user, to a list. The type is one of "user"
# or "admin". The admin tag lets the user into the admin interface.
#
sub usage()
{
print STDOUT "Usage: mmxlogin <uid> <listname> <type>\n";
exit(-1);
}
my $optlist = "d";
my $debug = 0;
my $user_uid;
my $listname;
my $xtype;
#
# 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;
#
# 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);
}
#
# 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;
}
usage()
if (@ARGV != 3);
$user_uid = $ARGV[0];
$listname = $ARGV[1];
$xtype = $ARGV[2];
#
# Untaint args.
#
if ($user_uid =~ /^([-\w]+)$/) {
$user_uid = $1;
}
else {
die("Bad data in uid: $user_uid");
}
if ($listname =~ /^([-\w]+)$/) {
$listname = $1;
}
else {
die("Bad data in listname: $listname");
}
if ($xtype =~ /^([\w]+)$/) {
$xtype = $1;
}
else {
die("Bad data in xtype: $xtype");
}
my $email = "${user_uid}\@${OURDOMAIN}";
#
# For ssh.
#
$UID = $EUID;
if ($CONTROL ne $BOSSNODE) {
open(COOKIE, "$SSH -host $CONTROL $MMPROXY ".
"xlogin $email $xtype $listname |") or
fatal("$MMPROXY failed on $CONTROL!");
my $cookie = <COOKIE>;
close(COOKIE) or
fatal("$MMPROXY failed on $CONTROL!");
# Send back to PHP.
print $cookie;
}
exit(0);
sub fatal($)
{
my($mesg) = $_[0];
die("*** $0:\n".
" $mesg\n");
}
#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
# Copyright (c) 2005 University of Utah and the Flux Group.
# All rights reserved.
#
use English;
use Getopt::Std;
#
# Change the admin password for a list. Change the list owner email at
# the same time.
#
sub usage()
{
print STDOUT "Usage: setmmpasswd -u <listname> <uid> <password> or\n";
print STDOUT " setmmpasswd -a <listname>\n";
exit(-1);
}
my $optlist = "dau";
my $debug = 0;
my $dbuid;
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";