Annotation of loncom/debugging_tools/unsubresources.pl, revision 1.2
1.1 raeburn 1: #!/usr/bin/perl
2: #
3: # The LearningOnline Network
4: #
5: # When an access node is being taken offline either permanently
6: # or for a long period of time, it would be friendly to domains
7: # which have library nodes from which resources have been replicated
8: # to unsubscribe from the resources, to avoid accumulation of
9: # delayed "update" transactions in lonnet.perm.log on the library
10: # nodes which are the home servers for the authors of the replicated
11: # resources, in the event that the author publishes updated version(s).
12: #
1.2 ! raeburn 13: # $Id: unsubresources.pl,v 1.1 2020/05/13 01:49:55 raeburn Exp $
1.1 raeburn 14: #
15: # Copyright Michigan State University Board of Trustees
16: #
17: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
18: #
19: # LON-CAPA is free software; you can redistribute it and/or modify
20: # it under the terms of the GNU General Public License as published by
21: # the Free Software Foundation; either version 2 of the License, or
22: # (at your option) any later version.
23: #
24: # LON-CAPA is distributed in the hope that it will be useful,
25: # but WITHOUT ANY WARRANTY; without even the implied warranty of
26: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
27: # GNU General Public License for more details.
28: #
29: # You should have received a copy of the GNU General Public License
30: # along with LON-CAPA; if not, write to the Free Software
31: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
32: #
33: # /home/httpd/html/adm/gpl.txt
34: #
35: # http://www.lon-capa.org/
36: #
37: #################################################
38:
39: use strict;
40: use lib '/home/httpd/lib/perl/';
41: use LONCAPA::Configuration;
42: use LONCAPA qw(:DEFAULT :match);
43: use Apache::lonlocal;
44: use Apache::lonnet;
45:
46: my ($londocroot,$londaemons);
47:
48: BEGIN {
49: my $perlvar=&LONCAPA::Configuration::read_conf();
50: if (ref($perlvar) eq 'HASH') {
51: $londocroot = $perlvar->{'lonDocRoot'};
52: $londaemons = $perlvar->{'lonDaemons'};
53: }
54: undef($perlvar);
55: }
56:
57: my $lang = &Apache::lonlocal::choose_language();
58: &Apache::lonlocal::get_language_handle(undef,$lang);
59:
60: my $parameter=$ARGV[0];
61: $parameter =~ s/^\s+//;
62: $parameter =~ s/\s+$//;
63:
64: if ((@ARGV > 1) || (($parameter ne '') && ($parameter ne 'execute'))) {
65: print &mt('usage: [_1]','unsubresources.pl [dryrun|execute]')."\n\n".
66: &mt('You should enter either no arguments, or just one argument: execute.')."\n".
67: &mt("execute - to unlink resources in [_1], and send unsub request to homeserver of resource author",
68: "$londocroot/res/'")."\n".
69: &mt('no argument to do a dry run, without actually unlinking or unsubscribing anything.')."\n";
70: exit;
71: }
72:
73: my $wwwid=getpwnam('www');
74: if ($wwwid!=$<) {
75: print &mt('This must be run as user www in order to unsubscribe previously subscribed resources.')."\n".
76: &mt('Stopping')."\n";
77: exit;
78: }
79:
80: if ($londocroot eq '') {
81: print &mt('Could not determine location of [_1] directory.',"'lonDocRoot'")."\n".
82: &mt('Stopping')."\n";
83: exit;
84: }
85: if ($londaemons eq '') {
86: print &mt('Could not determine location of [_1] directory.',"'lonDaemons'")."\n".
87: &mt('Stopping')."\n";
88: exit;
89: }
90:
91: # Get machine IDs
92: my @ids=&Apache::lonnet::current_machine_ids();
93:
94: print "\n".&mt("Unlinking and unsubscribing resources in $londocroot/res/")."\n".
95: &mt('No changes will occur for resources for which this server is the homeserver of the author of the resource.')."\n".
96: "-----------------------------\n\n".
97: &mt('If run without an argument, the script will report what it would do when unlinking and unsubscribing resources in [_1].',
98: "'$londocroot/res/'")."\n\n";
99:
100: my ($action) = ($parameter=~/^(execute)$/);
101: if ($action eq '') {
102: $action = 'dryrun';
103: }
104:
105: if ($action eq 'dryrun') {
106: print "\n".
107: &mt('Running in exploratory mode ...')."\n\n".
108: &mt('Run with argument [_1] to actually unlink and unsubscribe resources in [_2], i.e., [_3]',
109: "'execute'","'$londocroot/res/'","\n\nperl unsubresources.pl execute")."\n\n\n".
110: &mt('Continue? ~[y/N~] ');
111: if (!&get_user_selection()) {
112: exit;
113: } else {
114: print "\n";
115: }
116: } else {
117: print "\n *** ".&mt('Running in a mode where changes will be made.')." ***\n";
118: print "\n".
119: &mt('Mode is [_1] -- replicated resources in [_2] will be unlinked and unsubscribed.',
1.2 ! raeburn 120: "'$action'","'$londocroot/res/'")."\n".
! 121: &mt('Results will be logged in [_1].',"$londaemons/logs/unsubresources.log")."\n";
1.1 raeburn 122: print &mt('Continue? ~[y/N~] ');
123: if (!&get_user_selection()) {
124: exit;
125: } else {
126: print "\n";
127: }
128: }
129:
130: my $dir = "$londocroot/res";
131: my %alreadyseen;
132:
133: my $logfh;
134: unless ($action eq 'dryrun') {
135: if (!open($logfh,'>>',"$londaemons/logs/unsubresources.log")) {
136: print &mt('Could not open log file: [_1] for writing.',
137: "'$londaemons/logs/unsubresources.log'")."\n".
138: &mt('Stopping.')."\n";
139: exit;
140: } else {
141: &start_logging($logfh,$action);
142: }
143: }
144: &check_directory($action,$dir,$logfh,\@ids,\%alreadyseen);
145: unless ($action eq 'dryrun') {
146: &stop_logging($logfh);
147: }
148: print "\n".&mt('Done')."\n";
149: exit;
150:
151: sub check_directory {
152: my ($action,$dir,$fh,$idsref,$seenref,$currhome) = @_;
153: my $msg;
154: if (opendir(my $dirh,$dir)) {
155: while (my $item=readdir($dirh)) {
156: next if ($item =~ /^\./);
157: if (-d "$dir/$item") {
158: if ($dir eq "$londocroot/res") {
159: next if (($item eq 'adm') || ($item eq 'lib') || ($item eq 'res'));
160: if (&Apache::lonnet::domain($item) ne '') {
161: my %servers = &Apache::lonnet::get_unique_servers($item);
162: my @libservers;
163: foreach my $server (keys(%servers)) {
164: if (&Apache::lonnet::is_library($server)) {
165: push(@libservers,$server);
166: }
167: }
168: if (@libservers == 1) {
169: if ((ref($idsref) eq 'ARRAY') && (grep(/^\Q$libservers[0]\E$/,@{$idsref}))) {
170: $msg = &mt('Skipping directory for [_1] as [_2] is the single library node for the domain',
171: $item,$libservers[0])."\n";
172: if ($action eq 'execute') {
173: print $fh $msg;
174: } else {
175: print $msg;
176: }
177: next;
178: }
179: }
180: &check_directory($action,"$dir/$item",$fh,$idsref,$seenref);
181: } else {
182: $msg = &mt('Domain [_1] in [_2] is unavailable',
183: $item,$dir)."\n";
184: if ($action eq 'execute') {
185: print $fh $msg;
186: } else {
187: print $msg;
188: }
189: next;
190: }
191: } elsif ($dir =~ m{^\Q$londocroot/res\E/($match_domain)$}) {
192: my $udom = $1;
193: if ($item =~ /^($match_username)$/) {
194: my $uname = $1;
195: $currhome = &Apache::lonnet::homeserver($uname,$udom,1);
196: if ($currhome eq 'no_host') {
197: $msg = &mt('No homeserver for user: [_1] domain: [_2]',
198: $uname,$udom)."\n";
199: if ($action eq 'execute') {
200: print $fh $msg;
201: } else {
202: print $msg;
203: }
204: } elsif ((ref($idsref) eq 'ARRAY') && (grep(/^\Q$currhome\E$/,@{$idsref}))) {
205: $msg = &mt("Skipping user: [_1] in domain: [_2] as this is the user's homeserver.",
206: $uname,$udom)."\n";
207: if ($action eq 'execute') {
208: print $fh $msg;
209: } else {
210: print $msg;
211: }
212: } else {
213: &check_directory($action,"$dir/$item",$fh,$idsref,$seenref,$currhome);
214: }
215: } else {
216: $msg = &mt('Username: [_1] in domain: [_2] is invalid',
217: $item,$udom)."\n";
218: if ($action eq 'execute') {
219: print $fh $msg;
220: } else {
221: print $msg;
222: }
223: }
224: } else {
225: &check_directory($action,"$dir/$item",$fh,$idsref,$seenref,$currhome);
226: }
227: } elsif (-f "$dir/$item") {
228: if ($dir =~ m{^\Q$londocroot/res\E/$match_domain/$match_username}) {
229: next if ($seenref->{"$dir/$item"});
230: if ($action eq 'execute') {
231: if (unlink("$dir/$item")) {
232: if ($item =~ /\.meta$/) {
233: my $nonmeta = $item;
234: $nonmeta =~ s/\.meta$//;
235: next if ((-e "$dir/$nonmeta") || ($seenref->{"$dir/$nonmeta"}));
236: } elsif (-e "$dir/$item.meta") {
237: unlink("$dir/$item.meta");
238: }
239: if ($currhome ne '') {
1.2 ! raeburn 240: my $result = &Apache::lonnet::unsubscribe("$dir/$item");
1.1 raeburn 241: if ($result eq 'ok') {
242: print $fh &mt('Unsub complete for [_1] at [_2]',
243: "$dir/$item",$currhome)."\n";
244: } else {
245: print $fh &mt('Result of unsub for [_1] at [_2] was: [_3]',
246: "$dir/$item",$currhome,$result)."\n";
247: }
248: }
249: $seenref->{"$dir/$item"} = 1;
250: } else {
251: print $fh &mt('Failed to unlink [_1]',"$dir/$item")."\n";
252: }
253: } else {
254: if ($item =~ /\.meta$/) {
255: my $nonmeta = $item;
256: $nonmeta =~ s/\.meta$//;
257: next if (-e "$dir/$nonmeta");
258: print &mt('Would unlink [_1] and send unsub to [_2]',
259: "$dir/$item",$currhome)."\n";
260: } elsif (-e "$dir/$item.meta") {
261: print &mt('Would unlink [_1] and [_2], and send unsub to [_3]',
262: "$dir/$item","$dir/$item.meta",$currhome)."\n";
263: $seenref->{"$dir/$item.meta"} = 1;
264: } else {
265: print &mt('Would unlink [_1] and send unsub to [_2]',
266: "$dir/$item",$currhome)."\n";
267: }
268: $seenref->{"$dir/$item"} = 1;
269: }
270: } else {
271: $msg = &mt('Invalid directory [_1]',$dir)."\n";
272: if ($action eq 'execute') {
273: print $fh $msg;
274: } else {
275: print $msg;
276: }
277: }
278: }
279: }
280: closedir($dirh);
281: } else {
282: $msg = &mt('Could not open directory: [_1]',$dir)."\n";
283: if ($action eq 'execute') {
284: print $fh $msg;
285: } else {
286: print $msg;
287: }
288: }
289: return;
290: }
291:
292: sub get_user_selection {
293: my ($defaultrun) = @_;
294: my $do_action = 0;
295: my $choice = <STDIN>;
296: chomp($choice);
297: $choice =~ s/(^\s+|\s+$)//g;
298: my $yes = &mt('y');
299: if ($defaultrun) {
300: if (($choice eq '') || ($choice =~ /^\Q$yes\E/i)) {
301: $do_action = 1;
302: }
303: } else {
304: if ($choice =~ /^\Q$yes\E/i) {
305: $do_action = 1;
306: }
307: }
308: return $do_action;
309: }
310:
311: sub start_logging {
312: my ($fh,$action) = @_;
313: my $start = localtime(time);
314: print $fh "*****************************************************\n".
315: &mt('[_1] - mode is [_2].',
316: 'unsubresources.pl',"'$action'")."\n".
317: &mt('Started -- time: [_1]',$start)."\n".
318: "*****************************************************\n\n";
319: return;
320: }
321:
322: sub stop_logging {
323: my ($fh) = @_;
324: my $end = localtime(time);
325: print $fh "*****************************************************\n".
326: &mt('Ended -- time: [_1]',$end)."\n".
327: "*****************************************************\n\n\n";
328: close($fh);
329: return;
330: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to unsubresources.pl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / debugging_tools