Annotation of loncom/build/expire_DC_role.pl, revision 1.1
1.1 ! raeburn 1: #!/usr/bin/perl
! 2:
! 3: # The LearningOnline Network
! 4: #
! 5: # expire_DC_role.pl - Expire domain coordinator role from
! 6: # a user who currently has such a role in a domain for which current server is
! 7: # a library server for the domain.
! 8: #
! 9: # $Id: expire_DC_role.pl,v 1.1 2011/03/07 18:13:11 raeburn Exp $
! 10: #
! 11: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
! 12: #
! 13: # LON-CAPA is free software; you can redistribute it and/or modify
! 14: # it under the terms of the GNU General Public License as published by
! 15: # the Free Software Foundation; either version 2 of the License, or
! 16: # (at your option) any later version.
! 17: #
! 18: # LON-CAPA is distributed in the hope that it will be useful,
! 19: # but WITHOUT ANY WARRANTY; without even the implied warranty of
! 20: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! 21: # GNU General Public License for more details.
! 22: #
! 23: # You should have received a copy of the GNU General Public License
! 24: # along with LON-CAPA; if not, write to the Free Software
! 25: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
! 26: #
! 27: # /home/httpd/html/adm/gpl.txt
! 28: #
! 29: # http://www.lon-capa.org/
! 30: #
! 31: ###
! 32:
! 33: =pod
! 34:
! 35:
! 36: =head1 NAME
! 37:
! 38: expire_DC_role.pl - Expire domain coordinator role.
! 39:
! 40: =head1 SYNOPSIS
! 41:
! 42: To be run by root from the command line to expire domain coordinator role
! 43: for a user who currently has such a role in a domain for which current
! 44: server is a library server for the domain.
! 45:
! 46: User's homeserver must be the library server where the script is run.
! 47:
! 48: =head1 DESCRIPTION
! 49:
! 50: Carries out steps required for domain coordinator role expiration.
! 51:
! 52: =over 4
! 53:
! 54: =item *
! 55:
! 56: Tests to see if user already exists for LON-CAPA, if not it aborts.
! 57:
! 58: =item *
! 59:
! 60: Modify roles.hist and roles.db for user and nohist_domainroles.db for domain.
! 61:
! 62: =back
! 63:
! 64: =cut
! 65:
! 66: # ---------------------------------------------------- Configure general values
! 67:
! 68: use lib '/home/httpd/lib/perl/';
! 69: use LONCAPA;
! 70: use Apache::lonnet;
! 71: use Apache::loncommon;
! 72: use Apache::lonlocal;
! 73: &Apache::lonlocal::get_language_handle();
! 74:
! 75: =pod
! 76:
! 77: =head1 OPTIONS
! 78:
! 79: There are no flags to this script.
! 80:
! 81: usage: expire_DC_role.pl [USERNAME:DOMAIN] [DC ROLEDOMAIN]
! 82:
! 83: The first argument specifies the user name and domain of an existing user
! 84: who has a Domain Coordinator role in the "DC ROLEDOMAIN".
! 85:
! 86: The second argument specifies the domain for which the role is to be expired.
! 87:
! 88: =cut
! 89:
! 90: # ----------------------------------------------- So, are we invoked correctly?
! 91: # Two arguments or abort
! 92: if (@ARGV!=2) {
! 93: die('usage: expire_DC_role.pl [USERNAME:DOMAIN] [DC ROLEDOMAIN]'.
! 94: "\n");
! 95: }
! 96: my ($user,$role_domain)=(@ARGV);
! 97: my ($username,$domain)=split(':',$user);
! 98: if (!grep(/^\Q$role_domain\E$/,&Apache::lonnet::current_machine_domains())) {
! 99: die('**** ERROR **** Domain '.$role_domain.' is not a domain for which this server is a library server.'."\n");
! 100: }
! 101:
! 102: my $udpath=&propath($domain,$username);
! 103: if (!-d $udpath) {
! 104: die ('**** ERROR **** '.$user.' is not a LON-CAPA user for which this is the homeserver.'."\n");
! 105: }
! 106:
! 107: use GDBM_File; # A simple key-value pairing database.
! 108:
! 109: my $rolesref=&LONCAPA::locking_hash_tie("$udpath/roles.db",&GDBM_WRCREAT());
! 110: if (!$rolesref) {
! 111: die('unable to tie roles db: '."$udpath/roles.db");
! 112: }
! 113: my ($start,$status,$now);
! 114: $now = time();
! 115: if (exists($rolesref->{'/'.$role_domain.'/_dc'})) {
! 116: (my $role,my $end,$start) = split('_',$rolesref->{'/'.$role_domain.'/_dc'});
! 117: print(&mt("Confirmed: [_1] has a DC role for domain: [_2].",
! 118: $user,$role_domain)."\n");
! 119: if ($start) {
! 120: print(&mt("Start date: [_1]",&Apache::lonlocal::locallocaltime($start)).
! 121: "\n");
! 122: if (!$end) {
! 123: print(&mt("No planned end date. Proceeding to expire role.")."\n");
! 124: $status = 'active';
! 125: } else {
! 126: print(&mt("End date: [_1]",&Apache::lonlocal::locallocaltime($end)).
! 127: "\n");
! 128: if (($start <= $now) && ($end > $now)) {
! 129: print(&mt("Role is currently active. Proceeding to expire role.")."\n");
! 130: $status = 'active';
! 131: } elsif (($start > $now) && ($end >= $start)) {
! 132: print(&mt("Role is currently inactive, but will become active in the future. Proceeding to expire role.")."\n");
! 133: $status = 'future';
! 134: }
! 135: }
! 136: } elsif ($end) {
! 137: print(&mt("End date: [_1]",&Apache::lonlocal::locallocaltime($end)).
! 138: "\n");
! 139: if ($end >= $now) {
! 140: print(&mt("Role is currently active. Proceeding to expire role.")."\n");
! 141: $status = 'active';
! 142: }
! 143: }
! 144: if (!$start and !$end) {
! 145: print(&mt("Role is currently active. Proceeding to expire role.")."\n");
! 146: $status = 'active';
! 147: }
! 148: if ($status eq '') {
! 149: print(&mt("Role inactive and will remain so. Expiration is not required.")."\n");
! 150: }
! 151: } else {
! 152: print(&mt("[_1] does NOT have a DC role for domain: [_2].",
! 153: $user,$role_domain)."\n".
! 154: &mt("Expiration is not required")."\n");
! 155: }
! 156:
! 157: if ($status eq '') {
! 158: &LONCAPA::locking_hash_untie($rolesref);
! 159: exit(0);
! 160: }
! 161:
! 162: $rolesref->{'/'.$role_domain.'/_dc'}='dc_'.$now.'_'.$start; # Expire the domain coordinator role.
! 163: open(OUT, ">$udpath/roles.hist"); # roles.hist is the synchronous plain text.
! 164: foreach my $key (keys(%{$rolesref})) {
! 165: print(OUT $key.' : '.$rolesref->{$key}."\n");
! 166: }
! 167: close(OUT);
! 168: &LONCAPA::locking_hash_untie($rolesref);
! 169:
! 170: `chown www:www $udpath/roles.hist`; # Must be writeable by httpd process.
! 171: `chown www:www $udpath/roles.db`; # Must be writeable by httpd process.
! 172:
! 173: my %perlvar = %{&LONCAPA::Configuration::read_conf('loncapa.conf')};
! 174: my $dompath = $perlvar{'lonUsersDir'}.'/'.$domain;
! 175: my $domrolesref = &LONCAPA::locking_hash_tie("$dompath/nohist_domainroles.db",&GDBM_WRCREAT());
! 176:
! 177: if (!$domrolesref) {
! 178: die('unable to tie nohist_domainroles db: '."$dompath/nohist_domainroles.db");
! 179: }
! 180:
! 181: # Store in nohist_domainroles.db
! 182: my $domkey=&LONCAPA::escape('dc:'.$username.':'.$domain.'::'.$domain.':');
! 183: $domrolesref->{$domkey}= &LONCAPA::escape('$now:'.$start);
! 184: &LONCAPA::locking_hash_untie($domrolesref);
! 185:
! 186: system('/bin/chown',"www:www","$dompath/nohist_domainroles.db"); # Must be writeable by httpd process.
! 187: system('/bin/chown',"www:www","$dompath/nohist_domainroles.db.lock");
! 188:
! 189: # Output success message.
! 190: print(&mt('User: [_1], domain coordinator role expired in domain: [_2].',$user,$role_domain)."\n");
! 191:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>