Annotation of loncom/build/make_domain_coordinator.pl, revision 1.28
1.1 harris41 1: #!/usr/bin/perl
2:
3: =pod
4:
5: =head1 NAME
6:
7: make_domain_coordinator.pl - Make a domain coordinator on a LON-CAPA system
8:
1.2 harris41 9: =cut
10:
11: # The LearningOnline Network
12: # make_domain_coordinator.pl - Make a domain coordinator on a system
13: #
1.28 ! raeburn 14: # $Id: make_domain_coordinator.pl,v 1.27 2015/01/03 02:45:22 raeburn Exp $
1.2 harris41 15: #
16: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
17: #
18: # LON-CAPA is free software; you can redistribute it and/or modify
19: # it under the terms of the GNU General Public License as published by
20: # the Free Software Foundation; either version 2 of the License, or
21: # (at your option) any later version.
22: #
23: # LON-CAPA is distributed in the hope that it will be useful,
24: # but WITHOUT ANY WARRANTY; without even the implied warranty of
25: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
26: # GNU General Public License for more details.
27: #
28: # You should have received a copy of the GNU General Public License
29: # along with LON-CAPA; if not, write to the Free Software
30: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
31: #
32: # /home/httpd/html/adm/gpl.txt
33: #
34: # http://www.lon-capa.org/
35: #
36: ###
37:
38: =pod
39:
1.1 harris41 40: =head1 DESCRIPTION
41:
42: Automates the steps for domain coordinator creation. This
43: program also describes a manual procedure (see below).
44:
45: These are the steps that are executed on the linux operating system:
46:
47: =over 4
48:
49: =item *
50:
51: Tests to see if user already exists for linux system or for
1.7 harris41 52: LON-CAPA, if so aborts. A message is output that recommends following
53: a manual procedure enabling this user if so desired.
1.1 harris41 54:
55: =item *
56:
57: Creates a linux system user
58:
59: =item *
60:
61: Sets password
62:
63: =item *
64:
65: Creates a LON-CAPA lonUsers directory for user
66:
67: =item *
68:
69: Sets LON-CAPA password mechanism to be "unix"
70:
71: =item *
72:
73: Set roles.hist and roles.db
74:
75: =back
76:
77: =cut
78:
79: # NOTE: I am interspersing the manual procedure with the automation.
80: # To see the manual procedure, do perldoc ./make_domain_coordinator.pl
81:
82: # This is a standalone script. It *could* alternatively use the
83: # lcuseradd script, however lcuseradd relies on certain system
1.7 harris41 84: # dependencies. In order to have a focused performance, I am trying
85: # to avoid system dependencies until the LON-CAPA code base becomes
86: # more robust and well-boundaried. make_domain_coordinator.pl should be able
87: # to run freely as possible, irrespective of the status of a LON-CAPA
1.1 harris41 88: # installation.
89:
90: # ---------------------------------------------------- Configure general values
91:
1.10 albertel 92: use lib '/home/httpd/lib/perl/';
93: use LONCAPA;
1.13 raeburn 94: use LONCAPA::lonmetadata;
1.18 raeburn 95: use Term::ReadKey;
96: use Apache::lonnet;
97: use Apache::lonlocal;
1.13 raeburn 98: use DBI;
1.22 raeburn 99: use Storable qw(nfreeze);
1.28 ! raeburn 100: use Sys::Hostname::FQDN();
1.20 raeburn 101: use strict;
1.1 harris41 102:
103: =pod
104:
105: =head1 OPTIONS
106:
107: There are no flags to this script.
108:
109: usage: make_domain_coordinator.pl [USERNAME] [DOMAIN]
110:
1.3 harris41 111: The password is accepted through standard input
112: and should only consist of printable ASCII
113: characters and be a string of length greater than 5 characters.
1.1 harris41 114:
115: The first argument
116: specifies the user name of the domain coordinator and
117: should consist of only alphanumeric characters.
1.8 harris41 118: It is recommended that the USERNAME should be institution-specific
119: as opposed to something like "Sammy" or "Jo".
120: For example, "dcmsu" or "dcumich" would be good domain coordinator
121: USERNAMEs for places like Mich State Univ, etc.
1.1 harris41 122:
1.3 harris41 123: The second argument specifies the domain of the computer
1.12 albertel 124: coordinator.
1.1 harris41 125:
126: =cut
127:
1.18 raeburn 128: my $lang = &Apache::lonlocal::choose_language();
129: &Apache::lonlocal::get_language_handle(undef,$lang);
130: print"\n";
131:
1.1 harris41 132: # ----------------------------------------------- So, are we invoked correctly?
133: # Two arguments or abort
134: if (@ARGV!=2) {
1.18 raeburn 135: print(&mt('usage: [_1]','make_domain_coordinator.pl [USERNAME] [DOMAIN]')."\n\n".
136: &mt('It is recommended that the USERNAME should be institution-specific.').
137: "\n".&mt('It should not be something like "Sammy" or "Jo".')."\n".
138: &mt('For example, [_1] or [_2] would be good domain coordinator USERNAMEs for places like Michigan State University, etc.','"domcoordmsu"','"dcmichstate"')."\n");
139: exit;
1.1 harris41 140: }
1.18 raeburn 141: my ($username,$domain)=(@ARGV);
1.12 albertel 142: if ($username=~/$LONCAPA::not_username_re/) {
1.18 raeburn 143: print(&mt('**** ERROR **** Username [_1] must consist only of - . and alphanumeric characters.',$username)."\n");
144: exit;
1.1 harris41 145: }
1.12 albertel 146: if ($domain=~/$LONCAPA::not_domain_re/) {
1.18 raeburn 147: print(&mt('**** ERROR **** Domain [_1] must consist only of - . and alphanumeric characters.',$domain)."\n");
148: exit;
149: }
150:
151: # Does user already exist
152: my ($is_user,$has_lc_account);
153:
154: my $udpath=&propath($domain,$username);
155: if (-d $udpath) {
156: $has_lc_account = 1;
1.1 harris41 157: }
158:
1.18 raeburn 159: if ($has_lc_account) {
160: print(&mt('**** ERROR **** [_1] is already defined as a LON-CAPA user.',
161: $username)."\n\n".
162: &mt('To assign a domain coordinator role to an existing user, use: [_1]',
163: "\n".'perl add_domain_coordinator_privilege.pl')."\n\n");
164: exit;
1.1 harris41 165: }
1.18 raeburn 166:
167: if (-d "/home/$username") {
168: $is_user = 1;
1.1 harris41 169: }
170:
1.19 raeburn 171: if ($is_user) {
1.18 raeburn 172: print(&mt('**** ERROR **** [_1] is already a linux operating system user.',
173: $username)."\n\n".
174: &mt('This script will only automatically generate new users.')."\n".
175: &mt('To assign a domain coordinator role to an existing user:')."\n\n".
176: &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".
177: &mt('To view the documentation for this script, type: [_1].',
178: "\n".'perldoc ./make_domain_coordinator.pl')."\n\n");
179: exit;
180: }
1.1 harris41 181:
1.18 raeburn 182: # Output a warning message.
183: print(&mt('**** NOTE **** Generating a domain coordinator is "serious business".')."\n".
184: &mt('You must choose a password that is difficult to guess.')."\n");
1.7 harris41 185:
1.18 raeburn 186: print(&mt('Continue? ~[Y/n~] '));
187: my $go_on = <STDIN>;
188: chomp($go_on);
189: $go_on =~ s/(^\s+|\s+$)//g;
190: my $yes = &mt('y');
191: unless (($go_on eq '') || ($go_on =~ /^\Q$yes\E/i)) {
192: exit;
193: }
194: print "\n";
195:
1.20 raeburn 196: my ($got_passwd,$firstpass,$secondpass,$passwd);
1.18 raeburn 197: my $maxtries = 10;
198: my $trial = 0;
199: while ((!$got_passwd) && ($trial < $maxtries)) {
200: $firstpass = &get_password(&mt('Enter password'));
201: if (length($firstpass) < 6) {
202: print(&mt('Password too short.')."\n".
203: &mt('Please choose a password with at least six characters.')."\n".
1.20 raeburn 204: &mt('Please try again.')."\n");
1.18 raeburn 205: } elsif (length($firstpass) > 30) {
206: print(&mt('Password too long.')."\n".
207: &mt('Please choose a password with no more than thirty characters.')."\n".
1.20 raeburn 208: &mt('Please try again.')."\n");
1.18 raeburn 209: } else {
210: my $pbad=0;
1.21 raeburn 211: foreach (split(//,$firstpass)) {if ((ord($_)<32)||(ord($_)>126)){$pbad=1;}}
1.18 raeburn 212: if ($pbad) {
213: print(&mt('Password contains invalid characters.')."\n".
1.24 raeburn 214: &mt('Password must consist of standard ASCII characters.')."\n".
1.18 raeburn 215: &mt('Please try again.')."\n");
216: } else {
217: $secondpass = &get_password(&mt('Enter password a second time'));
218: if ($firstpass eq $secondpass) {
219: $got_passwd = 1;
220: $passwd = $firstpass;
221: } else {
222: print(&mt('Passwords did not match.')."\n".
223: &mt('Please try again.')."\n");
224: }
225: }
226: $trial ++;
227: }
1.1 harris41 228: }
1.18 raeburn 229: if (!$got_passwd) {
230: exit;
1.1 harris41 231: }
1.18 raeburn 232: print "\n";
1.1 harris41 233:
234: =pod
235:
236: =head1 MANUAL PROCEDURE
237:
1.7 harris41 238: There are 10 steps to manually recreating what this script performs
239: automatically.
1.1 harris41 240:
241: You need to decide on three pieces of information
242: to create a domain coordinator.
243:
244: * USERNAME (kermit, albert, joe, etc)
1.6 harris41 245: * DOMAIN (should be the same as lonDefDomain in /etc/httpd/conf/loncapa.conf)
1.1 harris41 246: * PASSWORD (don't tell me)
247:
248: The examples in these instructions will be based
249: on three example pieces of information:
250:
251: * USERNAME=dc103
252: * DOMAIN=103
253: * PASSWORD=sesame
254:
255: You will also need to know your "root" password
256: and your "www" password.
257:
258: =over 4
259:
260: =item 1.
261:
262: login as root on your Linux system
263: [prompt %] su
264:
265: =cut
266:
267: # ------------------------------------------------------------ So, are we root?
268:
1.7 harris41 269: if ($< != 0) { # Am I root?
1.18 raeburn 270: print(&mt('You must be root in order to generate a domain coordinator.').
271: "\n");
1.1 harris41 272: }
273:
274: =pod
275:
276: =item 2 (as root). add the user
277:
278: Command: [prompt %] /usr/sbin/useradd USERNAME
279: Example: [prompt %] /usr/sbin/useradd dc103
280:
281: =cut
282:
1.11 raeburn 283: # ----------------------------------------------------------- /usr/sbin/groupadd
284: # -- Add group
285: $username=~s/\W//g; # an extra filter, just to be sure
286:
1.18 raeburn 287: print(&mt('adding group: [_1]',$username)."\n");
1.11 raeburn 288: my $status = system('/usr/sbin/groupadd', $username);
289: if ($status) {
1.18 raeburn 290: print(&mt('Error.').' '.
291: &mt('Something went wrong with the addition of group "[_1]".',
292: $username)."\n");
293: exit;
1.11 raeburn 294: }
295: my $gid = getgrnam($username);
296:
1.1 harris41 297: # ----------------------------------------------------------- /usr/sbin/useradd
1.11 raeburn 298: # -- Add user
1.1 harris41 299:
1.18 raeburn 300: print(&mt('adding user: [_1]',$username)."\n");
1.11 raeburn 301: my $status = system('/usr/sbin/useradd','-c','LON-CAPA user','-g',$gid,$username);
302: if ($status) {
303: system("/usr/sbin/groupdel $username");
1.18 raeburn 304: print(&mt('Error.').' '.
305: &mt('Something went wrong with the addition of user "[_1]".',
306: $username)."\n");
307: exit;
1.11 raeburn 308: }
309:
1.18 raeburn 310: print(&mt('Done adding user.')."\n");
1.11 raeburn 311: # Make www a member of that user group.
312: my $groups=`/usr/bin/groups www`;
313: # untaint
314: my ($safegroups)=($groups=~/:\s*([\s\w]+)/);
315: $groups=$safegroups;
316: chomp $groups; $groups=~s/^\S+\s+\:\s+//;
317: my @grouplist=split(/\s+/,$groups);
318: my @ugrouplist=grep {!/www|$username/} @grouplist;
319: my $gl=join(',',(@ugrouplist,$username));
1.18 raeburn 320: print(&mt("Putting www in user's group.")."\n");
1.11 raeburn 321: if (system('/usr/sbin/usermod','-G',$gl,'www')) {
1.18 raeburn 322: print(&mt('Error.').' '.&mt('Could not make www a member of the group "[_1]".',
323: $username)."\n");
324: exit;
1.11 raeburn 325: }
326:
327: # Check if home directory exists for user
328: # If not, create one.
329: if (!-e "/home/$username") {
330: if (!mkdir("/home/$username",0710)) {
1.18 raeburn 331: print(&mt('Error.').' '.&mt('Could not add home directory for "[_1]".',
332: $username)."\n");
333: exit;
1.11 raeburn 334: }
335: }
1.1 harris41 336:
1.11 raeburn 337: if (-d "/home/$username") {
338: system('/bin/chown',"$username:$username","/home/$username");
339: system('/bin/chmod','-R','0660',"/home/$username");
340: system('/bin/chmod','0710',"/home/$username");
341: }
1.1 harris41 342: =pod
343:
344: =item 3 (as root). enter in a password
345:
346: Command: [prompt %] passwd USERNAME
347: New UNIX password: PASSWORD
348: Retype new UNIX passwd: PASSWORD
349: Example: [prompt %] passwd dc103
350: New UNIX password: sesame
351: Retype new UNIX passwd: sesame
352:
353: =cut
354:
1.7 harris41 355: # Process password (taint-check, then pass to the UNIX passwd command).
356: $username =~ s/\W//g; # an extra filter, just to be sure
1.20 raeburn 357: my $pbad = 0;
1.1 harris41 358: foreach (split(//,$passwd)) {if ((ord($_)<32)||(ord($_)>126)){$pbad=1;}}
359: if ($pbad) {
1.18 raeburn 360: print(&mt('Password must consist of standard ASCII characters.').
361: "\n");
1.1 harris41 362: }
1.16 raeburn 363:
1.26 raeburn 364: my ($distro,$nostdin);
1.16 raeburn 365: if (open(PIPE,"perl distprobe|")) {
366: $distro = <PIPE>;
367: close(PIPE);
368: }
369: if ($distro =~ /^ubuntu|debian/) {
1.26 raeburn 370: $nostdin = 1;
371: } elsif ($distro =~ /^suse([\d.]+)$/) {
372: if ($1 > 12.2) {
373: $nostdin = 1;
374: }
1.27 raeburn 375: } elsif ($distro =~ /^sles(\d+)$/) {
376: if ($1 > 11) {
377: $nostdin = 1;
378: }
1.26 raeburn 379: }
380: if ($nostdin) {
1.16 raeburn 381: open(OUT,"|usermod -p `mkpasswd $passwd` $username");
382: close(OUT);
1.26 raeburn 383: } else {
1.16 raeburn 384: open(OUT,"|passwd --stdin $username");
385: print(OUT $passwd."\n");
386: close(OUT);
387: }
1.1 harris41 388:
389: =pod
390:
391: =cut
392:
393: =pod
394:
395: =item 4. login as user=www
396:
397: Command: [prompt %] su www
398: Password: WWWPASSWORD
399:
400: =item 5. (as www). cd /home/httpd/lonUsers
401:
402: =item 6. (as www) Create user directory for your new user.
403:
404: Let U equal first letter of USERNAME
405: Let S equal second letter of USERNAME
406: Let E equal third letter of USERNAME
407: Command: [prompt %] install -d DOMAIN/U/S/E/USERNAME
1.7 harris41 408:
409: Here are three examples of the commands that would be needed
410: for different domain coordinator names (dc103, morphy, or ng):
411:
412: Example #1 (dc103): [prompt %] install -d 103/d/c/1/dc103
413: Example #2 (morphy): [prompt %] install -d 103/m/o/r/morphy
414: Example #3 (ng): [prompt %] install -d 103/n/g/_/ng
1.1 harris41 415:
416: =cut
417:
1.7 harris41 418: # Generate the user directory.
419: `install -o www -g www -d $udpath`; # Must be writeable by httpd process.
1.1 harris41 420:
421: =pod
422:
423: =item 7. (as www) Enter the newly created user directory.
424:
425: Command: [prompt %] cd DOMAIN/U/S/E/USERNAME
426: Example: [prompt %] cd 103/d/c/1/dc103
427:
428: =item 8. (as www). Set your password mechanism to 'unix'
429:
430: Command: [prompt %] echo "unix:" > passwd
431:
432: =cut
433:
1.7 harris41 434: # UNIX (/etc/passwd) style authentication is asserted for domain coordinators.
435: open(OUT, ">$udpath/passwd");
436: print(OUT 'unix:'."\n");
437: close(OUT);
1.15 www 438:
439: # Get permissions correct on udpath
440:
1.18 raeburn 441: print(&mt('Setting permissions on user data directories.').' '.
442: &mt('This may take a moment, please be patient ...')."\n");
1.15 www 443: `chown -R www:www /home/httpd/lonUsers/$domain` ; # Must be writeable by httpd process.
1.1 harris41 444:
445: =pod
446:
447: =item 9. (as www). Run CVS:loncapa/doc/rolesmanip.pl:
448:
449: Command: [prompt %] perl rolesmanip.pl DOMAIN USERNAME
450: Example: [prompt %] perl rolesmanip.pl 103 dc103
451:
452: =cut
453:
1.7 harris41 454: use GDBM_File; # A simplistic key-value pairing database.
1.1 harris41 455:
1.10 albertel 456: my $rolesref=&LONCAPA::locking_hash_tie("$udpath/roles.db",&GDBM_WRCREAT());
457: if (!$rolesref) {
1.18 raeburn 458: print(&mt('Error').' '.
1.24 raeburn 459: &mt('unable to tie roles db: [_1].',"$udpath/roles.db")."\n");
1.18 raeburn 460: exit;
1.10 albertel 461: }
1.13 raeburn 462: my $now = time;
463: $rolesref->{'/'.$domain.'/_dc'}='dc_0_'.$now; # Set the domain coordinator role.
1.7 harris41 464: open(OUT, ">$udpath/roles.hist"); # roles.hist is the synchronous plain text.
1.10 albertel 465: foreach my $key (keys(%{$rolesref})) {
466: print(OUT $key.' : '.$rolesref->{$key}."\n");
467: }
1.7 harris41 468: close(OUT);
1.10 albertel 469: &LONCAPA::locking_hash_untie($rolesref);
470:
1.1 harris41 471:
1.7 harris41 472: `chown www:www $udpath/roles.hist`; # Must be writeable by httpd process.
473: `chown www:www $udpath/roles.db`; # Must be writeable by httpd process.
1.1 harris41 474:
1.13 raeburn 475: my %perlvar = %{&LONCAPA::Configuration::read_conf('loncapa.conf')};
476: my $dompath = $perlvar{'lonUsersDir'}.'/'.$domain;
477: my $domrolesref = &LONCAPA::locking_hash_tie("$dompath/nohist_domainroles.db",&GDBM_WRCREAT());
478:
479: if (!$domrolesref) {
1.18 raeburn 480: print(&mt('Error').' '.&mt('unable to tie nohist_domainroles db: [_1].',
481: "$dompath/nohist_domainroles.db")."\n");
1.13 raeburn 482: }
483:
484: # Store in nohist_domainroles.db
485: my $domkey=&LONCAPA::escape('dc:'.$username.':'.$domain.'::'.$domain.':');
486: $domrolesref->{$domkey}= &LONCAPA::escape('0:'.$now);
487: &LONCAPA::locking_hash_untie($domrolesref);
488:
1.14 raeburn 489: system('/bin/chown',"www:www","$dompath/nohist_domainroles.db"); # Must be writeable by httpd process.
490: system('/bin/chown',"www:www","$dompath/nohist_domainroles.db.lock");
491:
1.22 raeburn 492: # Log with domainconfiguser in nohist_rolelog.db
493: my $domconfiguser = $domain.'-domainconfig';
494: my $subdir = $domconfiguser;
495: $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
1.23 raeburn 496: $subdir .= "/$domconfiguser";
1.22 raeburn 497:
1.23 raeburn 498: if (-d "$dompath/$subdir") {
499: my $rolelogref = &LONCAPA::locking_hash_tie("$dompath/$subdir/nohist_rolelog.db",&GDBM_WRCREAT());
500: my $domlogkey = &LONCAPA::escape($now.'00000'.$$.'000000');
501: my $storehash = {
502: role => 'dc',
503: start => $now,
504: end => 0,
505: context => 'server',
506: };
507: my $domlogvalue = {
508: 'exe_uname' => '',
509: 'exe_udom' => $domain,
510: 'exe_time' => $now,
511: 'exe_ip' => '127.0.0.1',
512: 'delflag' => '',
513: 'logentry' => $storehash,
514: 'uname' => $username,
515: 'udom' => $domain,
516: };
517: $rolelogref->{$domlogkey}=&freeze_escape($domlogvalue);
518: &LONCAPA::locking_hash_untie($rolelogref);
1.22 raeburn 519:
1.23 raeburn 520: system('/bin/chown',"www:www","$dompath/$subdir/nohist_rolelog.db"); # Must be writeable by httpd process.
521: system('/bin/chown',"www:www","$dompath/$subdir/nohist_rolelog.db.lock");
522: } else {
523: print(&mt('Failed to log role creation as the path to the directory: "[_1]" does not exist.',"$dompath/$subdir/")."\n".
524: &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).'));
525: }
1.22 raeburn 526:
1.13 raeburn 527: #Update allusers MySQL table
528:
1.18 raeburn 529: print(&mt('Adding new user to allusers table.')."\n");
1.13 raeburn 530: &allusers_update($username,$domain,\%perlvar);
531:
1.1 harris41 532: =pod
533:
534: =item 10.
535:
536: You may further define the domain coordinator user (i.e. dc103)
537: by going to http://MACHINENAME/adm/createuser.
538:
539: =cut
540:
1.7 harris41 541: # Output success message, and inform sysadmin about how to further proceed.
1.18 raeburn 542: print("\n".&mt('[_1] is now a domain coordinator',$username)."\n"); # Output success message.
1.28 ! raeburn 543: my $hostname = Sys::Hostname::FQDN::fqdn(); # Read in hostname.
1.18 raeburn 544: print("\n".
545: &mt('Once LON-CAPA is running, you should log-in and use: [_1] to further define this user.',
546: "\nhttp://$hostname/adm/createuser\n")."\n\n".
547: &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");
1.13 raeburn 548: # Output a suggested URL.
549:
550: sub allusers_update {
551: my ($username,$domain,$perlvar) = @_;
552: my %tablenames = (
553: 'allusers' => 'allusers',
554: );
555: my $dbh;
556: unless ($dbh = DBI->connect("DBI:mysql:loncapa","www",
557: $perlvar->{'lonSqlAccess'},
558: { RaiseError =>0,PrintError=>0})) {
1.18 raeburn 559: print(&mt('Cannot connect to database!')."\n");
1.13 raeburn 560: return;
561: }
562: my $tablechk = &allusers_table_exists($dbh);
563: if ($tablechk == 0) {
564: my $request =
565: &LONCAPA::lonmetadata::create_metadata_storage('allusers','allusers');
566: $dbh->do($request);
567: if ($dbh->err) {
1.18 raeburn 568: print(&mt('Failed to create [_1] table.','allusers')."\n");
1.13 raeburn 569: return;
570: }
571: }
572: my %userdata = (
573: username => $username,
574: domain => $domain,
575: );
576: my %loghash =
577: &LONCAPA::lonmetadata::process_allusers_data($dbh,undef,
578: \%tablenames,$username,$domain,\%userdata,'update');
579: foreach my $key (keys(%loghash)) {
580: print $loghash{$key}."\n";
581: }
582: return;
583: }
584:
585: sub allusers_table_exists {
586: my ($dbh) = @_;
587: my $sth=$dbh->prepare('SHOW TABLES');
588: $sth->execute();
589: my $aref = $sth->fetchall_arrayref;
590: $sth->finish();
591: if ($sth->err()) {
592: return undef;
593: }
594: my $result = 0;
595: foreach my $table (@{$aref}) {
596: if ($table->[0] eq 'allusers') {
597: $result = 1;
598: last;
599: }
600: }
601: return $result;
602: }
1.1 harris41 603:
1.18 raeburn 604: sub get_password {
605: my ($prompt) = @_;
606: local $| = 1;
607: print $prompt.': ';
608: my $newpasswd = '';
609: ReadMode 'raw';
610: my $key;
611: while(ord($key = ReadKey(0)) != 10) {
612: if(ord($key) == 127 || ord($key) == 8) {
613: chop($newpasswd);
614: print "\b \b";
615: } elsif(!ord($key) < 32) {
616: $newpasswd .= $key;
617: print '*';
618: }
619: }
620: ReadMode 'normal';
621: print "\n";
622: return $newpasswd;
623: }
624:
1.22 raeburn 625: sub freeze_escape {
626: my ($value)=@_;
627: if (ref($value)) {
628: $value=&nfreeze($value);
629: return '__FROZEN__'.&LONCAPA::escape($value);
630: }
631: return &LONCAPA::escape($value);
632: }
633:
1.1 harris41 634: =pod
635:
1.2 harris41 636: =head1 AUTHOR
1.1 harris41 637:
1.7 harris41 638: Written to help the LON-CAPA project.
1.1 harris41 639:
640: =cut
1.13 raeburn 641:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to make_domain_coordinator.pl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / build