Return to expire_DC_role.pl CVS log

Up to [LON-CAPA] / loncom / build

- Correctly set end date in nohist_domainroles.db

    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.7 2015/03/10 21:24:53 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: use Storable qw(nfreeze);
   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: my ($user,$role_domain) = (@ARGV);
   91: my $lang = &Apache::lonlocal::choose_language();
   92: &Apache::lonlocal::get_language_handle(undef,$lang);
   93: 
   94: if ($< != 0) { # Am I root?
   95:     print(&mt('You must be root in order to expire a domain coordinator role.').
   96:           "\n");
   97:     exit;
   98: }
   99: # ----------------------------------------------- So, are we invoked correctly?
  100: # Two arguments or abort
  101: if (@ARGV!=2) {
  102:     print(&mt('usage: [_1]','expire_DC_role.pl [USERNAME:DOMAIN] [DC ROLEDOMAIN]').
  103: 	"\n");
  104:     exit;
  105: }
  106: my ($user,$role_domain)=(@ARGV);
  107: my ($username,$domain)=split(':',$user);
  108: if (!grep(/^\Q$role_domain\E$/,&Apache::lonnet::current_machine_domains())) {
  109:     print(&mt('**** ERROR **** Domain [_1] is not a domain for which this server is a library server.',$role_domain)."\n");
  110:     exit;
  111: }
  112: 
  113: my $udpath=&propath($domain,$username);
  114: if (!-d $udpath) {
  115:     print(&mt('**** ERROR **** [_1] is not a LON-CAPA user for which this is the homeserver.',$user)."\n");
  116:     exit;
  117: }
  118: 
  119: use GDBM_File; # A simple key-value pairing database.
  120: 
  121: my $rolesref=&LONCAPA::locking_hash_tie("$udpath/roles.db",&GDBM_WRCREAT());
  122: if (!$rolesref) {
  123:     print(&mt('unable to tie [_1]',"roles db: $udpath/roles.db")."\n");
  124:     exit;
  125: }
  126: my ($start,$status,$now);
  127: $now = time();
  128: if (exists($rolesref->{'/'.$role_domain.'/_dc'})) {
  129:     (my $role,my $end,$start) = split('_',$rolesref->{'/'.$role_domain.'/_dc'});
  130:     print(&mt("Confirmed: [_1] has a DC role for domain: [_2].",
  131: 	      $user,$role_domain)."\n");
  132:     if ($start) {
  133: 	print(&mt("Start date: [_1]",&Apache::lonlocal::locallocaltime($start)).
  134: 	      "\n");
  135: 	if (!$end) {
  136: 	    print(&mt("No planned end date. Proceeding to expire role.")."\n");
  137:             $status = 'active';
  138: 	} else {
  139:             print(&mt("End date: [_1]",&Apache::lonlocal::locallocaltime($end)).
  140:                   "\n");
  141:             if (($start <= $now) && ($end > $now)) {
  142: 	        print(&mt("Role is currently active. Proceeding to expire role.")."\n");
  143:                 $status = 'active';
  144:             } elsif (($start > $now) && ($end >= $start)) {
  145:                 print(&mt("Role is currently inactive, but will become active in the future. Proceeding to expire role.")."\n");
  146:                 $status = 'future';
  147:             }
  148:         }
  149:     } elsif ($end) {
  150: 	print(&mt("End date: [_1]",&Apache::lonlocal::locallocaltime($end)).
  151: 	      "\n");
  152: 	if ($end >= $now) {
  153: 	    print(&mt("Role is currently active. Proceeding to expire role.")."\n");
  154:             $status = 'active';
  155: 	}
  156:     }
  157:     if (!$start and !$end) {
  158: 	print(&mt("Role is currently active. Proceeding to expire role.")."\n");
  159:         $status = 'active';
  160:     }
  161:     if ($status eq '') {
  162:         print(&mt("Role inactive and will remain so. Expiration is not required.")."\n");
  163:     }
  164: } else {
  165:     print(&mt("[_1] does NOT have a DC role for domain: [_2].",
  166:               $user,$role_domain)."\n".
  167:           &mt("Expiration is not required")."\n");
  168: }
  169: 
  170: if ($status eq '') {
  171:     &LONCAPA::locking_hash_untie($rolesref);
  172:     exit(0);
  173: }
  174: 
  175: $rolesref->{'/'.$role_domain.'/_dc'}='dc_'.$now.'_'.$start; # Expire the domain coordinator role.
  176: open(OUT, ">$udpath/roles.hist"); # roles.hist is the synchronous plain text.
  177: foreach my $key (keys(%{$rolesref})) {
  178:     print(OUT $key.' : '.$rolesref->{$key}."\n");
  179: }
  180: close(OUT);
  181: &LONCAPA::locking_hash_untie($rolesref);
  182: 
  183: `chown www:www $udpath/roles.hist`; # Must be writeable by httpd process.
  184: `chown www:www $udpath/roles.db`; # Must be writeable by httpd process.
  185: 
  186: my %perlvar = %{&LONCAPA::Configuration::read_conf('loncapa.conf')};
  187: my $dompath = $perlvar{'lonUsersDir'}.'/'.$domain;
  188: my $domrolesref = &LONCAPA::locking_hash_tie("$dompath/nohist_domainroles.db",&GDBM_WRCREAT());
  189: 
  190: if (!$domrolesref) {
  191:     print(&mt('unable to tie [_1]',"nohist_domainroles db: $dompath/nohist_domainroles.db")."\n");
  192:     exit;
  193: }
  194: 
  195: # Store in nohist_domainroles.db
  196: my $domkey=&LONCAPA::escape('dc:'.$username.':'.$domain.'::'.$domain.':');
  197: $domrolesref->{$domkey}= &LONCAPA::escape($now.':'.$start);
  198: &LONCAPA::locking_hash_untie($domrolesref);
  199: 
  200:  system('/bin/chown',"www:www","$dompath/nohist_domainroles.db"); # Must be writeable by httpd process.
  201:  system('/bin/chown',"www:www","$dompath/nohist_domainroles.db.lock");
  202: 
  203: # Log with domainconfiguser in nohist_rolelog.db
  204: my $domconfiguser = $domain.'-domainconfig';
  205: my $subdir = $domconfiguser;
  206: $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
  207: 
  208: my $rolelogref = &LONCAPA::locking_hash_tie("$dompath/$subdir/$domconfiguser/nohist_rolelog.db",&GDBM_WRCREAT());
  209: 
  210: if (!$rolelogref) {
  211:     print(&mt('unable to tie [_1]',"nohist_rolelog db: $dompath/$subdir/$domconfiguser/nohist_rolelog.db")."\n");
  212:     exit;
  213: }
  214: 
  215: my $domlogkey = &LONCAPA::escape($now.'00000'.$$.'000000');
  216: my $storehash = {
  217:                    role    => 'dc',
  218:                    start   => $start,
  219:                    end     => $now,
  220:                    context => 'server',
  221:                 };
  222: my $domlogvalue = {
  223:                     'exe_uname' => '',
  224:                     'exe_udom'  => $domain,
  225:                     'exe_time'  => $now,
  226:                     'exe_ip'    => '127.0.0.1',
  227:                     'delflag'   => '',
  228:                     'logentry'  => $storehash,
  229:                     'uname'     => $username,
  230:                     'udom'      => $domain,
  231:                  };
  232: $rolelogref->{$domlogkey}=&freeze_escape($domlogvalue);
  233: &LONCAPA::locking_hash_untie($rolelogref);
  234: 
  235:  system('/bin/chown',"www:www","$dompath/$subdir/$domconfiguser/nohist_rolelog.db"); # Must be writeable by httpd process.
  236:  system('/bin/chown',"www:www","$dompath/$subdir/$domconfiguser/nohist_rolelog.db.lock");
  237: 
  238: # Output success message.
  239: print(&mt('User: [_1], domain coordinator role expired in domain: [_2].',$user,$role_domain)."\n");
  240: 
  241: sub freeze_escape {
  242:     my ($value)=@_;
  243:     if (ref($value)) {
  244:         $value=&nfreeze($value);
  245:         return '__FROZEN__'.&LONCAPA::escape($value);
  246:     }
  247:     return &LONCAPA::escape($value);
  248: }
  249: 
  250: exit;