Move newmmlist page form logic to a backend Perl script.

     www/newmmlist.php3 - The reworked PHP page.
     backend/{newmmlist,GNUmakefile}.in configure configure.in - New backend script.
     sql/database-fill.sql - Add table_regex 'mailman_lists' checking patterns.

backend/GNUmakefile.in

@@ -12,8 +12,8 @@ UNIFIED         = @UNIFIED_BOSS_AND_OPS@
 
 include $(OBJDIR)/Makeconf
 
-BIN_SCRIPTS	= moduserinfo newgroup
-WEB_BIN_SCRIPTS = webmoduserinfo webnewgroup
+BIN_SCRIPTS	= moduserinfo newgroup newmmlist
+WEB_BIN_SCRIPTS = webmoduserinfo webnewgroup webnewmmlist
 WEB_SBIN_SCRIPTS= 
 LIBEXEC_SCRIPTS	= $(WEB_BIN_SCRIPTS) $(WEB_SBIN_SCRIPTS)
 

backend/newmmlist.in

+#!/usr/bin/perl -wT
+#
+# EMULAB-COPYRIGHT
+# Copyright (c) 2000-2007 University of Utah and the Flux Group.
+# All rights reserved.
+#
+use English;
+use strict;
+use Getopt::Std;
+use XML::Simple;
+use Data::Dumper;
+
+#
+# Back-end script to create a new Mailman list.
+#
+sub usage()
+{
+    print("Usage: newmmlist [-v] <xmlfile>\n");
+    exit(-1);
+}
+my $optlist = "dv";
+my $debug   = 0;
+my $verify  = 0;	# Check data and return status only. 
+
+#
+# Configure variables
+#
+my $TB		= "@prefix@";
+my $TBOPS       = "@TBOPSEMAIL@";
+my $TBAUDIT	= "@TBAUDITEMAIL@";
+
+#
+# Untaint the path
+#
+$ENV{'PATH'} = "$TB/bin:$TB/sbin:/bin:/usr/bin:/usr/bin:/usr/sbin";
+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;
+use User;
+use Project;
+# There is no MmList package now.
+
+# Protos
+sub fatal($);
+sub UserError(;$);
+sub escapeshellarg($);
+
+#
+# Parse command arguments. Once we return from getopts, all that should be
+# left are the required arguments.
+#
+my %options = ();
+if (! getopts($optlist, \%options)) {
+    usage();
+}
+if (defined($options{"d"})) {
+    $debug = 1;
+}
+if (defined($options{"v"})) {
+    $verify = 1;
+}
+if (@ARGV != 1) {
+    usage();
+}
+my $xmlfile  = shift(@ARGV);
+
+#
+# Map invoking user to object. 
+# If invoked as "nobody" we are coming from the web interface and the
+# current user context is "implied" (see tbauth.php3).
+#
+my $this_user;
+
+if (getpwuid($UID) ne "nobody") {
+    $this_user = User->ThisUser();
+
+    if (! defined($this_user)) {
+	fatal("You ($UID) do not exist!");
+    }
+    # You don't need admin privileges to create a new Mailman list.
+
+}
+else {
+    #
+    # Check the filename when invoked from the web interface; must be a
+    # file in /tmp.
+    #
+    if ($xmlfile =~ /^([-\w\.\/]+)$/) {
+	$xmlfile = $1;
+    }
+    else {
+	fatal("Bad data in pathname: $xmlfile");
+    }
+
+    # Use realpath to resolve any symlinks.
+    my $translated = `realpath $xmlfile`;
+    if ($translated =~ /^(\/tmp\/[-\w\.\/]+)$/) {
+	$xmlfile = $1;
+    }
+    else {
+	fatal("Bad data in translated pathname: $xmlfile");
+    }
+
+    # The web interface (and in the future the xmlrpc interface) sets this.
+    $this_user = User->ImpliedUser();
+
+    if (! defined($this_user)) {
+	fatal("Cannot determine implied user!");
+    }
+}
+
+#
+# These are the fields that we allow to come in from the XMLfile.
+#
+my $SLOT_OPTIONAL	= 0x1;	# The field is not required.
+my $SLOT_REQUIRED	= 0x2;  # The field is required and must be non-null.
+my $SLOT_ADMINONLY	= 0x4;  # Only admins can set this field.
+#
+# XXX We should encode all of this in the DB so that we can generate the
+# forms on the fly, as well as this checking code.
+#
+my %xmlfields =
+    # XML Field Name        DB slot name         Flags             Default
+    ("pid"		=> ["pid",		$SLOT_REQUIRED],
+     "password1"	=> ["password1",	$SLOT_REQUIRED],
+     "password2"	=> ["password2",	$SLOT_REQUIRED],
+     "listname"		=> ["listname",		$SLOT_REQUIRED],
+     "fullname"		=> ["fullname",		$SLOT_REQUIRED]);
+
+#
+# Must wrap the parser in eval since it exits on error.
+#
+my $xmlparse = eval { XMLin($xmlfile,
+			    VarAttr => 'name',
+			    ContentKey => '-content',
+			    SuppressEmpty => undef); };
+fatal($@)
+    if ($@);
+
+#
+# Process and dump the errors (formatted for the web interface).
+# We should probably XML format the errors instead but not sure I want
+# to go there yet.
+#
+my %errors = ();
+
+#
+# Make sure all the required arguments were provided.
+#
+foreach my $key (keys(%xmlfields)) {
+    my (undef, $required, undef) = @{$xmlfields{$key}};
+
+    $errors{$key} = "Required value not provided"
+	if ($required & $SLOT_REQUIRED  &&
+	    ! exists($xmlparse->{'attribute'}->{"$key"}));
+}
+UserError()
+    if (keys(%errors));
+
+#
+# We build up an array of arguments as we check
+# the attributes.
+#
+my %newmmlist_args = ();
+
+foreach my $key (keys(%{ $xmlparse->{'attribute'} })) {
+    my $value = $xmlparse->{'attribute'}->{"$key"}->{'value'};
+
+    if ($debug) {
+	print STDERR "User attribute: '$key' -> '$value'\n";
+    }
+
+    $errors{$key} = "Unknown attribute"
+	if (!exists($xmlfields{$key}));
+
+    my ($dbslot, $required, $default) = @{$xmlfields{$key}};
+
+    if ($required & $SLOT_REQUIRED) {
+	# A slot that must be provided, so do not allow a null value.
+	if (!defined($value)) {
+	    $errors{$key} = "Must provide a non-null value";
+	    next;
+	}
+    }
+    if ($required & $SLOT_OPTIONAL) {
+	# Optional slot. If value is null skip it. Might not be the correct
+	# thing to do all the time?
+	if (!defined($value)) {
+	    next
+		if (!defined($default));
+	    $value = $default;
+	}
+    }
+    if ($required & $SLOT_ADMINONLY) {
+	# Admin implies optional, but thats probably not correct approach.
+	$errors{$key} = "Administrators only"
+	    if (! $this_user->IsAdmin());
+    }
+	
+    # Now check that the value is legal.
+    if (! TBcheck_dbslot($value, "mailman_lists", $dbslot, TBDB_CHECKDBSLOT_ERROR)) {
+	$errors{$key} = TBFieldErrorString();
+	next;
+    }
+
+    $newmmlist_args{$dbslot} = $value;
+}
+UserError()
+    if (keys(%errors));
+
+#
+# Now do special checks.
+#
+my $project = Project->Lookup($newmmlist_args{"pid"});
+if (!defined($project)) {
+    UserError("Project: No such project");
+}
+if (!$project->AccessCheck($this_user, TB_PROJECT_READINFO())) {
+    UserError("Project: Not enough permission");
+}
+my $listname = $project->pid() . "-" . $newmmlist_args{"listname"};
+my $safename = escapeshellarg($listname);
+my $password = $newmmlist_args{"password1"};
+
+#
+# Need to lock the table for this. 
+# 
+DBQueryFatal("lock tables mailman_listnames write");
+
+my $query_result =
+    DBQueryFatal("select * from mailman_listnames ".
+		 "where listname='$safename'");
+if ($query_result->numrows) {
+    DBQueryFatal("unlock tables");
+    UserError("ListName: Name already in use; pick another");
+}
+
+exit(0)
+    if ($verify);
+
+#
+# Now safe to create a new Mailman list.
+#
+my $uid	 = $this_user->uid();
+my $dbid = $this_user->dbid();
+DBQueryFatal("insert into mailman_listnames ".
+	     " (listname, owner_uid, owner_idx, created) ".
+	     "values ('$safename', '$uid', '$dbid', now())");
+DBQueryFatal("unlock tables");
+
+#
+# Okay, call out to the backend to create the actual list. 
+#
+my $cmd = "addmmlist -u " . escapeshellarg($listname) . " $uid " .
+    escapeshellarg($password);
+##print $cmd . "\n";
+my $cmd_out = `$cmd`;
+my $retval = $?;
+
+# Failed? Remove the DB entry.
+if ($retval != 0) {
+    DBQueryFatal("delete from mailman_listnames ".
+		 "where listname='$safename'");
+}
+
+UserError("Error: " . $cmd_out)
+    if ($retval);
+
+# The web interface requires this line to be printed.
+print "MMLIST $listname has been created\n";
+exit(0);
+
+sub fatal($)
+{
+    my ($mesg) = @_;
+
+    print STDERR "*** $0:\n".
+	         "    $mesg\n";
+    # Exit with negative status so web interface treats it as system error.
+    exit(-1);
+}
+
+sub UserError(;$)
+{
+    my ($mesg) = @_;
+
+    if (keys(%errors)) {
+	foreach my $key (keys(%errors)) {
+	    my $val = $errors{$key};
+	    print "${key}: $val\n";
+	}
+    }
+    print "$mesg\n"
+	if (defined($mesg));
+
+    # Exit with positive status so web interface treats it as user error.
+    exit(1);
+}
+
+sub escapeshellarg($)
+{
+    my ($str) = @_;
+
+    $str =~ s/[^[:alnum:]]/\\$&/g;
+    return $str;
+}

