#!/usr/bin/perl
# The LearningOnline Network
#
# expire_DC_role.pl - Expire domain coordinator role from
# a user who currently has such a role in a domain for which current server is
# a library server for the domain.
#
# $Id: expire_DC_role.pl,v 1.6 2015/03/10 20:19:14 raeburn Exp $
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
###
=pod
=head1 NAME
expire_DC_role.pl - Expire domain coordinator role.
=head1 SYNOPSIS
To be run by root from the command line to expire domain coordinator role
for a user who currently has such a role in a domain for which current
server is a library server for the domain.
User's homeserver must be the library server where the script is run.
=head1 DESCRIPTION
Carries out steps required for domain coordinator role expiration.
=over 4
=item *
Tests to see if user already exists for LON-CAPA, if not it aborts.
=item *
Modify roles.hist and roles.db for user and nohist_domainroles.db for domain.
=back
=cut
# ---------------------------------------------------- Configure general values
use lib '/home/httpd/lib/perl/';
use LONCAPA;
use Apache::lonnet;
use Apache::loncommon;
use Apache::lonlocal;
use Storable qw(nfreeze);
=pod
=head1 OPTIONS
There are no flags to this script.
usage: expire_DC_role.pl [USERNAME:DOMAIN] [DC ROLEDOMAIN]
The first argument specifies the user name and domain of an existing user
who has a Domain Coordinator role in the "DC ROLEDOMAIN".
The second argument specifies the domain for which the role is to be expired.
=cut
my ($user,$role_domain) = (@ARGV);
my $lang = &Apache::lonlocal::choose_language();
&Apache::lonlocal::get_language_handle(undef,$lang);
if ($< != 0) { # Am I root?
print(&mt('You must be root in order to expire a domain coordinator role.').
"\n");
exit;
}
# ----------------------------------------------- So, are we invoked correctly?
# Two arguments or abort
if (@ARGV!=2) {
print(&mt('usage: [_1]','expire_DC_role.pl [USERNAME:DOMAIN] [DC ROLEDOMAIN]').
"\n");
exit;
}
my ($user,$role_domain)=(@ARGV);
my ($username,$domain)=split(':',$user);
if (!grep(/^\Q$role_domain\E$/,&Apache::lonnet::current_machine_domains())) {
print(&mt('**** ERROR **** Domain [_1] is not a domain for which this server is a library server.',$role_domain)."\n");
exit;
}
my $udpath=&propath($domain,$username);
if (!-d $udpath) {
print(&mt('**** ERROR **** [_1] is not a LON-CAPA user for which this is the homeserver.',$user)."\n");
exit;
}
use GDBM_File; # A simple key-value pairing database.
my $rolesref=&LONCAPA::locking_hash_tie("$udpath/roles.db",&GDBM_WRCREAT());
if (!$rolesref) {
print(&mt('unable to tie [_1]',"roles db: $udpath/roles.db")."\n");
exit;
}
my ($start,$status,$now);
$now = time();
if (exists($rolesref->{'/'.$role_domain.'/_dc'})) {
(my $role,my $end,$start) = split('_',$rolesref->{'/'.$role_domain.'/_dc'});
print(&mt("Confirmed: [_1] has a DC role for domain: [_2].",
$user,$role_domain)."\n");
if ($start) {
print(&mt("Start date: [_1]",&Apache::lonlocal::locallocaltime($start)).
"\n");
if (!$end) {
print(&mt("No planned end date. Proceeding to expire role.")."\n");
$status = 'active';
} else {
print(&mt("End date: [_1]",&Apache::lonlocal::locallocaltime($end)).
"\n");
if (($start <= $now) && ($end > $now)) {
print(&mt("Role is currently active. Proceeding to expire role.")."\n");
$status = 'active';
} elsif (($start > $now) && ($end >= $start)) {
print(&mt("Role is currently inactive, but will become active in the future. Proceeding to expire role.")."\n");
$status = 'future';
}
}
} elsif ($end) {
print(&mt("End date: [_1]",&Apache::lonlocal::locallocaltime($end)).
"\n");
if ($end >= $now) {
print(&mt("Role is currently active. Proceeding to expire role.")."\n");
$status = 'active';
}
}
if (!$start and !$end) {
print(&mt("Role is currently active. Proceeding to expire role.")."\n");
$status = 'active';
}
if ($status eq '') {
print(&mt("Role inactive and will remain so. Expiration is not required.")."\n");
}
} else {
print(&mt("[_1] does NOT have a DC role for domain: [_2].",
$user,$role_domain)."\n".
&mt("Expiration is not required")."\n");
}
if ($status eq '') {
&LONCAPA::locking_hash_untie($rolesref);
exit(0);
}
$rolesref->{'/'.$role_domain.'/_dc'}='dc_'.$now.'_'.$start; # Expire the domain coordinator role.
open(OUT, ">$udpath/roles.hist"); # roles.hist is the synchronous plain text.
foreach my $key (keys(%{$rolesref})) {
print(OUT $key.' : '.$rolesref->{$key}."\n");
}
close(OUT);
&LONCAPA::locking_hash_untie($rolesref);
`chown www:www $udpath/roles.hist`; # Must be writeable by httpd process.
`chown www:www $udpath/roles.db`; # Must be writeable by httpd process.
my %perlvar = %{&LONCAPA::Configuration::read_conf('loncapa.conf')};
my $dompath = $perlvar{'lonUsersDir'}.'/'.$domain;
my $domrolesref = &LONCAPA::locking_hash_tie("$dompath/nohist_domainroles.db",&GDBM_WRCREAT());
if (!$domrolesref) {
print(&mt('unable to tie [_1]',"nohist_domainroles db: $dompath/nohist_domainroles.db")."\n");
exit;
}
# Store in nohist_domainroles.db
my $domkey=&LONCAPA::escape('dc:'.$username.':'.$domain.'::'.$domain.':');
$domrolesref->{$domkey}= &LONCAPA::escape('$now:'.$start);
&LONCAPA::locking_hash_untie($domrolesref);
system('/bin/chown',"www:www","$dompath/nohist_domainroles.db"); # Must be writeable by httpd process.
system('/bin/chown',"www:www","$dompath/nohist_domainroles.db.lock");
# Log with domainconfiguser in nohist_rolelog.db
my $domconfiguser = $domain.'-domainconfig';
my $subdir = $domconfiguser;
$subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
my $rolelogref = &LONCAPA::locking_hash_tie("$dompath/$subdir/$domconfiguser/nohist_rolelog.db",&GDBM_WRCREAT());
if (!$rolelogref) {
print(&mt('unable to tie [_1]',"nohist_rolelog db: $dompath/$subdir/$domconfiguser/nohist_rolelog.db")."\n");
exit;
}
my $domlogkey = &LONCAPA::escape($now.'00000'.$$.'000000');
my $storehash = {
role => 'dc',
start => $start,
end => $now,
context => 'server',
};
my $domlogvalue = {
'exe_uname' => '',
'exe_udom' => $domain,
'exe_time' => $now,
'exe_ip' => '127.0.0.1',
'delflag' => '',
'logentry' => $storehash,
'uname' => $username,
'udom' => $domain,
};
$rolelogref->{$domlogkey}=&freeze_escape($domlogvalue);
&LONCAPA::locking_hash_untie($rolelogref);
system('/bin/chown',"www:www","$dompath/$subdir/$domconfiguser/nohist_rolelog.db"); # Must be writeable by httpd process.
system('/bin/chown',"www:www","$dompath/$subdir/$domconfiguser/nohist_rolelog.db.lock");
# Output success message.
print(&mt('User: [_1], domain coordinator role expired in domain: [_2].',$user,$role_domain)."\n");
sub freeze_escape {
my ($value)=@_;
if (ref($value)) {
$value=&nfreeze($value);
return '__FROZEN__'.&LONCAPA::escape($value);
}
return &LONCAPA::escape($value);
}
exit;
500 Internal Server Error
Internal Server Error
The server encountered an internal error or
misconfiguration and was unable to complete
your request.
Please contact the server administrator at
root@localhost to inform them of the time this error occurred,
and the actions you performed just before this error.
More information about this error may be available
in the server error log.