Annotation of loncom/build/expire_DC_role.pl, revision 1.4

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: # 
1.4     ! raeburn     9: # $Id: expire_DC_role.pl,v 1.3 2012/07/06 13:49:32 raeburn Exp $
1.1       raeburn    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;
1.3       raeburn    72: use Apache::lonlocal;
1.4     ! raeburn    73: use Storable qw(nfreeze);
1.1       raeburn    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: 
1.2       raeburn    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: }
1.1       raeburn    99: # ----------------------------------------------- So, are we invoked correctly?
                    100: # Two arguments or abort
                    101: if (@ARGV!=2) {
1.2       raeburn   102:     print(&mt('usage: [_1]','expire_DC_role.pl [USERNAME:DOMAIN] [DC ROLEDOMAIN]').
1.1       raeburn   103: 	"\n");
1.2       raeburn   104:     exit;
1.1       raeburn   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())) {
1.2       raeburn   109:     print(&mt('**** ERROR **** Domain [_1] is not a domain for which this server is a library server.',$role_domain)."\n");
                    110:     exit;
1.1       raeburn   111: }
                    112: 
                    113: my $udpath=&propath($domain,$username);
                    114: if (!-d $udpath) {
1.2       raeburn   115:     print(&mt('**** ERROR **** [_1] is not a LON-CAPA user for which this is the homeserver.',$user)."\n");
                    116:     exit;
1.1       raeburn   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) {
1.2       raeburn   123:     print(&mt('unable to tie [_1]',"roles db: $udpath/roles.db")."\n");
                    124:     exit;
1.1       raeburn   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) {
1.2       raeburn   191:     print(&mt('unable to tie [_1]',"nohist_domainroles db: $dompath/nohist_domainroles.db")."\n");
                    192:     exit;
1.1       raeburn   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: 
1.4     ! raeburn   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: print "Looking to tie $dompath/$subdir/nohist_rolelog.db\n";
        !           209: 
        !           210: my $rolelogref = &LONCAPA::locking_hash_tie("$dompath/$subdir/$domconfiguser/nohist_rolelog.db",&GDBM_WRCREAT());
        !           211: 
        !           212: if (ref($rolelogref) eq 'HASH') {
        !           213:     foreach my $key (keys(%{$rolelogref})) {
        !           214:         print "found $key\n";
        !           215:     }
        !           216: }
        !           217: 
        !           218: my $domlogkey = &LONCAPA::escape($now.'00000'.$$.'000000');
        !           219: my $storehash = {
        !           220:                    role    => 'dc',
        !           221:                    start   => $start,
        !           222:                    end     => $now,
        !           223:                    context => 'server',
        !           224:                 };
        !           225: my $domlogvalue = {
        !           226:                     'exe_uname' => '',
        !           227:                     'exe_udom'  => $domain,
        !           228:                     'exe_time'  => $now,
        !           229:                     'exe_ip'    => '127.0.0.1',
        !           230:                     'delflag'   => '',
        !           231:                     'logentry'  => $storehash,
        !           232:                     'uname'     => $username,
        !           233:                     'udom'      => $domain,
        !           234:                  };
        !           235: $rolelogref->{$domlogkey}=&freeze_escape($domlogvalue);
        !           236: &LONCAPA::locking_hash_untie($rolelogref);
        !           237: 
        !           238:  system('/bin/chown',"www:www","$dompath/$subdir/nohist_rolelog.db"); # Must be writeable by httpd process.
        !           239:  system('/bin/chown',"www:www","$dompath/$subdir/nohist_rolelog.db.lock");
        !           240: 
        !           241: 
1.1       raeburn   242: # Output success message.
                    243: print(&mt('User: [_1], domain coordinator role expired in domain: [_2].',$user,$role_domain)."\n");
                    244: 
1.4     ! raeburn   245: sub freeze_escape {
        !           246:     my ($value)=@_;
        !           247:     if (ref($value)) {
        !           248:         $value=&nfreeze($value);
        !           249:         return '__FROZEN__'.&LONCAPA::escape($value);
        !           250:     }
        !           251:     return &LONCAPA::escape($value);
        !           252: }
        !           253: 
1.2       raeburn   254: exit;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>