configure

@@ -2428,6 +2428,7 @@ outfiles="$outfiles Makeconf GNUmakefile \
 	account/addpubkey account/addsfskey account/genpubkeys \
 	account/quotamail account/mkusercert account/newproj account/newuser \
 	backend/GNUmakefile backend/moduserinfo backend/newgroup \
+	backend/newmmlist \
 	tbsetup/GNUmakefile tbsetup/console_setup tbsetup/spewlogfile \
 	tbsetup/spewrpmtar tbsetup/gentopofile tbsetup/power_sgmote.pm \
 	tbsetup/console_reset tbsetup/bwconfig tbsetup/power_rpc27.pm \

configure.in

@@ -808,6 +808,7 @@ outfiles="$outfiles Makeconf GNUmakefile \
 	account/addpubkey account/addsfskey account/genpubkeys \
 	account/quotamail account/mkusercert account/newproj account/newuser \
 	backend/GNUmakefile backend/moduserinfo backend/newgroup \
+	backend/newmmlist \
 	tbsetup/GNUmakefile tbsetup/console_setup tbsetup/spewlogfile \
 	tbsetup/spewrpmtar tbsetup/gentopofile tbsetup/power_sgmote.pm \
 	tbsetup/console_reset tbsetup/bwconfig tbsetup/power_rpc27.pm \

