version 1.16, 2009/07/17 01:11:11
|
version 1.28, 2021/01/08 00:38:07
|
Line 92 Set roles.hist and roles.db
|
Line 92 Set roles.hist and roles.db
|
use lib '/home/httpd/lib/perl/'; |
use lib '/home/httpd/lib/perl/'; |
use LONCAPA; |
use LONCAPA; |
use LONCAPA::lonmetadata; |
use LONCAPA::lonmetadata; |
|
use Term::ReadKey; |
|
use Apache::lonnet; |
|
use Apache::lonlocal; |
use DBI; |
use DBI; |
|
use Storable qw(nfreeze); |
|
use Sys::Hostname::FQDN(); |
|
use strict; |
|
|
=pod |
=pod |
|
|
Line 119 coordinator.
|
Line 125 coordinator.
|
|
|
=cut |
=cut |
|
|
|
my $lang = &Apache::lonlocal::choose_language(); |
|
&Apache::lonlocal::get_language_handle(undef,$lang); |
|
print"\n"; |
|
|
# ----------------------------------------------- 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". |
print(&mt('usage: [_1]','make_domain_coordinator.pl [USERNAME] [DOMAIN]')."\n\n". |
'(and password through standard input)'."\n". |
&mt('It is recommended that the USERNAME should be institution-specific.'). |
'It is recommended that the USERNAME should be institution-specific '. |
"\n".&mt('It should not be something like "Sammy" or "Jo".')."\n". |
"\n".'as opposed to something like "Sammy" or "Jo".'."\n". |
&mt('For example, [_1] or [_2] would be good domain coordinator USERNAMEs for places like Michigan State University, etc.','"domcoordmsu"','"dcmichstate"')."\n"); |
'For example, "dcmsu" or "dcumich" would be good domain coordinator'. |
exit; |
"\n".'USERNAMEs for places like Mich State Univ, etc.'."\n"); |
|
} |
} |
my ($username,$domain)=(@ARGV); shift @ARGV; shift @ARGV; |
my ($username,$domain)=(@ARGV); |
if ($username=~/$LONCAPA::not_username_re/) { |
if ($username=~/$LONCAPA::not_username_re/) { |
die('**** ERROR **** '. |
print(&mt('**** ERROR **** Username [_1] must consist only of - . and alphanumeric characters.',$username)."\n"); |
'Username '.$username.' must consist only of - . and alphanumeric characters'. |
exit; |
"\n"); |
|
} |
} |
if ($domain=~/$LONCAPA::not_domain_re/) { |
if ($domain=~/$LONCAPA::not_domain_re/) { |
die('**** ERROR **** '. |
print(&mt('**** ERROR **** Domain [_1] must consist only of - . and alphanumeric characters.',$domain)."\n"); |
'Domain '.$domain.' must consist only of - . and alphanumeric charaters and '. |
exit; |
"\n"); |
|
} |
} |
|
|
# Output a warning message. |
# Does user already exist |
print('**** NOTE **** '. |
my ($is_user,$has_lc_account); |
'Generating a domain coordinator is "serious business".'."\n". |
|
'Choosing a difficult-to-guess (and keeping it a secret) password '."\n". |
my $udpath=&propath($domain,$username); |
'is highly recommended.'."\n"); |
if (-d $udpath) { |
|
$has_lc_account = 1; |
print("Password: "); $|=1; |
|
my $passwd=<>; # read in password from standard input |
|
chomp($passwd); |
|
|
|
if (length($passwd)<6 or length($passwd)>30) { |
|
die('**** ERROR **** '.'Password is an unreasonable length.'."\n". |
|
'It should be at least 6 characters in length.'."\n"); |
|
} |
} |
my $pbad=0; |
|
foreach (split(//,$passwd)) {if ((ord($_)<32)||(ord($_)>126)){$pbad=1;}} |
if ($has_lc_account) { |
if ($pbad) { |
print(&mt('**** ERROR **** [_1] is already defined as a LON-CAPA user.', |
die('**** ERROR **** '. |
$username)."\n\n". |
'Password must consist of standard ASCII characters'."\n"); |
&mt('To assign a domain coordinator role to an existing user, use: [_1]', |
|
"\n".'perl add_domain_coordinator_privilege.pl')."\n\n"); |
|
exit; |
} |
} |
|
|
# And does user already exist |
if (-d "/home/$username") { |
|
$is_user = 1; |
|
} |
|
|
my $caveat = |
if ($is_user) { |
'For security reasons, this script will only automatically generate '."\n". |
print(&mt('**** ERROR **** [_1] is already a linux operating system user.', |
'new users, not pre-existing users.'."\n". |
$username)."\n\n". |
"If you want to make '$username' a domain coordinator, you "."\n". |
&mt('This script will only automatically generate new users.')."\n". |
'should do so manually by customizing the MANUAL PROCEDURE'."\n". |
&mt('To assign a domain coordinator role to an existing user:')."\n\n". |
'described in the documentation. To view the documentation '."\n". |
&mt('If you want to make "[_1]" a domain coordinator, you should do so manually by customizing the MANUAL PROCEDURE described in the documentation.',$username)."\n\n". |
'for this script, type '. |
&mt('To view the documentation for this script, type: [_1].', |
"'perldoc ./make_domain_coordinator.pl'."."\n"; |
"\n".'perldoc ./make_domain_coordinator.pl')."\n\n"); |
|
exit; |
|
} |
|
|
if (-d "/home/$username") { |
# Output a warning message. |
die ('**** ERROR **** '.$username.' is already a linux operating system '. |
print(&mt('**** NOTE **** Generating a domain coordinator is "serious business".')."\n". |
'user.'."\n".$caveat); |
&mt('You must choose a password that is difficult to guess.')."\n"); |
|
|
|
print(&mt('Continue? ~[Y/n~] ')); |
|
my $go_on = <STDIN>; |
|
chomp($go_on); |
|
$go_on =~ s/(^\s+|\s+$)//g; |
|
my $yes = &mt('y'); |
|
unless (($go_on eq '') || ($go_on =~ /^\Q$yes\E/i)) { |
|
exit; |
|
} |
|
print "\n"; |
|
|
|
my ($got_passwd,$firstpass,$secondpass,$passwd); |
|
my $maxtries = 10; |
|
my $trial = 0; |
|
while ((!$got_passwd) && ($trial < $maxtries)) { |
|
$firstpass = &get_password(&mt('Enter password')); |
|
if (length($firstpass) < 6) { |
|
print(&mt('Password too short.')."\n". |
|
&mt('Please choose a password with at least six characters.')."\n". |
|
&mt('Please try again.')."\n"); |
|
} elsif (length($firstpass) > 30) { |
|
print(&mt('Password too long.')."\n". |
|
&mt('Please choose a password with no more than thirty characters.')."\n". |
|
&mt('Please try again.')."\n"); |
|
} else { |
|
my $pbad=0; |
|
foreach (split(//,$firstpass)) {if ((ord($_)<32)||(ord($_)>126)){$pbad=1;}} |
|
if ($pbad) { |
|
print(&mt('Password contains invalid characters.')."\n". |
|
&mt('Password must consist of standard ASCII characters.')."\n". |
|
&mt('Please try again.')."\n"); |
|
} else { |
|
$secondpass = &get_password(&mt('Enter password a second time')); |
|
if ($firstpass eq $secondpass) { |
|
$got_passwd = 1; |
|
$passwd = $firstpass; |
|
} else { |
|
print(&mt('Passwords did not match.')."\n". |
|
&mt('Please try again.')."\n"); |
|
} |
|
} |
|
$trial ++; |
|
} |
} |
} |
my $udpath=&propath($domain,$username); |
if (!$got_passwd) { |
if (-d $udpath) { |
exit; |
die ('**** ERROR **** '.$username.' is already defined as a LON-CAPA '. |
|
'user.'."\n".$caveat); |
|
} |
} |
|
print "\n"; |
|
|
=pod |
=pod |
|
|
Line 219 login as root on your Linux system
|
Line 267 login as root on your Linux system
|
# ------------------------------------------------------------ So, are we root? |
# ------------------------------------------------------------ So, are we root? |
|
|
if ($< != 0) { # Am I root? |
if ($< != 0) { # Am I root? |
die 'You must be root in order to generate a domain coordinator.'."\n"; |
print(&mt('You must be root in order to generate a domain coordinator.'). |
|
"\n"); |
} |
} |
|
|
=pod |
=pod |
Line 235 if ($< != 0) { # Am I root?
|
Line 284 if ($< != 0) { # Am I root?
|
# -- Add group |
# -- Add group |
$username=~s/\W//g; # an extra filter, just to be sure |
$username=~s/\W//g; # an extra filter, just to be sure |
|
|
print "adding group: $username \n"; |
print(&mt('adding group: [_1]',$username)."\n"); |
my $status = system('/usr/sbin/groupadd', $username); |
my $status = system('/usr/sbin/groupadd', $username); |
if ($status) { |
if ($status) { |
die "Error. Something went wrong with the addition of group ". |
print(&mt('Error.').' '. |
"\"$username\".\n"; |
&mt('Something went wrong with the addition of group "[_1]".', |
|
$username)."\n"); |
|
exit; |
} |
} |
my $gid = getgrnam($username); |
my $gid = getgrnam($username); |
|
|
# ----------------------------------------------------------- /usr/sbin/useradd |
# ----------------------------------------------------------- /usr/sbin/useradd |
# -- Add user |
# -- Add user |
|
|
print "adding user: $username \n"; |
print(&mt('adding user: [_1]',$username)."\n"); |
my $status = system('/usr/sbin/useradd','-c','LON-CAPA user','-g',$gid,$username); |
my $status = system('/usr/sbin/useradd','-c','LON-CAPA user','-g',$gid,$username); |
if ($status) { |
if ($status) { |
system("/usr/sbin/groupdel $username"); |
system("/usr/sbin/groupdel $username"); |
die "Error. Something went wrong with the addition of user ". |
print(&mt('Error.').' '. |
"\"$username\".\n"; |
&mt('Something went wrong with the addition of user "[_1]".', |
|
$username)."\n"); |
|
exit; |
} |
} |
|
|
print "Done adding user\n"; |
print(&mt('Done adding user.')."\n"); |
# Make www a member of that user group. |
# Make www a member of that user group. |
my $groups=`/usr/bin/groups www`; |
my $groups=`/usr/bin/groups www`; |
# untaint |
# untaint |
Line 264 chomp $groups; $groups=~s/^\S+\s+\:\s+//
|
Line 317 chomp $groups; $groups=~s/^\S+\s+\:\s+//
|
my @grouplist=split(/\s+/,$groups); |
my @grouplist=split(/\s+/,$groups); |
my @ugrouplist=grep {!/www|$username/} @grouplist; |
my @ugrouplist=grep {!/www|$username/} @grouplist; |
my $gl=join(',',(@ugrouplist,$username)); |
my $gl=join(',',(@ugrouplist,$username)); |
print "Putting www in user's group\n"; |
print(&mt("Putting www in user's group.")."\n"); |
if (system('/usr/sbin/usermod','-G',$gl,'www')) { |
if (system('/usr/sbin/usermod','-G',$gl,'www')) { |
die "Error. Could not make www a member of the group ". |
print(&mt('Error.').' '.&mt('Could not make www a member of the group "[_1]".', |
"\"$username\".\n"; |
$username)."\n"); |
|
exit; |
} |
} |
|
|
# Check if home directory exists for user |
# Check if home directory exists for user |
# If not, create one. |
# If not, create one. |
if (!-e "/home/$username") { |
if (!-e "/home/$username") { |
if (!mkdir("/home/$username",0710)) { |
if (!mkdir("/home/$username",0710)) { |
print "Error. Could not add home directory for ". |
print(&mt('Error.').' '.&mt('Could not add home directory for "[_1]".', |
"\"$username\".\n"; |
$username)."\n"); |
|
exit; |
} |
} |
} |
} |
|
|
Line 299 if (-d "/home/$username") {
|
Line 354 if (-d "/home/$username") {
|
|
|
# Process password (taint-check, then pass to the UNIX passwd command). |
# Process password (taint-check, then pass to the UNIX passwd command). |
$username =~ s/\W//g; # an extra filter, just to be sure |
$username =~ s/\W//g; # an extra filter, just to be sure |
$pbad = 0; |
my $pbad = 0; |
foreach (split(//,$passwd)) {if ((ord($_)<32)||(ord($_)>126)){$pbad=1;}} |
foreach (split(//,$passwd)) {if ((ord($_)<32)||(ord($_)>126)){$pbad=1;}} |
if ($pbad) { |
if ($pbad) { |
die('Password must consist of standard ASCII characters'."\n"); |
print(&mt('Password must consist of standard ASCII characters.'). |
|
"\n"); |
} |
} |
|
|
my $distro; |
my ($distro,$nostdin); |
if (open(PIPE,"perl distprobe|")) { |
if (open(PIPE,"perl distprobe|")) { |
$distro = <PIPE>; |
$distro = <PIPE>; |
close(PIPE); |
close(PIPE); |
} |
} |
if ($distro =~ /^ubuntu|debian/) { |
if ($distro =~ /^ubuntu|debian/) { |
|
$nostdin = 1; |
|
} elsif ($distro =~ /^suse([\d.]+)$/) { |
|
if ($1 > 12.2) { |
|
$nostdin = 1; |
|
} |
|
} elsif ($distro =~ /^sles(\d+)$/) { |
|
if ($1 > 11) { |
|
$nostdin = 1; |
|
} |
|
} |
|
if ($nostdin) { |
open(OUT,"|usermod -p `mkpasswd $passwd` $username"); |
open(OUT,"|usermod -p `mkpasswd $passwd` $username"); |
close(OUT); |
close(OUT); |
} else { |
} else { |
Line 371 close(OUT);
|
Line 438 close(OUT);
|
|
|
# Get permissions correct on udpath |
# Get permissions correct on udpath |
|
|
print "Setting permissions on user data directories. This may take a moment, please be patient ...\n"; |
print(&mt('Setting permissions on user data directories.').' '. |
|
&mt('This may take a moment, please be patient ...')."\n"); |
`chown -R www:www /home/httpd/lonUsers/$domain` ; # Must be writeable by httpd process. |
`chown -R www:www /home/httpd/lonUsers/$domain` ; # Must be writeable by httpd process. |
|
|
=pod |
=pod |
Line 387 use GDBM_File; # A simplistic key-value
|
Line 455 use GDBM_File; # A simplistic key-value
|
|
|
my $rolesref=&LONCAPA::locking_hash_tie("$udpath/roles.db",&GDBM_WRCREAT()); |
my $rolesref=&LONCAPA::locking_hash_tie("$udpath/roles.db",&GDBM_WRCREAT()); |
if (!$rolesref) { |
if (!$rolesref) { |
die('unable to tie roles db: '."$udpath/roles.db"); |
print(&mt('Error').' '. |
|
&mt('unable to tie roles db: [_1].',"$udpath/roles.db")."\n"); |
|
exit; |
} |
} |
my $now = time; |
my $now = time; |
$rolesref->{'/'.$domain.'/_dc'}='dc_0_'.$now; # Set the domain coordinator role. |
$rolesref->{'/'.$domain.'/_dc'}='dc_0_'.$now; # Set the domain coordinator role. |
Line 407 my $dompath = $perlvar{'lonUsersDir'}.'/
|
Line 477 my $dompath = $perlvar{'lonUsersDir'}.'/
|
my $domrolesref = &LONCAPA::locking_hash_tie("$dompath/nohist_domainroles.db",&GDBM_WRCREAT()); |
my $domrolesref = &LONCAPA::locking_hash_tie("$dompath/nohist_domainroles.db",&GDBM_WRCREAT()); |
|
|
if (!$domrolesref) { |
if (!$domrolesref) { |
die('unable to tie nohist_domainroles db: '."$dompath/nohist_domainroles.db"); |
print(&mt('Error').' '.&mt('unable to tie nohist_domainroles db: [_1].', |
|
"$dompath/nohist_domainroles.db")."\n"); |
} |
} |
|
|
# Store in nohist_domainroles.db |
# Store in nohist_domainroles.db |
Line 418 $domrolesref->{$domkey}= &LONCAPA::escap
|
Line 489 $domrolesref->{$domkey}= &LONCAPA::escap
|
system('/bin/chown',"www:www","$dompath/nohist_domainroles.db"); # Must be writeable by httpd process. |
system('/bin/chown',"www:www","$dompath/nohist_domainroles.db"); # Must be writeable by httpd process. |
system('/bin/chown',"www:www","$dompath/nohist_domainroles.db.lock"); |
system('/bin/chown',"www:www","$dompath/nohist_domainroles.db.lock"); |
|
|
|
# Log with domainconfiguser in nohist_rolelog.db |
|
my $domconfiguser = $domain.'-domainconfig'; |
|
my $subdir = $domconfiguser; |
|
$subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/; |
|
$subdir .= "/$domconfiguser"; |
|
|
|
if (-d "$dompath/$subdir") { |
|
my $rolelogref = &LONCAPA::locking_hash_tie("$dompath/$subdir/nohist_rolelog.db",&GDBM_WRCREAT()); |
|
my $domlogkey = &LONCAPA::escape($now.'00000'.$$.'000000'); |
|
my $storehash = { |
|
role => 'dc', |
|
start => $now, |
|
end => 0, |
|
context => 'server', |
|
}; |
|
my $domlogvalue = { |
|
'exe_uname' => '', |
|
'exe_udom' => $domain, |
|
'exe_time' => $now, |
|
'exe_ip' => '127.0.0.1', |
|
'delflag' => '', |
|
'logentry' => $storehash, |
|
'uname' => $username, |
|
'udom' => $domain, |
|
}; |
|
$rolelogref->{$domlogkey}=&freeze_escape($domlogvalue); |
|
&LONCAPA::locking_hash_untie($rolelogref); |
|
|
|
system('/bin/chown',"www:www","$dompath/$subdir/nohist_rolelog.db"); # Must be writeable by httpd process. |
|
system('/bin/chown',"www:www","$dompath/$subdir/nohist_rolelog.db.lock"); |
|
} else { |
|
print(&mt('Failed to log role creation as the path to the directory: "[_1]" does not exist.',"$dompath/$subdir/")."\n". |
|
&mt('Please run UPDATE from the top level directory of the extracted LON-CAPA tarball, i.e., two levels up from this current directory (loncom/build).')); |
|
} |
|
|
#Update allusers MySQL table |
#Update allusers MySQL table |
|
|
print "Adding new user to allusers table\n"; |
print(&mt('Adding new user to allusers table.')."\n"); |
&allusers_update($username,$domain,\%perlvar); |
&allusers_update($username,$domain,\%perlvar); |
|
|
=pod |
=pod |
Line 433 by going to http://MACHINENAME/adm/creat
|
Line 539 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("\n$username is now a domain coordinator\n"); # Output success message. |
print("\n".&mt('[_1] is now a domain coordinator',$username)."\n"); # Output success message. |
my $hostname=`hostname`; chomp($hostname); # Read in hostname. |
my $hostname = Sys::Hostname::FQDN::fqdn(); # Read in hostname. |
print("\n".'Once LON-CAPA is running, you should log-in and use: '."\n". |
print("\n". |
'http://'.$hostname.'/adm/createuser to further define this user.'."\n\n". |
&mt('Once LON-CAPA is running, you should log-in and use: [_1] to further define this user.', |
'From the user management menu, click the link: "Add/Modify a Single User" '."\n". |
"\nhttp://$hostname/adm/createuser\n")."\n\n". |
'to search for the user and to provide additional information (last name, first name etc.).'."\n"); |
&mt('From the user management menu, click the link: "Add/Modify a User" to search for the user and to provide additional information (last name, first name etc.).')."\n"); |
# Output a suggested URL. |
# Output a suggested URL. |
|
|
sub allusers_update { |
sub allusers_update { |
Line 450 sub allusers_update {
|
Line 556 sub allusers_update {
|
unless ($dbh = DBI->connect("DBI:mysql:loncapa","www", |
unless ($dbh = DBI->connect("DBI:mysql:loncapa","www", |
$perlvar->{'lonSqlAccess'}, |
$perlvar->{'lonSqlAccess'}, |
{ RaiseError =>0,PrintError=>0})) { |
{ RaiseError =>0,PrintError=>0})) { |
print "Cannot connect to database!\n"; |
print(&mt('Cannot connect to database!')."\n"); |
return; |
return; |
} |
} |
my $tablechk = &allusers_table_exists($dbh); |
my $tablechk = &allusers_table_exists($dbh); |
Line 459 sub allusers_update {
|
Line 565 sub allusers_update {
|
&LONCAPA::lonmetadata::create_metadata_storage('allusers','allusers'); |
&LONCAPA::lonmetadata::create_metadata_storage('allusers','allusers'); |
$dbh->do($request); |
$dbh->do($request); |
if ($dbh->err) { |
if ($dbh->err) { |
print "Failed to crate allusers table\n"; |
print(&mt('Failed to create [_1] table.','allusers')."\n"); |
return; |
return; |
} |
} |
} |
} |
Line 495 sub allusers_table_exists {
|
Line 601 sub allusers_table_exists {
|
return $result; |
return $result; |
} |
} |
|
|
|
sub get_password { |
|
my ($prompt) = @_; |
|
local $| = 1; |
|
print $prompt.': '; |
|
my $newpasswd = ''; |
|
ReadMode 'raw'; |
|
my $key; |
|
while(ord($key = ReadKey(0)) != 10) { |
|
if(ord($key) == 127 || ord($key) == 8) { |
|
chop($newpasswd); |
|
print "\b \b"; |
|
} elsif(!ord($key) < 32) { |
|
$newpasswd .= $key; |
|
print '*'; |
|
} |
|
} |
|
ReadMode 'normal'; |
|
print "\n"; |
|
return $newpasswd; |
|
} |
|
|
|
sub freeze_escape { |
|
my ($value)=@_; |
|
if (ref($value)) { |
|
$value=&nfreeze($value); |
|
return '__FROZEN__'.&LONCAPA::escape($value); |
|
} |
|
return &LONCAPA::escape($value); |
|
} |
|
|
=pod |
=pod |
|
|
=head1 AUTHOR |
=head1 AUTHOR |