Annotation of loncom/build/expire_DC_role.pl, revision 1.2
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.2 ! raeburn 9: # $Id: expire_DC_role.pl,v 1.1 2011/03/07 23:13:40 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.2 ! raeburn 72: use Apache::lonlocal();
1.1 raeburn 73:
74: =pod
75:
76: =head1 OPTIONS
77:
78: There are no flags to this script.
79:
80: usage: expire_DC_role.pl [USERNAME:DOMAIN] [DC ROLEDOMAIN]
81:
82: The first argument specifies the user name and domain of an existing user
83: who has a Domain Coordinator role in the "DC ROLEDOMAIN".
84:
85: The second argument specifies the domain for which the role is to be expired.
86:
87: =cut
88:
1.2 ! raeburn 89: my ($user,$role_domain) = (@ARGV);
! 90: my $lang = &Apache::lonlocal::choose_language();
! 91: &Apache::lonlocal::get_language_handle(undef,$lang);
! 92:
! 93: if ($< != 0) { # Am I root?
! 94: print(&mt('You must be root in order to expire a domain coordinator role.').
! 95: "\n");
! 96: exit;
! 97: }
1.1 raeburn 98: # ----------------------------------------------- So, are we invoked correctly?
99: # Two arguments or abort
100: if (@ARGV!=2) {
1.2 ! raeburn 101: print(&mt('usage: [_1]','expire_DC_role.pl [USERNAME:DOMAIN] [DC ROLEDOMAIN]').
1.1 raeburn 102: "\n");
1.2 ! raeburn 103: exit;
1.1 raeburn 104: }
105: my ($user,$role_domain)=(@ARGV);
106: my ($username,$domain)=split(':',$user);
107: if (!grep(/^\Q$role_domain\E$/,&Apache::lonnet::current_machine_domains())) {
1.2 ! raeburn 108: print(&mt('**** ERROR **** Domain [_1] is not a domain for which this server is a library server.',$role_domain)."\n");
! 109: exit;
1.1 raeburn 110: }
111:
112: my $udpath=&propath($domain,$username);
113: if (!-d $udpath) {
1.2 ! raeburn 114: print(&mt('**** ERROR **** [_1] is not a LON-CAPA user for which this is the homeserver.',$user)."\n");
! 115: exit;
1.1 raeburn 116: }
117:
118: use GDBM_File; # A simple key-value pairing database.
119:
120: my $rolesref=&LONCAPA::locking_hash_tie("$udpath/roles.db",&GDBM_WRCREAT());
121: if (!$rolesref) {
1.2 ! raeburn 122: print(&mt('unable to tie [_1]',"roles db: $udpath/roles.db")."\n");
! 123: exit;
1.1 raeburn 124: }
125: my ($start,$status,$now);
126: $now = time();
127: if (exists($rolesref->{'/'.$role_domain.'/_dc'})) {
128: (my $role,my $end,$start) = split('_',$rolesref->{'/'.$role_domain.'/_dc'});
129: print(&mt("Confirmed: [_1] has a DC role for domain: [_2].",
130: $user,$role_domain)."\n");
131: if ($start) {
132: print(&mt("Start date: [_1]",&Apache::lonlocal::locallocaltime($start)).
133: "\n");
134: if (!$end) {
135: print(&mt("No planned end date. Proceeding to expire role.")."\n");
136: $status = 'active';
137: } else {
138: print(&mt("End date: [_1]",&Apache::lonlocal::locallocaltime($end)).
139: "\n");
140: if (($start <= $now) && ($end > $now)) {
141: print(&mt("Role is currently active. Proceeding to expire role.")."\n");
142: $status = 'active';
143: } elsif (($start > $now) && ($end >= $start)) {
144: print(&mt("Role is currently inactive, but will become active in the future. Proceeding to expire role.")."\n");
145: $status = 'future';
146: }
147: }
148: } elsif ($end) {
149: print(&mt("End date: [_1]",&Apache::lonlocal::locallocaltime($end)).
150: "\n");
151: if ($end >= $now) {
152: print(&mt("Role is currently active. Proceeding to expire role.")."\n");
153: $status = 'active';
154: }
155: }
156: if (!$start and !$end) {
157: print(&mt("Role is currently active. Proceeding to expire role.")."\n");
158: $status = 'active';
159: }
160: if ($status eq '') {
161: print(&mt("Role inactive and will remain so. Expiration is not required.")."\n");
162: }
163: } else {
164: print(&mt("[_1] does NOT have a DC role for domain: [_2].",
165: $user,$role_domain)."\n".
166: &mt("Expiration is not required")."\n");
167: }
168:
169: if ($status eq '') {
170: &LONCAPA::locking_hash_untie($rolesref);
171: exit(0);
172: }
173:
174: $rolesref->{'/'.$role_domain.'/_dc'}='dc_'.$now.'_'.$start; # Expire the domain coordinator role.
175: open(OUT, ">$udpath/roles.hist"); # roles.hist is the synchronous plain text.
176: foreach my $key (keys(%{$rolesref})) {
177: print(OUT $key.' : '.$rolesref->{$key}."\n");
178: }
179: close(OUT);
180: &LONCAPA::locking_hash_untie($rolesref);
181:
182: `chown www:www $udpath/roles.hist`; # Must be writeable by httpd process.
183: `chown www:www $udpath/roles.db`; # Must be writeable by httpd process.
184:
185: my %perlvar = %{&LONCAPA::Configuration::read_conf('loncapa.conf')};
186: my $dompath = $perlvar{'lonUsersDir'}.'/'.$domain;
187: my $domrolesref = &LONCAPA::locking_hash_tie("$dompath/nohist_domainroles.db",&GDBM_WRCREAT());
188:
189: if (!$domrolesref) {
1.2 ! raeburn 190: print(&mt('unable to tie [_1]',"nohist_domainroles db: $dompath/nohist_domainroles.db")."\n");
! 191: exit;
1.1 raeburn 192: }
193:
194: # Store in nohist_domainroles.db
195: my $domkey=&LONCAPA::escape('dc:'.$username.':'.$domain.'::'.$domain.':');
196: $domrolesref->{$domkey}= &LONCAPA::escape('$now:'.$start);
197: &LONCAPA::locking_hash_untie($domrolesref);
198:
199: system('/bin/chown',"www:www","$dompath/nohist_domainroles.db"); # Must be writeable by httpd process.
200: system('/bin/chown',"www:www","$dompath/nohist_domainroles.db.lock");
201:
202: # Output success message.
203: print(&mt('User: [_1], domain coordinator role expired in domain: [_2].',$user,$role_domain)."\n");
204:
1.2 ! raeburn 205: 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