sql/database-fill.sql

@@ -810,7 +810,15 @@ REPLACE INTO table_regex VALUES ('virt_firewalls','eid','text','redirect','exper
 REPLACE INTO table_regex VALUES ('virt_firewalls','fwname','text','redirect','virt_nodes:vname',0,0,NULL);
 REPLACE INTO table_regex VALUES ('virt_firewalls','type','text','regex','^(ipfw|ipfw2|ipchains|ipfw2-vlan)$',0,0,NULL);
 REPLACE INTO table_regex VALUES ('virt_firewalls','style','text','regex','^(open|closed|basic|emulab)$',0,0,NULL);
+
+REPLACE INTO table_regex VALUES ('mailman_lists','pid','text','redirect','projects:pid',0,0,NULL);
+REPLACE INTO table_regex VALUES ('mailman_lists','password1','text','redirect','default:tinytext',0,0,NULL);
+REPLACE INTO table_regex VALUES ('mailman_lists','password2','text','redirect','default:tinytext',0,0,NULL);
+REPLACE INTO table_regex VALUES ('mailman_lists','fullname','text','redirect','users:usr_email',0,0,NULL);
+REPLACE INTO table_regex VALUES ('mailman_lists','listname','text','redirect','mailman_listnames:listname',0,0,NULL);
+
 REPLACE INTO table_regex VALUES ('mailman_listnames','listname','text','regex','^[-\\w\\.\\+]+$',3,64,NULL);
+
 REPLACE INTO table_regex VALUES ('default','fulltext','text','regex','^[\\040-\\176\\012\\015\\011]*$',0,20000,NULL);
 REPLACE INTO table_regex VALUES ('node_attributes','attrkey','text','regex','^[-\\w]+$',1,32,NULL);
 REPLACE INTO table_regex VALUES ('node_attributes','attrvalue','text','regex','^[-\\w\\.+,\\s]+$',0,255,NULL);

www/newmmlist.php3

@@ -324,48 +324,106 @@ if (count($errors)) {
     return;
 }
 
-$listname = $project->pid() . "-" . $formfields["listname"];
-$safename = addslashes($listname);
-$password = $formfields["password1"];
-
 #
-# Need to lock the table for this. 
-# 
-DBQueryFatal("lock tables mailman_listnames write");
-
-$query_result =
-    DBQueryFatal("select * from mailman_listnames ".
-		 "where listname='$safename'");
-if (mysql_num_rows($query_result)) {
-    DBQueryFatal("unlock tables");
-    $errors["List Name"] = "Name already in use; pick another";
+# Build up argument array to pass along.
+#
+$args = array();
+
+if (isset($formfields["pid"]) &&
+    $formfields["pid"] != "none" && $formfields["pid"] != "") {
+    $args["pid"]		= $formfields["pid"];
+}
+if (isset($formfields["password1"]) && $formfields["password1"] != "") {
+    $args["password1"]	= $formfields["password1"];
+}
+if (isset($formfields["password2"]) && $formfields["password2"] != "") {
+    $args["password2"]	= $formfields["password2"];
+}
+if (isset($formfields["listname"]) && $formfields["listname"] != "") {
+    $args["listname"]	= $formfields["listname"];
+}
+if (isset($formfields["fullname"]) && $formfields["fullname"] != "") {
+    $args["fullname"]	= $formfields["fullname"];
+}
+
+if (! ($result = NewMmList($uid, $args, $errors))) {
+    # Always respit the form so that the form fields are not lost.
+    # I just hate it when that happens so lets not be guilty of it ourselves.
     SPITFORM($formfields, $errors);
     PAGEFOOTER();
     return;
 }
 
-DBQueryFatal("insert into mailman_listnames ".
-	     " (listname, owner_uid, owner_idx, created) ".
-	     "values ('$safename', '$uid', '$dbid', now())");
-DBQueryFatal("unlock tables");
-
 #
-# Okay, call out to the backend to create the actual list. 
+# Okay, redirect the user over to the listadmin page to finish configuring.
 #
-$retval = SUEXEC($uid, $TBADMINGROUP,
-		 "webaddmmlist -u " . escapeshellarg($listname) . " $uid " .
-		           escapeshellarg($password),
-		 SUEXEC_ACTION_IGNORE);
-
-# Failed? Remove the DB entry.
-if ($retval != 0) {
-    DBQueryFatal("delete from mailman_listnames ".
-		 "where listname='$safename'");
-    SUEXECERROR(SUEXEC_ACTION_DIE);
-}
+header("Location: ${MAILMANURL}/admin/${listname}/?adminpw=${formfields["password1"]}");
 
 #
-# Okay, redirect the user over to the listadmin page to finish configuring.
+# When there's an MmList class, this will be a Class function to make a new one...
 #
-header("Location: ${MAILMANURL}/admin/${listname}/?adminpw=${password}");
+function NewMmList($uid, $args, &$errors) {
+    global $suexec_output, $suexec_output_array, $TBADMINGROUP;
+
+    #
+    # Generate a temporary file and write in the XML goo.
+    #
+    $xmlname = tempnam("/tmp", "newmmlist");
+    if (! $xmlname) {
+	TBERROR("Could not create temporary filename", 0);
+	$errors[] = "Transient error; please try again later.";
+	return null;
+    }
+    if (! ($fp = fopen($xmlname, "w"))) {
+	TBERROR("Could not open temp file $xmlname", 0);
+	$errors[] = "Transient error; please try again later.";
+	return null;
+    }
+
+    fwrite($fp, "<MmList>\n");
+    foreach ($args as $name => $value) {
+	fwrite($fp, "<attribute name=\"$name\">");
+	fwrite($fp, "  <value>" . htmlspecialchars($value) . "</value>");
+	fwrite($fp, "</attribute>\n");
+    }
+    fwrite($fp, "</MmList>\n");
+    fclose($fp);
+    chmod($xmlname, 0666);
+
+    $retval = SUEXEC($uid, $TBADMINGROUP, "webnewmmlist $xmlname",
+		     SUEXEC_ACTION_IGNORE);
+
+    if ($retval) {
+	if ($retval < 0) {
+	    $errors[] = "Transient error; please try again later.";
+	    SUEXECERROR(SUEXEC_ACTION_CONTINUE);
+	}
+	else {
+	    # unlink($xmlname);
+	    if (count($suexec_output_array)) {
+		for ($i = 0; $i < count($suexec_output_array); $i++) {
+		    $line = $suexec_output_array[$i];
+		    if (preg_match("/^([-\w]+):\s*(.*)$/",
+				   $line, $matches)) {
+			$errors[$matches[1]] = $matches[2];
+		    }
+		    else
+			$errors[] = $line;
+		}
+	    }
+	    else
+		$errors[] = "Transient error; please try again later.";
+	}
+	return null;
+    }
+
+    # There are no return value(s) to parse at the end of the output.
+
+    # Unlink this here, so that the file is left behind in case of error.
+    # We can then create the MmList by hand from the xmlfile, if desired.
+    unlink($xmlname);
+
+    return true; 
+}
+
 ?>