loncom/build/make_domain_coordinator.pl - diff

Return to make_domain_coordinator.pl CVS log

Up to [LON-CAPA] / loncom / build

Diff for /loncom/build/make_domain_coordinator.pl between versions 1.9 and 1.12

version 1.9, 2003/02/03 18:03:52	version 1.12, 2007/06/01 05:17:58
Line 33 make_domain_coordinator.pl - Make a doma	Line 33 make_domain_coordinator.pl - Make a doma
#	#
# http://www.lon-capa.org/	# http://www.lon-capa.org/
#	#
# YEAR=2002
#
###	###

=pod	=pod
Line 91 Set roles.hist and roles.db	Line 89 Set roles.hist and roles.db

# ---------------------------------------------------- Configure general values	# ---------------------------------------------------- Configure general values

my %perlvar; # Holds network-wide and machine-specific configuration values.	use lib '/home/httpd/lib/perl/';
# We only need one configuration value however, lonUsersDir. Rather than	use LONCAPA;
# read this out of loncapa.conf, I am just going to hard-code this for now.
$perlvar{'lonUsersDir'}='/home/httpd/lonUsers';

=pod	=pod

Line 117 For example, "dcmsu" or "dcumich" would	Line 113 For example, "dcmsu" or "dcumich" would
USERNAMEs for places like Mich State Univ, etc.	USERNAMEs for places like Mich State Univ, etc.

The second argument specifies the domain of the computer	The second argument specifies the domain of the computer
coordinator and should consist of only alphanumeric characters.	coordinator.

=cut	=cut

Line 132 if (@ARGV!=2) {	Line 128 if (@ARGV!=2) {
"\n".'USERNAMEs for places like Mich State Univ, etc.'."\n");	"\n".'USERNAMEs for places like Mich State Univ, etc.'."\n");
}	}
my ($username,$domain)=(@ARGV); shift @ARGV; shift @ARGV;	my ($username,$domain)=(@ARGV); shift @ARGV; shift @ARGV;
unless ($username=~/^\w+$/ and $username!~/\_/) {	if ($username=~/$LONCAPA::not_username_re/) {
die('** ERROR ** '.	die('** ERROR ** '.
'Username '.$username.' must consist only of alphanumeric characters'.	'Username '.$username.' must consist only of - . and alphanumeric characters'.
"\n");	"\n");
}	}
unless ($domain=~/^\w+$/ and $domain!~/\_/) {	if ($domain=~/$LONCAPA::not_domain_re/) {
die('** ERROR ** '.	die('** ERROR ** '.
'Domain '.$domain.' must consist only of alphanumeric characters'.	'Domain '.$domain.' must consist only of - . and alphanumeric charaters and '.
"\n");	"\n");
}	}

