version 1.7, 2002/10/12 16:23:21
|
version 1.13, 2007/12/31 16:52:26
|
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 |
|
# 3/1,3/3,3/4 Scott Harrison |
|
# 10/12 Scott Harrison |
|
# |
|
### |
### |
|
|
=pod |
=pod |
Line 93 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. |
use LONCAPA::lonmetadata; |
$perlvar{'lonUsersDir'}='/home/httpd/lonUsers'; |
use DBI; |
|
|
=pod |
=pod |
|
|
Line 113 characters and be a string of length gre
|
Line 109 characters and be a string of length gre
|
The first argument |
The first argument |
specifies the user name of the domain coordinator and |
specifies the user name of the domain coordinator and |
should consist of only alphanumeric characters. |
should consist of only alphanumeric characters. |
|
It is recommended that the USERNAME should be institution-specific |
|
as opposed to something like "Sammy" or "Jo". |
|
For example, "dcmsu" or "dcumich" would be good domain coordinator |
|
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 |
|
|
# ----------------------------------------------- So, are we invoked correctly? |
# ----------------------------------------------- So, are we invoked correctly? |
# Two arguments or abort |
# Two arguments or abort |
if (@ARGV!=2) { |
if (@ARGV!=2) { |
die 'usage: make_domain_coordinator.pl [USERNAME] [DOMAIN] '."\n". |
die('usage: make_domain_coordinator.pl [USERNAME] [DOMAIN] '."\n". |
'(and password through standard input)'."\n"; |
'(and password through standard input)'."\n". |
|
'It is recommended that the USERNAME should be institution-specific '. |
|
"\n".'as opposed to something like "Sammy" or "Jo".'."\n". |
|
'For example, "dcmsu" or "dcumich" would be good domain coordinator'. |
|
"\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 173 if (-d "/home/$username") {
|
Line 177 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 227 if ($< != 0) { # Am I root?
|
Line 231 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 317 close(OUT);
|
Line 369 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. |
} |
|
my $now = time; |
|
$rolesref->{'/'.$domain.'/_dc'}='dc_0_'.$now; # 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. |
|
|
|
my %perlvar = %{&LONCAPA::Configuration::read_conf('loncapa.conf')}; |
|
my $dompath = $perlvar{'lonUsersDir'}.'/'.$domain; |
|
my $domrolesref = &LONCAPA::locking_hash_tie("$dompath/nohist_domainroles.db",&GDBM_WRCREAT()); |
|
|
|
if (!$domrolesref) { |
|
die('unable to tie nohist_domainroles db: '."$dompath/nohist_domainroles.db"); |
|
} |
|
|
|
# Store in nohist_domainroles.db |
|
my $domkey=&LONCAPA::escape('dc:'.$username.':'.$domain.'::'.$domain.':'); |
|
$domrolesref->{$domkey}= &LONCAPA::escape('0:'.$now); |
|
&LONCAPA::locking_hash_untie($domrolesref); |
|
|
|
#Update allusers MySQL table |
|
|
|
print "Adding new user to allusers table\n"; |
|
&allusers_update($username,$domain,\%perlvar); |
|
|
=pod |
=pod |
|
|
=item 10. |
=item 10. |
Line 343 by going to http://MACHINENAME/adm/creat
|
Line 415 by going to http://MACHINENAME/adm/creat
|
=cut |
=cut |
|
|
# Output success message, and inform sysadmin about how to further proceed. |
# Output success message, and inform sysadmin about how to further proceed. |
print("$username is now a domain coordinator\n"); # Output success message. |
print("\n$username is now a domain coordinator\n"); # Output success message. |
my $hostname=`hostname`; chomp($hostname); # Read in hostname. |
my $hostname=`hostname`; chomp($hostname); # Read in hostname. |
print("http://$hostname/adm/createuser will allow you to further define". |
print("\n".'Once LON-CAPA is running, you should log-in and use: '."\n". |
" this user.\n"); # Output a suggested URL. |
'http://'.$hostname.'/adm/createuser to further define this user.'."\n\n". |
|
'From the user management menu, click the link: "Add/Modify a Single User" '."\n". |
|
'to search for the user and to provide additional information (last name, first name etc.).'."\n"); |
|
# Output a suggested URL. |
|
|
|
sub allusers_update { |
|
my ($username,$domain,$perlvar) = @_; |
|
my %tablenames = ( |
|
'allusers' => 'allusers', |
|
); |
|
my $dbh; |
|
unless ($dbh = DBI->connect("DBI:mysql:loncapa","www", |
|
$perlvar->{'lonSqlAccess'}, |
|
{ RaiseError =>0,PrintError=>0})) { |
|
print "Cannot connect to database!\n"; |
|
return; |
|
} |
|
my $tablechk = &allusers_table_exists($dbh); |
|
if ($tablechk == 0) { |
|
my $request = |
|
&LONCAPA::lonmetadata::create_metadata_storage('allusers','allusers'); |
|
$dbh->do($request); |
|
if ($dbh->err) { |
|
print "Failed to crate allusers table\n"; |
|
return; |
|
} |
|
} |
|
my %userdata = ( |
|
username => $username, |
|
domain => $domain, |
|
); |
|
my %loghash = |
|
&LONCAPA::lonmetadata::process_allusers_data($dbh,undef, |
|
\%tablenames,$username,$domain,\%userdata,'update'); |
|
foreach my $key (keys(%loghash)) { |
|
print $loghash{$key}."\n"; |
|
} |
|
return; |
|
} |
|
|
# ================================================================= SUBROUTINES |
sub allusers_table_exists { |
# Subroutine propath: take in domain and username, and generate filesystem path |
my ($dbh) = @_; |
sub propath { |
my $sth=$dbh->prepare('SHOW TABLES'); |
my ($udom,$uname)=@_; # The lonDefDomain, and the domain coord. username. |
$sth->execute(); |
$udom =~ s/\W//g; # Taint removal. |
my $aref = $sth->fetchall_arrayref; |
$uname =~ s/\W//g; # Taint removal. |
$sth->finish(); |
my $subdir = $uname.'__'; |
if ($sth->err()) { |
$subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/; # The path must have three subdirs. |
return undef; |
my $proname = "$perlvar{'lonUsersDir'}/$udom/$subdir/$uname"; # Total path. |
} |
return $proname; # Return the total user directory filesystem path. |
my $result = 0; |
|
foreach my $table (@{$aref}) { |
|
if ($table->[0] eq 'allusers') { |
|
$result = 1; |
|
last; |
|
} |
|
} |
|
return $result; |
} |
} |
|
|
=pod |
=pod |
Line 366 sub propath {
|
Line 483 sub propath {
|
|
|
Written to help the LON-CAPA project. |
Written to help the LON-CAPA project. |
|
|
Scott Harrison, sharrison@users.sourceforge.net |
|
|
|
=cut |
=cut |
|
|