Annotation of loncom/build/make_domain_coordinator.pl, revision 1.18
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.18 ! raeburn 14: # $Id: make_domain_coordinator.pl,v 1.17 2009/07/17 22:23:59 droeschl 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.1 harris41 99:
100: =pod
101:
102: =head1 OPTIONS
103:
104: There are no flags to this script.
105:
106: usage: make_domain_coordinator.pl [USERNAME] [DOMAIN]
107:
1.3 harris41 108: The password is accepted through standard input
109: and should only consist of printable ASCII
110: characters and be a string of length greater than 5 characters.
1.1 harris41 111:
112: The first argument
113: specifies the user name of the domain coordinator and
114: should consist of only alphanumeric characters.
1.8 harris41 115: It is recommended that the USERNAME should be institution-specific
116: as opposed to something like "Sammy" or "Jo".
117: For example, "dcmsu" or "dcumich" would be good domain coordinator
118: USERNAMEs for places like Mich State Univ, etc.
1.1 harris41 119:
1.3 harris41 120: The second argument specifies the domain of the computer
1.12 albertel 121: coordinator.
1.1 harris41 122:
123: =cut
124:
1.18 ! raeburn 125: my ($username,$domain)=(@ARGV);
! 126: my $lang = &Apache::lonlocal::choose_language();
! 127: &Apache::lonlocal::get_language_handle(undef,$lang);
! 128: print"\n";
! 129:
1.1 harris41 130: # ----------------------------------------------- So, are we invoked correctly?
131: # Two arguments or abort
132: if (@ARGV!=2) {
1.18 ! raeburn 133: print(&mt('usage: [_1]','make_domain_coordinator.pl [USERNAME] [DOMAIN]')."\n\n".
! 134: &mt('It is recommended that the USERNAME should be institution-specific.').
! 135: "\n".&mt('It should not be something like "Sammy" or "Jo".')."\n".
! 136: &mt('For example, [_1] or [_2] would be good domain coordinator USERNAMEs for places like Michigan State University, etc.','"domcoordmsu"','"dcmichstate"')."\n");
! 137: exit;
1.1 harris41 138: }
1.18 ! raeburn 139: my ($username,$domain)=(@ARGV);
1.12 albertel 140: if ($username=~/$LONCAPA::not_username_re/) {
1.18 ! raeburn 141: print(&mt('**** ERROR **** Username [_1] must consist only of - . and alphanumeric characters.',$username)."\n");
! 142: exit;
1.1 harris41 143: }
1.12 albertel 144: if ($domain=~/$LONCAPA::not_domain_re/) {
1.18 ! raeburn 145: print(&mt('**** ERROR **** Domain [_1] must consist only of - . and alphanumeric characters.',$domain)."\n");
! 146: exit;
! 147: }
! 148:
! 149: # Does user already exist
! 150: my ($is_user,$has_lc_account);
! 151:
! 152: my $udpath=&propath($domain,$username);
! 153: if (-d $udpath) {
! 154: $has_lc_account = 1;
1.1 harris41 155: }
156:
1.18 ! raeburn 157: if ($has_lc_account) {
! 158: print(&mt('**** ERROR **** [_1] is already defined as a LON-CAPA user.',
! 159: $username)."\n\n".
! 160: &mt('To assign a domain coordinator role to an existing user, use: [_1]',
! 161: "\n".'perl add_domain_coordinator_privilege.pl')."\n\n");
! 162: exit;
1.1 harris41 163: }
1.18 ! raeburn 164:
! 165: if (-d "/home/$username") {
! 166: $is_user = 1;
1.1 harris41 167: }
168:
1.18 ! raeburn 169: if (is_user) {
! 170: print(&mt('**** ERROR **** [_1] is already a linux operating system user.',
! 171: $username)."\n\n".
! 172: &mt('This script will only automatically generate new users.')."\n".
! 173: &mt('To assign a domain coordinator role to an existing user:')."\n\n".
! 174: &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".
! 175: &mt('To view the documentation for this script, type: [_1].',
! 176: "\n".'perldoc ./make_domain_coordinator.pl')."\n\n");
! 177: exit;
! 178: }
1.1 harris41 179:
1.18 ! raeburn 180: # Output a warning message.
! 181: print(&mt('**** NOTE **** Generating a domain coordinator is "serious business".')."\n".
! 182: &mt('You must choose a password that is difficult to guess.')."\n");
1.7 harris41 183:
1.18 ! raeburn 184: print(&mt('Continue? ~[Y/n~] '));
! 185: my $go_on = <STDIN>;
! 186: chomp($go_on);
! 187: $go_on =~ s/(^\s+|\s+$)//g;
! 188: my $yes = &mt('y');
! 189: unless (($go_on eq '') || ($go_on =~ /^\Q$yes\E/i)) {
! 190: exit;
! 191: }
! 192: print "\n";
! 193:
! 194: my ($got_passwd,$firstpass,$secondpass);
! 195: my $maxtries = 10;
! 196: my $trial = 0;
! 197: while ((!$got_passwd) && ($trial < $maxtries)) {
! 198: $firstpass = &get_password(&mt('Enter password'));
! 199: if (length($firstpass) < 6) {
! 200: print(&mt('Password too short.')."\n".
! 201: &mt('Please choose a password with at least six characters.')."\n".
! 202: i &mt('Please try again.')."\n");
! 203: } elsif (length($firstpass) > 30) {
! 204: print(&mt('Password too long.')."\n".
! 205: &mt('Please choose a password with no more than thirty characters.')."\n".
! 206: i &mt('Please try again.')."\n");
! 207: } else {
! 208: my $pbad=0;
! 209: foreach (split(//,$passwd)) {if ((ord($_)<32)||(ord($_)>126)){$pbad=1;}}
! 210: if ($pbad) {
! 211: print(&mt('Password contains invalid characters.')."\n".
! 212: &mt('Password must consist of standard ASCII characters')."\n".
! 213: &mt('Please try again.')."\n");
! 214: } else {
! 215: $secondpass = &get_password(&mt('Enter password a second time'));
! 216: if ($firstpass eq $secondpass) {
! 217: $got_passwd = 1;
! 218: $passwd = $firstpass;
! 219: } else {
! 220: print(&mt('Passwords did not match.')."\n".
! 221: &mt('Please try again.')."\n");
! 222: }
! 223: }
! 224: $trial ++;
! 225: }
1.1 harris41 226: }
1.18 ! raeburn 227: if (!$got_passwd) {
! 228: exit;
1.1 harris41 229: }
1.18 ! raeburn 230: print "\n";
1.1 harris41 231:
232: =pod
233:
234: =head1 MANUAL PROCEDURE
235:
1.7 harris41 236: There are 10 steps to manually recreating what this script performs
237: automatically.
1.1 harris41 238:
239: You need to decide on three pieces of information
240: to create a domain coordinator.
241:
242: * USERNAME (kermit, albert, joe, etc)
1.6 harris41 243: * DOMAIN (should be the same as lonDefDomain in /etc/httpd/conf/loncapa.conf)
1.1 harris41 244: * PASSWORD (don't tell me)
245:
246: The examples in these instructions will be based
247: on three example pieces of information:
248:
249: * USERNAME=dc103
250: * DOMAIN=103
251: * PASSWORD=sesame
252:
253: You will also need to know your "root" password
254: and your "www" password.
255:
256: =over 4
257:
258: =item 1.
259:
260: login as root on your Linux system
261: [prompt %] su
262:
263: =cut
264:
265: # ------------------------------------------------------------ So, are we root?
266:
1.7 harris41 267: if ($< != 0) { # Am I root?
1.18 ! raeburn 268: print(&mt('You must be root in order to generate a domain coordinator.').
! 269: "\n");
1.1 harris41 270: }
271:
272: =pod
273:
274: =item 2 (as root). add the user
275:
276: Command: [prompt %] /usr/sbin/useradd USERNAME
277: Example: [prompt %] /usr/sbin/useradd dc103
278:
279: =cut
280:
1.11 raeburn 281: # ----------------------------------------------------------- /usr/sbin/groupadd
282: # -- Add group
283: $username=~s/\W//g; # an extra filter, just to be sure
284:
1.18 ! raeburn 285: print(&mt('adding group: [_1]',$username)."\n");
1.11 raeburn 286: my $status = system('/usr/sbin/groupadd', $username);
287: if ($status) {
1.18 ! raeburn 288: print(&mt('Error.').' '.
! 289: &mt('Something went wrong with the addition of group "[_1]".',
! 290: $username)."\n");
! 291: exit;
1.11 raeburn 292: }
293: my $gid = getgrnam($username);
294:
1.1 harris41 295: # ----------------------------------------------------------- /usr/sbin/useradd
1.11 raeburn 296: # -- Add user
1.1 harris41 297:
1.18 ! raeburn 298: print(&mt('adding user: [_1]',$username)."\n");
1.11 raeburn 299: my $status = system('/usr/sbin/useradd','-c','LON-CAPA user','-g',$gid,$username);
300: if ($status) {
301: system("/usr/sbin/groupdel $username");
1.18 ! raeburn 302: print(&mt('Error.').' '.
! 303: &mt('Something went wrong with the addition of user "[_1]".',
! 304: $username)."\n");
! 305: exit;
1.11 raeburn 306: }
307:
1.18 ! raeburn 308: print(&mt('Done adding user.')."\n");
1.11 raeburn 309: # Make www a member of that user group.
310: my $groups=`/usr/bin/groups www`;
311: # untaint
312: my ($safegroups)=($groups=~/:\s*([\s\w]+)/);
313: $groups=$safegroups;
314: chomp $groups; $groups=~s/^\S+\s+\:\s+//;
315: my @grouplist=split(/\s+/,$groups);
316: my @ugrouplist=grep {!/www|$username/} @grouplist;
317: my $gl=join(',',(@ugrouplist,$username));
1.18 ! raeburn 318: print(&mt("Putting www in user's group.")."\n");
1.11 raeburn 319: if (system('/usr/sbin/usermod','-G',$gl,'www')) {
1.18 ! raeburn 320: print(&mt('Error.').' '.&mt('Could not make www a member of the group "[_1]".',
! 321: $username)."\n");
! 322: exit;
1.11 raeburn 323: }
324:
325: # Check if home directory exists for user
326: # If not, create one.
327: if (!-e "/home/$username") {
328: if (!mkdir("/home/$username",0710)) {
1.18 ! raeburn 329: print(&mt('Error.').' '.&mt('Could not add home directory for "[_1]".',
! 330: $username)."\n");
! 331: exit;
1.11 raeburn 332: }
333: }
1.1 harris41 334:
1.11 raeburn 335: if (-d "/home/$username") {
336: system('/bin/chown',"$username:$username","/home/$username");
337: system('/bin/chmod','-R','0660',"/home/$username");
338: system('/bin/chmod','0710',"/home/$username");
339: }
1.1 harris41 340: =pod
341:
342: =item 3 (as root). enter in a password
343:
344: Command: [prompt %] passwd USERNAME
345: New UNIX password: PASSWORD
346: Retype new UNIX passwd: PASSWORD
347: Example: [prompt %] passwd dc103
348: New UNIX password: sesame
349: Retype new UNIX passwd: sesame
350:
351: =cut
352:
1.7 harris41 353: # Process password (taint-check, then pass to the UNIX passwd command).
354: $username =~ s/\W//g; # an extra filter, just to be sure
355: $pbad = 0;
1.1 harris41 356: foreach (split(//,$passwd)) {if ((ord($_)<32)||(ord($_)>126)){$pbad=1;}}
357: if ($pbad) {
1.18 ! raeburn 358: print(&mt('Password must consist of standard ASCII characters.').
! 359: "\n");
1.1 harris41 360: }
1.16 raeburn 361:
362: my $distro;
363: if (open(PIPE,"perl distprobe|")) {
364: $distro = <PIPE>;
365: close(PIPE);
366: }
367: if ($distro =~ /^ubuntu|debian/) {
368: open(OUT,"|usermod -p `mkpasswd $passwd` $username");
369: close(OUT);
370: } else {
371: open(OUT,"|passwd --stdin $username");
372: print(OUT $passwd."\n");
373: close(OUT);
374: }
1.1 harris41 375:
376: =pod
377:
378: =cut
379:
380: =pod
381:
382: =item 4. login as user=www
383:
384: Command: [prompt %] su www
385: Password: WWWPASSWORD
386:
387: =item 5. (as www). cd /home/httpd/lonUsers
388:
389: =item 6. (as www) Create user directory for your new user.
390:
391: Let U equal first letter of USERNAME
392: Let S equal second letter of USERNAME
393: Let E equal third letter of USERNAME
394: Command: [prompt %] install -d DOMAIN/U/S/E/USERNAME
1.7 harris41 395:
396: Here are three examples of the commands that would be needed
397: for different domain coordinator names (dc103, morphy, or ng):
398:
399: Example #1 (dc103): [prompt %] install -d 103/d/c/1/dc103
400: Example #2 (morphy): [prompt %] install -d 103/m/o/r/morphy
401: Example #3 (ng): [prompt %] install -d 103/n/g/_/ng
1.1 harris41 402:
403: =cut
404:
1.7 harris41 405: # Generate the user directory.
406: `install -o www -g www -d $udpath`; # Must be writeable by httpd process.
1.1 harris41 407:
408: =pod
409:
410: =item 7. (as www) Enter the newly created user directory.
411:
412: Command: [prompt %] cd DOMAIN/U/S/E/USERNAME
413: Example: [prompt %] cd 103/d/c/1/dc103
414:
415: =item 8. (as www). Set your password mechanism to 'unix'
416:
417: Command: [prompt %] echo "unix:" > passwd
418:
419: =cut
420:
1.7 harris41 421: # UNIX (/etc/passwd) style authentication is asserted for domain coordinators.
422: open(OUT, ">$udpath/passwd");
423: print(OUT 'unix:'."\n");
424: close(OUT);
1.15 www 425:
426: # Get permissions correct on udpath
427:
1.18 ! raeburn 428: print(&mt('Setting permissions on user data directories.').' '.
! 429: &mt('This may take a moment, please be patient ...')."\n");
1.15 www 430: `chown -R www:www /home/httpd/lonUsers/$domain` ; # Must be writeable by httpd process.
1.1 harris41 431:
432: =pod
433:
434: =item 9. (as www). Run CVS:loncapa/doc/rolesmanip.pl:
435:
436: Command: [prompt %] perl rolesmanip.pl DOMAIN USERNAME
437: Example: [prompt %] perl rolesmanip.pl 103 dc103
438:
439: =cut
440:
1.7 harris41 441: use GDBM_File; # A simplistic key-value pairing database.
1.1 harris41 442:
1.10 albertel 443: my $rolesref=&LONCAPA::locking_hash_tie("$udpath/roles.db",&GDBM_WRCREAT());
444: if (!$rolesref) {
1.18 ! raeburn 445: print(&mt('Error').' '.
! 446: &mt('unable to tie roles db: [_1]'."$udpath/roles.db")."\n");
! 447: exit;
1.10 albertel 448: }
1.13 raeburn 449: my $now = time;
450: $rolesref->{'/'.$domain.'/_dc'}='dc_0_'.$now; # Set the domain coordinator role.
1.7 harris41 451: open(OUT, ">$udpath/roles.hist"); # roles.hist is the synchronous plain text.
1.10 albertel 452: foreach my $key (keys(%{$rolesref})) {
453: print(OUT $key.' : '.$rolesref->{$key}."\n");
454: }
1.7 harris41 455: close(OUT);
1.10 albertel 456: &LONCAPA::locking_hash_untie($rolesref);
457:
1.1 harris41 458:
1.7 harris41 459: `chown www:www $udpath/roles.hist`; # Must be writeable by httpd process.
460: `chown www:www $udpath/roles.db`; # Must be writeable by httpd process.
1.1 harris41 461:
1.13 raeburn 462: my %perlvar = %{&LONCAPA::Configuration::read_conf('loncapa.conf')};
463: my $dompath = $perlvar{'lonUsersDir'}.'/'.$domain;
464: my $domrolesref = &LONCAPA::locking_hash_tie("$dompath/nohist_domainroles.db",&GDBM_WRCREAT());
465:
466: if (!$domrolesref) {
1.18 ! raeburn 467: print(&mt('Error').' '.&mt('unable to tie nohist_domainroles db: [_1].',
! 468: "$dompath/nohist_domainroles.db")."\n");
1.13 raeburn 469: }
470:
471: # Store in nohist_domainroles.db
472: my $domkey=&LONCAPA::escape('dc:'.$username.':'.$domain.'::'.$domain.':');
473: $domrolesref->{$domkey}= &LONCAPA::escape('0:'.$now);
474: &LONCAPA::locking_hash_untie($domrolesref);
475:
1.14 raeburn 476: system('/bin/chown',"www:www","$dompath/nohist_domainroles.db"); # Must be writeable by httpd process.
477: system('/bin/chown',"www:www","$dompath/nohist_domainroles.db.lock");
478:
1.13 raeburn 479: #Update allusers MySQL table
480:
1.18 ! raeburn 481: print(&mt('Adding new user to allusers table.')."\n");
1.13 raeburn 482: &allusers_update($username,$domain,\%perlvar);
483:
1.1 harris41 484: =pod
485:
486: =item 10.
487:
488: You may further define the domain coordinator user (i.e. dc103)
489: by going to http://MACHINENAME/adm/createuser.
490:
491: =cut
492:
1.7 harris41 493: # Output success message, and inform sysadmin about how to further proceed.
1.18 ! raeburn 494: print("\n".&mt('[_1] is now a domain coordinator',$username)."\n"); # Output success message.
1.7 harris41 495: my $hostname=`hostname`; chomp($hostname); # Read in hostname.
1.18 ! raeburn 496: print("\n".
! 497: &mt('Once LON-CAPA is running, you should log-in and use: [_1] to further define this user.',
! 498: "\nhttp://$hostname/adm/createuser\n")."\n\n".
! 499: &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 500: # Output a suggested URL.
501:
502: sub allusers_update {
503: my ($username,$domain,$perlvar) = @_;
504: my %tablenames = (
505: 'allusers' => 'allusers',
506: );
507: my $dbh;
508: unless ($dbh = DBI->connect("DBI:mysql:loncapa","www",
509: $perlvar->{'lonSqlAccess'},
510: { RaiseError =>0,PrintError=>0})) {
1.18 ! raeburn 511: print(&mt('Cannot connect to database!')."\n");
1.13 raeburn 512: return;
513: }
514: my $tablechk = &allusers_table_exists($dbh);
515: if ($tablechk == 0) {
516: my $request =
517: &LONCAPA::lonmetadata::create_metadata_storage('allusers','allusers');
518: $dbh->do($request);
519: if ($dbh->err) {
1.18 ! raeburn 520: print(&mt('Failed to create [_1] table.','allusers')."\n");
1.13 raeburn 521: return;
522: }
523: }
524: my %userdata = (
525: username => $username,
526: domain => $domain,
527: );
528: my %loghash =
529: &LONCAPA::lonmetadata::process_allusers_data($dbh,undef,
530: \%tablenames,$username,$domain,\%userdata,'update');
531: foreach my $key (keys(%loghash)) {
532: print $loghash{$key}."\n";
533: }
534: return;
535: }
536:
537: sub allusers_table_exists {
538: my ($dbh) = @_;
539: my $sth=$dbh->prepare('SHOW TABLES');
540: $sth->execute();
541: my $aref = $sth->fetchall_arrayref;
542: $sth->finish();
543: if ($sth->err()) {
544: return undef;
545: }
546: my $result = 0;
547: foreach my $table (@{$aref}) {
548: if ($table->[0] eq 'allusers') {
549: $result = 1;
550: last;
551: }
552: }
553: return $result;
554: }
1.1 harris41 555:
1.18 ! raeburn 556: sub get_password {
! 557: my ($prompt) = @_;
! 558: local $| = 1;
! 559: print $prompt.': ';
! 560: my $newpasswd = '';
! 561: ReadMode 'raw';
! 562: my $key;
! 563: while(ord($key = ReadKey(0)) != 10) {
! 564: if(ord($key) == 127 || ord($key) == 8) {
! 565: chop($newpasswd);
! 566: print "\b \b";
! 567: } elsif(!ord($key) < 32) {
! 568: $newpasswd .= $key;
! 569: print '*';
! 570: }
! 571: }
! 572: ReadMode 'normal';
! 573: print "\n";
! 574: return $newpasswd;
! 575: }
! 576:
1.1 harris41 577: =pod
578:
1.2 harris41 579: =head1 AUTHOR
1.1 harris41 580:
1.7 harris41 581: Written to help the LON-CAPA project.
1.1 harris41 582:
583: =cut
1.13 raeburn 584:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>