version 1.1, 2002/03/02 03:49:18
|
version 1.20, 2011/11/17 14:29:51
|
Line 6
|
Line 6
|
|
|
make_domain_coordinator.pl - Make a domain coordinator on a LON-CAPA system |
make_domain_coordinator.pl - Make a domain coordinator on a LON-CAPA system |
|
|
|
=cut |
|
|
|
# The LearningOnline Network |
|
# make_domain_coordinator.pl - Make a domain coordinator on a system |
|
# |
|
# $Id$ |
|
# |
|
# This file is part of the LearningOnline Network with CAPA (LON-CAPA). |
|
# |
|
# LON-CAPA is free software; you can redistribute it and/or modify |
|
# it under the terms of the GNU General Public License as published by |
|
# the Free Software Foundation; either version 2 of the License, or |
|
# (at your option) any later version. |
|
# |
|
# LON-CAPA is distributed in the hope that it will be useful, |
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
# GNU General Public License for more details. |
|
# |
|
# You should have received a copy of the GNU General Public License |
|
# along with LON-CAPA; if not, write to the Free Software |
|
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
|
# |
|
# /home/httpd/html/adm/gpl.txt |
|
# |
|
# http://www.lon-capa.org/ |
|
# |
|
### |
|
|
|
=pod |
|
|
=head1 DESCRIPTION |
=head1 DESCRIPTION |
|
|
Automates the steps for domain coordinator creation. This |
Automates the steps for domain coordinator creation. This |
Line 18 These are the steps that are executed on
|
Line 49 These are the steps that are executed on
|
=item * |
=item * |
|
|
Tests to see if user already exists for linux system or for |
Tests to see if user already exists for linux system or for |
LON-CAPA, if so aborts |
LON-CAPA, if so aborts. A message is output that recommends following |
|
a manual procedure enabling this user if so desired. |
|
|
=item * |
=item * |
|
|
Line 44 Set roles.hist and roles.db
|
Line 76 Set roles.hist and roles.db
|
|
|
=cut |
=cut |
|
|
# The LearningOnline Network |
|
# make_domain_coordinator.pl - Make a domain coordinator on a system |
|
# |
|
# $Id$ |
|
# |
|
# Copyright Michigan State University Board of Trustees |
|
# |
|
# This file is part of the LearningOnline Network with CAPA (LON-CAPA). |
|
# |
|
# LON-CAPA is free software; you can redistribute it and/or modify |
|
# it under the terms of the GNU General Public License as published by |
|
# the Free Software Foundation; either version 2 of the License, or |
|
# (at your option) any later version. |
|
# |
|
# LON-CAPA is distributed in the hope that it will be useful, |
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
# GNU General Public License for more details. |
|
# |
|
# You should have received a copy of the GNU General Public License |
|
# along with LON-CAPA; if not, write to the Free Software |
|
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
|
# |
|
# /home/httpd/html/adm/gpl.txt |
|
# |
|
# http://www.lon-capa.org/ |
|
# |
|
# YEAR=2002 |
|
# 3/1 Scott Harrison |
|
|
|
# NOTE: I am interspersing the manual procedure with the automation. |
# NOTE: I am interspersing the manual procedure with the automation. |
# To see the manual procedure, do perldoc ./make_domain_coordinator.pl |
# To see the manual procedure, do perldoc ./make_domain_coordinator.pl |
|
|
# This is a standalone script. It *could* alternatively use the |
# This is a standalone script. It *could* alternatively use the |
# lcuseradd script, however lcuseradd relies on certain system |
# lcuseradd script, however lcuseradd relies on certain system |
# dependencies. make_domain_coordinator.pl should be able |
# dependencies. In order to have a focused performance, I am trying |
# to run freely as possible irrespective of the status of a LON-CAPA |
# to avoid system dependencies until the LON-CAPA code base becomes |
|
# more robust and well-boundaried. make_domain_coordinator.pl should be able |
|
# to run freely as possible, irrespective of the status of a LON-CAPA |
# installation. |
# installation. |
|
|
# ---------------------------------------------------- Configure general values |
# ---------------------------------------------------- Configure general values |
|
|
my %perlvar; |
use lib '/home/httpd/lib/perl/'; |
$perlvar{'lonUsersDir'}='/home/httpd/lonUsers'; |
use LONCAPA; |
|
use LONCAPA::lonmetadata; |
|
use Term::ReadKey; |
|
use Apache::lonnet; |
|
use Apache::lonlocal; |
|
use DBI; |
|
use strict; |
|
|
=pod |
=pod |
|
|
Line 97 There are no flags to this script.
|
Line 106 There are no flags to this script.
|
|
|
usage: make_domain_coordinator.pl [USERNAME] [DOMAIN] |
usage: make_domain_coordinator.pl [USERNAME] [DOMAIN] |
|
|
The password is accepted through standard input. |
The password is accepted through standard input |
|
and should only consist of printable ASCII |
|
characters and be a string of length greater than 5 characters. |
|
|
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 password for the domain |
The second argument specifies the domain of the computer |
coordinator and should only consist of printable ASCII |
coordinator. |
characters and be a string of length greater than 5 characters. |
|
|
|
=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.'). |
|
"\n".&mt('It should not be 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"); |
|
exit; |
} |
} |
my ($username,$domain)=(@ARGV); shift @ARGV; shift @ARGV; |
my ($username,$domain)=(@ARGV); |
unless ($username=~/^\w+$/ and $username!~/\_/) { |
if ($username=~/$LONCAPA::not_username_re/) { |
die 'Username '.$username.' must consist only of alphanumeric characters'. |
print(&mt('**** ERROR **** Username [_1] must consist only of - . and alphanumeric characters.',$username)."\n"); |
"\n"; |
exit; |
} |
} |
unless ($domain=~/^\w+$/ and $domain!~/\_/) { |
if ($domain=~/$LONCAPA::not_domain_re/) { |
die 'Domain '.$domain.' must consist only of alphanumeric characters'. |
print(&mt('**** ERROR **** Domain [_1] must consist only of - . and alphanumeric characters.',$domain)."\n"); |
"\n"; |
exit; |
} |
} |
|
|
my $passwd=<>; # read in password from standard input |
# Does user already exist |
chomp($passwd); |
my ($is_user,$has_lc_account); |
|
|
if (length($passwd)<6 or length($passwd)>30) { |
my $udpath=&propath($domain,$username); |
die 'Password is an unreasonable length.'."\n"; |
if (-d $udpath) { |
} |
$has_lc_account = 1; |
my $pbad=0; |
|
foreach (split(//,$passwd)) {if ((ord($_)<32)||(ord($_)>126)){$pbad=1;}} |
|
if ($pbad) { |
|
die 'Password must consist of standard ASCII characters'."\n"; |
|
} |
} |
|
|
# And does user already exist |
if ($has_lc_account) { |
|
print(&mt('**** ERROR **** [_1] is already defined as a LON-CAPA user.', |
|
$username)."\n\n". |
|
&mt('To assign a domain coordinator role to an existing user, use: [_1]', |
|
"\n".'perl add_domain_coordinator_privilege.pl')."\n\n"); |
|
exit; |
|
} |
|
|
if (-d "/home/$username") { |
if (-d "/home/$username") { |
die ($username.' is already a linux operating system user.'."\n"); |
$is_user = 1; |
} |
} |
my $udpath=propath($domain,$username); |
|
if (-d $udpath) { |
if ($is_user) { |
die ($username.' is already defined as a LON-CAPA user.'."\n"); |
print(&mt('**** ERROR **** [_1] is already a linux operating system user.', |
|
$username)."\n\n". |
|
&mt('This script will only automatically generate new users.')."\n". |
|
&mt('To assign a domain coordinator role to an existing user:')."\n\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". |
|
&mt('To view the documentation for this script, type: [_1].', |
|
"\n".'perldoc ./make_domain_coordinator.pl')."\n\n"); |
|
exit; |
|
} |
|
|
|
# Output a warning message. |
|
print(&mt('**** NOTE **** Generating a domain coordinator is "serious business".')."\n". |
|
&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(//,$passwd)) {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 ++; |
|
} |
|
} |
|
if (!$got_passwd) { |
|
exit; |
|
} |
|
print "\n"; |
|
|
=pod |
=pod |
|
|
=head1 MANUAL PROCEDURE |
=head1 MANUAL PROCEDURE |
|
|
There are 10 steps to a manual procedure. |
There are 10 steps to manually recreating what this script performs |
|
automatically. |
|
|
You need to decide on three pieces of information |
You need to decide on three pieces of information |
to create a domain coordinator. |
to create a domain coordinator. |
|
|
* USERNAME (kermit, albert, joe, etc) |
* USERNAME (kermit, albert, joe, etc) |
* DOMAIN (should be the same as lonDefDomain in /etc/httpd/conf/access.conf) |
* DOMAIN (should be the same as lonDefDomain in /etc/httpd/conf/loncapa.conf) |
* PASSWORD (don't tell me) |
* PASSWORD (don't tell me) |
|
|
The examples in these instructions will be based |
The examples in these instructions will be based |
Line 181 login as root on your Linux system
|
Line 264 login as root on your Linux system
|
|
|
# ------------------------------------------------------------ So, are we root? |
# ------------------------------------------------------------ So, are we root? |
|
|
if ($< != 0) { |
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 194 if ($< != 0) {
|
Line 278 if ($< != 0) {
|
|
|
=cut |
=cut |
|
|
|
# ----------------------------------------------------------- /usr/sbin/groupadd |
|
# -- Add group |
|
$username=~s/\W//g; # an extra filter, just to be sure |
|
|
|
print(&mt('adding group: [_1]',$username)."\n"); |
|
my $status = system('/usr/sbin/groupadd', $username); |
|
if ($status) { |
|
print(&mt('Error.').' '. |
|
&mt('Something went wrong with the addition of group "[_1]".', |
|
$username)."\n"); |
|
exit; |
|
} |
|
my $gid = getgrnam($username); |
|
|
# ----------------------------------------------------------- /usr/sbin/useradd |
# ----------------------------------------------------------- /usr/sbin/useradd |
|
# -- Add user |
|
|
$username=~s/\W//g; # an extra filter, just to be sure |
print(&mt('adding user: [_1]',$username)."\n"); |
`/usr/sbin/useradd $username`; |
my $status = system('/usr/sbin/useradd','-c','LON-CAPA user','-g',$gid,$username); |
|
if ($status) { |
|
system("/usr/sbin/groupdel $username"); |
|
print(&mt('Error.').' '. |
|
&mt('Something went wrong with the addition of user "[_1]".', |
|
$username)."\n"); |
|
exit; |
|
} |
|
|
|
print(&mt('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(&mt("Putting www in user's group.")."\n"); |
|
if (system('/usr/sbin/usermod','-G',$gl,'www')) { |
|
print(&mt('Error.').' '.&mt('Could not make www a member of the group "[_1]".', |
|
$username)."\n"); |
|
exit; |
|
} |
|
|
|
# Check if home directory exists for user |
|
# If not, create one. |
|
if (!-e "/home/$username") { |
|
if (!mkdir("/home/$username",0710)) { |
|
print(&mt('Error.').' '.&mt('Could not add home directory for "[_1]".', |
|
$username)."\n"); |
|
exit; |
|
} |
|
} |
|
|
|
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 212 $username=~s/\W//g; # an extra filter, j
|
Line 350 $username=~s/\W//g; # an extra filter, j
|
|
|
=cut |
=cut |
|
|
$username=~s/\W//g; # an extra filter, just to be sure |
# Process password (taint-check, then pass to the UNIX passwd command). |
$pbad=0; |
$username =~ s/\W//g; # an extra filter, just to be sure |
|
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; |
|
if (open(PIPE,"perl distprobe|")) { |
|
$distro = <PIPE>; |
|
close(PIPE); |
|
} |
|
if ($distro =~ /^ubuntu|debian/) { |
|
open(OUT,"|usermod -p `mkpasswd $passwd` $username"); |
|
close(OUT); |
|
} else { |
|
open(OUT,"|passwd --stdin $username"); |
|
print(OUT $passwd."\n"); |
|
close(OUT); |
} |
} |
open OUT,"|passwd --stdin $username"; |
|
print OUT $passwd."\n"; |
|
close OUT; |
|
|
|
=pod |
=pod |
|
|
Line 241 close OUT;
|
Line 392 close OUT;
|
Let S equal second letter of USERNAME |
Let S equal second letter of USERNAME |
Let E equal third letter of USERNAME |
Let E equal third letter of USERNAME |
Command: [prompt %] install -d DOMAIN/U/S/E/USERNAME |
Command: [prompt %] install -d DOMAIN/U/S/E/USERNAME |
Example: [prompt %] install -d 103/d/c/1/dc103 |
|
|
Here are three examples of the commands that would be needed |
|
for different domain coordinator names (dc103, morphy, or ng): |
|
|
|
Example #1 (dc103): [prompt %] install -d 103/d/c/1/dc103 |
|
Example #2 (morphy): [prompt %] install -d 103/m/o/r/morphy |
|
Example #3 (ng): [prompt %] install -d 103/n/g/_/ng |
|
|
=cut |
=cut |
|
|
`install -o www -g www -d $udpath`; |
# Generate the user directory. |
|
`install -o www -g www -d $udpath`; # Must be writeable by httpd process. |
|
|
=pod |
=pod |
|
|
Line 260 close OUT;
|
Line 418 close OUT;
|
|
|
=cut |
=cut |
|
|
open OUT, ">$udpath/passwd"; |
# UNIX (/etc/passwd) style authentication is asserted for domain coordinators. |
print OUT 'unix:'."\n"; |
open(OUT, ">$udpath/passwd"); |
close OUT; |
print(OUT 'unix:'."\n"); |
`chown www:www $udpath/passwd`; |
close(OUT); |
|
|
|
# Get permissions correct on udpath |
|
|
|
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. |
|
|
=pod |
=pod |
|
|
Line 274 close OUT;
|
Line 438 close OUT;
|
|
|
=cut |
=cut |
|
|
use GDBM_File; |
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); |
if (!$rolesref) { |
|
print(&mt('Error').' '. |
$hash{'/'.$domain.'/_dc'}='dc'; |
&mt('unable to tie roles db: [_1]'."$udpath/roles.db")."\n"); |
open OUT, ">$udpath/roles.hist"; |
exit; |
map { |
} |
print OUT $_.' : '.$hash{$_}."\n"; |
my $now = time; |
} keys %hash; |
$rolesref->{'/'.$domain.'/_dc'}='dc_0_'.$now; # Set the domain coordinator role. |
close OUT; |
open(OUT, ">$udpath/roles.hist"); # roles.hist is the synchronous plain text. |
|
foreach my $key (keys(%{$rolesref})) { |
untie %hash; |
print(OUT $key.' : '.$rolesref->{$key}."\n"); |
`chown www:www $udpath/roles.hist`; |
} |
`chown www:www $udpath/roles.db`; |
close(OUT); |
|
&LONCAPA::locking_hash_untie($rolesref); |
|
|
|
|
|
`chown www:www $udpath/roles.hist`; # 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) { |
|
print(&mt('Error').' '.&mt('unable to tie nohist_domainroles db: [_1].', |
|
"$dompath/nohist_domainroles.db")."\n"); |
|
} |
|
|
|
# Store in nohist_domainroles.db |
|
my $domkey=&LONCAPA::escape('dc:'.$username.':'.$domain.'::'.$domain.':'); |
|
$domrolesref->{$domkey}= &LONCAPA::escape('0:'.$now); |
|
&LONCAPA::locking_hash_untie($domrolesref); |
|
|
|
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"); |
|
|
|
#Update allusers MySQL table |
|
|
|
print(&mt('Adding new user to allusers table.')."\n"); |
|
&allusers_update($username,$domain,\%perlvar); |
|
|
=pod |
=pod |
|
|
Line 299 by going to http://MACHINENAME/adm/creat
|
Line 490 by going to http://MACHINENAME/adm/creat
|
|
|
=cut |
=cut |
|
|
print "$username is now a domain coordinator\n"; |
# Output success message, and inform sysadmin about how to further proceed. |
my $hostname=`hostname`; chomp $hostname; |
print("\n".&mt('[_1] is now a domain coordinator',$username)."\n"); # Output success message. |
print "http://$hostname/adm/createuser will allow you to further define". |
my $hostname=`hostname`; chomp($hostname); # Read in hostname. |
" this user.\n"; |
print("\n". |
|
&mt('Once LON-CAPA is running, you should log-in and use: [_1] to further define this user.', |
|
"\nhttp://$hostname/adm/createuser\n")."\n\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. |
|
|
|
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(&mt('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(&mt('Failed to create [_1] table.','allusers')."\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; |
|
} |
|
|
|
sub allusers_table_exists { |
|
my ($dbh) = @_; |
|
my $sth=$dbh->prepare('SHOW TABLES'); |
|
$sth->execute(); |
|
my $aref = $sth->fetchall_arrayref; |
|
$sth->finish(); |
|
if ($sth->err()) { |
|
return undef; |
|
} |
|
my $result = 0; |
|
foreach my $table (@{$aref}) { |
|
if ($table->[0] eq 'allusers') { |
|
$result = 1; |
|
last; |
|
} |
|
} |
|
return $result; |
|
} |
|
|
# ----------------------------------------------------------------- SUBROUTINES |
sub get_password { |
sub propath { |
my ($prompt) = @_; |
my ($udom,$uname)=@_; |
local $| = 1; |
$udom=~s/\W//g; |
print $prompt.': '; |
$uname=~s/\W//g; |
my $newpasswd = ''; |
my $subdir=$uname.'__'; |
ReadMode 'raw'; |
$subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/; |
my $key; |
my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname"; |
while(ord($key = ReadKey(0)) != 10) { |
return $proname; |
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; |
} |
} |
|
|
=pod |
=pod |
|
|
AUTHOR |
=head1 AUTHOR |
|
|
Scott Harrison, harris41@msu.edu |
Written to help the LON-CAPA project. |
|
|
=cut |
=cut |
|
|