Line 179 if (-d "/home/$username") {	Line 175 if (-d "/home/$username") {
die ('** ERROR ** '.$username.' is already a linux operating system '.	die ('** ERROR ** '.$username.' is already a linux operating system '.
'user.'."\n".$caveat);	'user.'."\n".$caveat);
}	}
my $udpath=propath($domain,$username);	my $udpath=&propath($domain,$username);
if (-d $udpath) {	if (-d $udpath) {
die ('** ERROR ** '.$username.' is already defined as a LON-CAPA '.	die ('** ERROR ** '.$username.' is already defined as a LON-CAPA '.
'user.'."\n".$caveat);	'user.'."\n".$caveat);
Line 233 if ($< != 0) { # Am I root?	Line 229 if ($< != 0) { # Am I root?

=cut	=cut

	# ----------------------------------------------------------- /usr/sbin/groupadd
	# -- Add group
	$username=~s/\W//g; # an extra filter, just to be sure

	print "adding group: $username \n";
	my $status = system('/usr/sbin/groupadd', $username);
	if ($status) {
	die "Error. Something went wrong with the addition of group ".
	"\"$username\".\n";
	}
	my $gid = getgrnam($username);

# ----------------------------------------------------------- /usr/sbin/useradd	# ----------------------------------------------------------- /usr/sbin/useradd
	# -- Add user

$username=~s/\W//g; # an extra filter, just to be sure	print "adding user: $username \n";
`/usr/sbin/useradd $username`; # Add the user with the 'useradd' command.	my $status = system('/usr/sbin/useradd','-c','LON-CAPA user','-g',$gid,$username);
	if ($status) {
	system("/usr/sbin/groupdel $username");
	die "Error. Something went wrong with the addition of user ".
	"\"$username\".\n";
	}

	print "Done adding user\n";
	# Make www a member of that user group.
	my $groups=`/usr/bin/groups www`;
	# untaint
	my ($safegroups)=($groups=~/:\s*([\s\w]+)/);
	$groups=$safegroups;
	chomp $groups; $groups=~s/^\S+\s+\:\s+//;
	my @grouplist=split(/\s+/,$groups);
	my @ugrouplist=grep {!/www\|$username/} @grouplist;
	my $gl=join(',',(@ugrouplist,$username));
	print "Putting www in user's group\n";
	if (system('/usr/sbin/usermod','-G',$gl,'www')) {
	die "Error. Could not make www a member of the group ".
	"\"$username\".\n";
	}

	# Check if home directory exists for user
	# If not, create one.
	if (!-e "/home/$username") {
	if (!mkdir("/home/$username",0710)) {
	print "Error. Could not add home directory for ".
	"\"$username\".\n";
	}
	}

	if (-d "/home/$username") {
	system('/bin/chown',"$username:$username","/home/$username");
	system('/bin/chmod','-R','0660',"/home/$username");
	system('/bin/chmod','0710',"/home/$username");
	}
=pod	=pod

=item 3 (as root). enter in a password	=item 3 (as root). enter in a password
Line 323 close(OUT);	Line 367 close(OUT);
=cut	=cut

use GDBM_File; # A simplistic key-value pairing database.	use GDBM_File; # A simplistic key-value pairing database.
my %hash;

tie(%hash,'GDBM_File',"$udpath/roles.db",	my $rolesref=&LONCAPA::locking_hash_tie("$udpath/roles.db",&GDBM_WRCREAT());
&GDBM_WRCREAT,0640); # Interface with GDBM database thru a hash variable.	if (!$rolesref) {
	die('unable to tie roles db: '."$udpath/roles.db");
$hash{'/'.$domain.'/_dc'}='dc'; # Set the domain coordinator role.	}
	$rolesref->{'/'.$domain.'/_dc'}='dc'; # Set the domain coordinator role.
open(OUT, ">$udpath/roles.hist"); # roles.hist is the synchronous plain text.	open(OUT, ">$udpath/roles.hist"); # roles.hist is the synchronous plain text.
map {	foreach my $key (keys(%{$rolesref})) {
print(OUT $_.' : '.$hash{$_}."\n");	print(OUT $key.' : '.$rolesref->{$key}."\n");
} keys %hash;	}
close(OUT);	close(OUT);
untie(%hash); # Finish interfacing with GDBM database.	&LONCAPA::locking_hash_untie($rolesref);


`chown www:www $udpath/roles.hist`; # Must be writeable by httpd process.	`chown www:www $udpath/roles.hist`; # Must be writeable by httpd process.
`chown www:www $udpath/roles.db`; # Must be writeable by httpd process.	`chown www:www $udpath/roles.db`; # Must be writeable by httpd process.
Line 354 my $hostname=`hostname`; chomp($hostname	Line 399 my $hostname=`hostname`; chomp($hostname
print("http://$hostname/adm/createuser will allow you to further define".	print("http://$hostname/adm/createuser will allow you to further define".
" this user.\n"); # Output a suggested URL.	" this user.\n"); # Output a suggested URL.

# ================================================================= SUBROUTINES
# Subroutine propath: take in domain and username, and generate filesystem path
sub propath {
my ($udom,$uname)=@_; # The lonDefDomain, and the domain coord. username.
$udom =~ s/\W//g; # Taint removal.
$uname =~ s/\W//g; # Taint removal.
my $subdir = $uname.'__';
$subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/; # The path must have three subdirs.
my $proname = "$perlvar{'lonUsersDir'}/$udom/$subdir/$uname"; # Total path.
return $proname; # Return the total user directory filesystem path.
}

=pod	=pod

=head1 AUTHOR	=head1 AUTHOR

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.9
changed lines
	Added in v.1.12