All new accounts created on Gitlab now require administrator approval. If you invite any collaborators, please let Flux staff know so they can approve the accounts.

Commit 8965aad8 authored by Russ Fish's avatar Russ Fish

Move moduserinfo page form logic to a backend Perl script and methods.

 GNUmakefile.in configure configure.in  - Add the testbed/backend directory.
 www/moduserinfo.php3 - The reworked PHP page.
 www/user_defs.php - Add a ModUserInfo method bridging to the script via XML,
     and remove the ChangeProfile method that is being replaced.
 backend/{moduserinfo,GNUmakefile}.in - Add the Perl script.
 db/User.pm.in - Add a ModUserInfo worker class method for script arg checking.
     Also SetUserInterface, SetWindowsPassword, and AccessCheck methods,
     and a copy of the escapeshellarg fn.
 sql/database-fill.sql - Add some to the table_regex 'users' checking patterns.

Support stuff:
 account/tbacct.in - Update the UpdateWindowsPassword() function.
 db/libdb.pm.in - Add TBDB_USER_INTERFACE_EMULAB and TBDB_USER_INTERFACE_PLAB().
 tbsetup/libtestbed.pm.in - Add TB*EMAIL, TBMAIL_* vars (OPS, WWW, AUDIT).
parent 52d174df
......@@ -25,11 +25,11 @@ include Makeconf
# @optional_subdirs@ (has event)
# ipod os security sensors
# Then things that only depend on stuff we've done:
# pxe tbsetup tmcd utils www tip capture vis
# pxe tbsetup tmcd utils backend www tip capture vis
# Then things that depend on stuff we just did:
#
SUBDIRS = lib db assign www @optional_subdirs@ ipod security sensors \
pxe tbsetup account tmcd utils tip capture ipod vis \
pxe tbsetup account tmcd utils backend tip capture ipod vis \
sensors os xmlrpc install/newnode_sshkeys mote tools/whol \
tools/svn wiki bugdb collab tools/rmanage
......
......@@ -646,28 +646,55 @@ sub UpdatePassword()
#
sub UpdateWindowsPassword()
{
# shell escape.
$wpswd =~ s/\$/\\\$/g;
#
# Check status. Ignore if user is not active.
# New password (encrypted) comes in on the command line.
#
if ($status ne USERSTATUS_ACTIVE) {
print("$user is not active! Not updating the password!\n");
usage()
if (! @ARGV);
my $new_wpswd = shift(@ARGV);
# Lets not do this if no changes.
if ($new_wpswd eq $target_user->w_pswd()) {
print "Password has not changed ...\n";
return 0;
}
$UID = 0;
print "Updating user $user Samba password on $SAMBANODE.\n";
# -s = silent, -a = add user if necessary.
open( SPCMD, "| $SSH -host $SAMBANODE $SMBPASSWD -s -a $user")
|| fatal("Opening $SMBPASSWD pipe, user $user on $SAMBANODE: $! $?");
local $SIG{PIPE} = sub { die "smbpasswd spooler pipe broke" };
print SPCMD "$wpswd\n$wpswd\n";
close SPCMD
|| fatal("Closing $SMBPASSWD pipe, user $user on $SAMBANODE: $! $?");
#
# Insert into database.
#
if ($target_user->SetWindowsPassword($new_wpswd)) {
fatal("Could not update Windows password string for $target_user");
}
$UID = $SAVEUID;
# Go no further if a webonly user.
return 0
if ($webonly);
#
# Go no further if user is not active or frozen.
#
return 0
if (! ($status eq USERSTATUS_ACTIVE || $status eq USERSTATUS_FROZEN));
#
# Change on ops for Samba only if there is a real account there.
#
if (! $wikionly) {
# shell escape.
$new_wpswd =~ s/\$/\\\$/g;
$UID = 0;
print "Updating user $user Samba password on $SAMBANODE.\n";
# -s = silent, -a = add user if necessary.
open( SPCMD, "| $SSH -host $SAMBANODE $SMBPASSWD -s -a $user")
|| fatal("Opening $SMBPASSWD pipe, user $user on $SAMBANODE: $! $?");
local $SIG{PIPE} = sub { die "smbpasswd spooler pipe broke" };
print SPCMD "$new_wpswd\n$new_wpswd\n";
close SPCMD
|| fatal("Closing $SMBPASSWD pipe, user $user on $SAMBANODE: $! $?");
$UID = $SAVEUID;
}
return 0;
}
......
#
# EMULAB-COPYRIGHT
# Copyright (c) 2000-2007 University of Utah and the Flux Group.
# All rights reserved.
#
SRCDIR = @srcdir@
TESTBED_SRCDIR = @top_srcdir@
OBJDIR = ..
SUBDIR = backend
UNIFIED = @UNIFIED_BOSS_AND_OPS@
include $(OBJDIR)/Makeconf
BIN_SCRIPTS = moduserinfo
WEB_BIN_SCRIPTS = webmoduserinfo
WEB_SBIN_SCRIPTS=
LIBEXEC_SCRIPTS = $(WEB_BIN_SCRIPTS) $(WEB_SBIN_SCRIPTS)
#
# Force dependencies on the scripts so that they will be rerun through
# configure if the .in file is changed.
#
all: $(BIN_SCRIPTS) $(LIBEXEC_SCRIPTS)
include $(TESTBED_SRCDIR)/GNUmakerules
install: $(addprefix $(INSTALL_BINDIR)/, $(BIN_SCRIPTS)) \
$(addprefix $(INSTALL_LIBEXECDIR)/, $(LIBEXEC_SCRIPTS))
@echo "Don't forget to do a post-install as root"
boss-install: install
post-install:
#
# Control node installation (okay, plastic)
#
control-install:
# This rule says what web* script depends on which installed binary directory.
$(WEB_SBIN_SCRIPTS): $(INSTALL_SBINDIR)
$(WEB_BIN_SCRIPTS): $(INSTALL_BINDIR)
# Just in case the dirs are not yet created,
$(INSTALL_SBINDIR) $(INSTALL_BINDIR):
# And then how to turn the template into the actual script.
$(WEB_SBIN_SCRIPTS) $(WEB_BIN_SCRIPTS): $(TESTBED_SRCDIR)/WEBtemplate.in
@echo "Generating $@"
cat $< | sed -e 's,@PROGTOINVOKE@,$(word 2,$^)/$(subst web,,$@),' > $@
clean:
#!/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;
#
# Change the user profile from a XML description.
#
sub usage()
{
print("Usage: moduserinfo [-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@";
my $checkpass = "$TB/libexec/checkpass";
#
# 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;
# Protos
sub fatal($);
sub UserError(;$);
sub CheckPassword($$$$$);
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 manage your own profile.
}
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
("uid" => ["uid", $SLOT_REQUIRED],
# The rest are optional, so we can skip passing ones that are not changing.
"usr_name" => ["usr_name", $SLOT_OPTIONAL],
"usr_title" => ["usr_title", $SLOT_OPTIONAL],
"usr_affil" => ["usr_affil", $SLOT_OPTIONAL],
"usr_shell" => ["usr_shell", $SLOT_OPTIONAL],
"usr_URL" => ["usr_URL", $SLOT_OPTIONAL],
"usr_email" => ["usr_email", $SLOT_OPTIONAL],
"usr_addr" => ["usr_addr", $SLOT_OPTIONAL],
"usr_addr2" => ["usr_addr2", $SLOT_OPTIONAL],
"usr_city" => ["usr_city", $SLOT_OPTIONAL],
"usr_state" => ["usr_state", $SLOT_OPTIONAL],
"usr_zip" => ["usr_zip", $SLOT_OPTIONAL],
"usr_country" => ["usr_country", $SLOT_OPTIONAL],
"usr_phone" => ["usr_phone", $SLOT_OPTIONAL],
"password1" => ["password1", $SLOT_OPTIONAL],
"password2" => ["password2", $SLOT_OPTIONAL],
"w_password1" => ["w_password1", $SLOT_OPTIONAL],
"w_password2" => ["w_password2", $SLOT_OPTIONAL],
"user_interface" => ["user_interface", $SLOT_OPTIONAL],
"notes" => ["notes", $SLOT_OPTIONAL]);
#
# 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 to pass to User->ModUserInfo() as we check
# the attributes.
#
my %moduserinfo_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, "users", $dbslot, TBDB_CHECKDBSLOT_ERROR)) {
$errors{$key} = TBFieldErrorString();
next;
}
$moduserinfo_args{$dbslot} = $value;
}
UserError()
if (keys(%errors));
#
# Now do special checks.
#
my $target_uid = $moduserinfo_args{"uid"};
my $target_user = User->Lookup($target_uid);
if (!defined($target_user)) {
UserError("uid: No such user name");
}
if (!$target_user->AccessCheck($this_user, TB_USERINFO_MODIFYINFO())) {
UserError("UserInfo: Not enough permission");
}
my $target_name = $target_user->name();
my $target_email = $target_user->email();
# Make sure the user name has at least two tokens!
if ($moduserinfo_args{"usr_name"} &&
$moduserinfo_args{"usr_name"} !~ /\S\s+\S/) {
UserError("FullName: Please provide a first and last name");
}
if ($moduserinfo_args{"URL"} ) {
if ($moduserinfo_args{"URL"} !~ /^http:\/\//) {
UserError("URL: malformed - Must begin with http://");
}
if ($moduserinfo_args{"URL"} !~ /\s/) {
UserError("URL: malformed - Spaces are not allowed.");
}
}
if ($moduserinfo_args{"usr_email"}) {
my $temp_user = User->LookupByEmail($moduserinfo_args{"usr_email"});
if ($temp_user && !$target_user->SameUser($temp_user)) {
UserError("EmailAddress: Already in use by another user!");
}
}
my $pwd1 = $moduserinfo_args{"password1"};
my $pwd2 = $moduserinfo_args{"password2"};
if (($pwd1 && $pwd1 ne "") xor ($pwd2 && $pwd2 ne "")) {
UserError("Password: must confirm");
}
if ($pwd1 && $pwd2) {
if ($pwd1 ne $pwd2) {
UserError("Password: Two passwords do not match");
}
if ($pwd2) {
CheckPassword("", $target_uid, $pwd2,
$target_name, $target_email);
}
}
# We often get the previous Windows password without a confirmation,
# because it is shown in the form input field.
my $wpwd1 = $moduserinfo_args{"w_password1"};
my $wpwd2 = $moduserinfo_args{"w_password2"};
if ($wpwd1 && $wpwd2) {
if ($wpwd2 ne "" && $wpwd1 ne $wpwd2) {
UserError("WindowsPassword: Two passwords do not match");
}
if ($wpwd2) {
CheckPassword("Windows", $target_uid, $wpwd2,
$target_name, $target_email);
}
}
my $ui = $moduserinfo_args{"user_interface"};
if ($ui && $ui ne TBDB_USER_INTERFACE_EMULAB &&
$ui ne TBDB_USER_INTERFACE_PLAB) {
UserError("UserInterface: Invalid");
}
exit(0)
if ($verify);
#
# Now safe to make the changes.
#
my $usrerr;
my $mod_val = User->ModUserInfo($this_user, $target_user,
\%moduserinfo_args, \$usrerr);
UserError($usrerr)
if (defined($usrerr));
fatal("Could not modify user profile!")
if (!defined($mod_val));
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 CheckPassword($$$$$)
{
my ($prefix, $uid, $password, $name, $email) = @_;
my $checkpass_args = escapeshellarg($password)
. " " . $uid . " " . escapeshellarg($name . ":" . $email);
my $pwokay = `$checkpass $checkpass_args`;
if ($?) {
chomp($pwokay);
if (! ($pwokay =~ /^ok$/)) {
UserError("$prefix$pwokay");
}
fatal("Checkpass failed with $?");
}
}
sub escapeshellarg($)
{
my ($str) = @_;
$str =~ s/[^[:alnum:]]/\\$&/g;
return $str;
}
......@@ -2427,6 +2427,7 @@ outfiles="$outfiles Makeconf GNUmakefile \
account/GNUmakefile account/tbacct \
account/addpubkey account/addsfskey account/genpubkeys \
account/quotamail account/mkusercert account/newproj account/newuser \
backend/GNUmakefile backend/moduserinfo \
tbsetup/GNUmakefile tbsetup/console_setup tbsetup/spewlogfile \
tbsetup/spewrpmtar tbsetup/gentopofile tbsetup/power_sgmote.pm \
tbsetup/console_reset tbsetup/bwconfig tbsetup/power_rpc27.pm \
......
......@@ -807,6 +807,7 @@ outfiles="$outfiles Makeconf GNUmakefile \
account/GNUmakefile account/tbacct \
account/addpubkey account/addsfskey account/genpubkeys \
account/quotamail account/mkusercert account/newproj account/newuser \
backend/GNUmakefile backend/moduserinfo \
tbsetup/GNUmakefile tbsetup/console_setup tbsetup/spewlogfile \
tbsetup/spewrpmtar tbsetup/gentopofile tbsetup/power_sgmote.pm \
tbsetup/console_reset tbsetup/bwconfig tbsetup/power_rpc27.pm \
......
......@@ -43,6 +43,7 @@ my $CONTROL = "@USERNODE@";
my $OURDOMAIN = "@OURDOMAIN@";
my $MIN_UNIX_UID = @MIN_UNIX_UID@;
my $MIN_UNIX_GID = @MIN_UNIX_GID@;
my $tbacct = "$TB/sbin/tbacct";
# Create() flags.
$NEWUSER_FLAGS_PROJLEADER = 0x01;
......@@ -67,6 +68,10 @@ $USERSTATUS_ARCHIVED = "archived";
$USERSTATUS_UNAPPROVED $USERSTATUS_UNVERIFIED
$USERSTATUS_NEWUSER $USERSTATUS_ARCHIVED);
# Protos
sub SetUserInterface($$);
sub escapeshellarg($);
# Cache of instances to avoid regenerating them.
my %users = ();
my $debug = 0;
......@@ -255,8 +260,8 @@ sub LookupByWikiName($$)
}
#
# Lookup user given a wikiname. This is just to make sure the wikiname
# the user picked is unique.
# Lookup user given an e-mail address. This is just to make sure the
# e-mail address the user picked is unique.
#
sub LookupByEmail($$)
{
......@@ -354,7 +359,7 @@ sub Create($$$$)
}
# Must be exact root
next
if ($name != $token);
if ($name ne $token);
# Backwards compatability; might not have appended number.
if (isset($number) && intval($number) > $max) {
......@@ -621,6 +626,212 @@ sub IsAdmin($)
return $self->admin();
}
#
# Worker class method to change the user profile.
# Assumes most argument checking was done elsewhere.
#
sub ModUserInfo($$$$)
{
my ($class, $this_user, $target_user, $argref, $usrerr_ref) = @_;
my $this_uid = $this_user->uid();
my $isadmin = $this_user->IsAdmin();
my $target_uid = $target_user->uid();
my $target_uid_idx = $target_user->uid_idx();
my $target_name = $target_user->name();
my $target_email = $target_user->email();
my $wikionly = $target_user->wikionly();
my %mods;
my $noreport;
#
# Only admin types can change the email address. If its different, the
# user circumvented the form, and so its okay to blast it.
#
my $usr_email = $argref->{"usr_email"};
if ($usr_email && $target_email ne $usr_email) {
if (!$isadmin) {
$$usrerr_ref = "Email: ".
"You are not allowed to change your email address";
return undef;
}
#
# Invoke the backend to deal with this.
#
my $cmd = "$tbacct email $target_uid " .
escapeshellarg($usr_email);
##print $cmd;
my $cmd_out = `$cmd`;
if ($?) {
chomp($cmd_out);
$$usrerr_ref = "Error: " . $cmd_out;
return undef;
}
$mods{"usr_email"} = $usr_email;
}
#
# Now see if the user is requesting to change the password.
#
if (($argref->{"password1"} && $argref->{"password1"} ne "") &&
($argref->{"password2"} && $argref->{"password2"} ne "")) {
my $old_encoding = $target_user->pswd();
my $new_encoding = crypt($argref->{"password1"}, $old_encoding);
#
# Compare. Must change it!
#
if ($old_encoding eq $new_encoding) {
$$usrerr_ref = "Error: " .
"New password same as old password";
return undef;
}
#
# Do it again. This ensures we use the current algorithm, not whatever
# it was encoded with last time.
# XXX Perl crypt doesn't have this option!
# XXX $new_encoding = crypt($argref->{"password1"});
my $safe_encoding = escapeshellarg($new_encoding);
#
# Invoke the backend to deal with this.
#
my $cmd = "tbacct passwd $target_uid $safe_encoding";
##print $cmd;