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>
![[BACK]](/icons/back.gif){kind=icon}
Return to expire_DC_role.pl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / build