Annotation of loncom/debugging_tools/unsubresources.pl, revision 1.1
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: #
! 13: # $Id: unsubresources.pl,v 1.1 2020/05/11 12:15:29 raeburn Exp $
! 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.',
! 120: "'$action'","'$londocroot/res/'")."\n";
! 121: print &mt('Continue? ~[y/N~] ');
! 122: if (!&get_user_selection()) {
! 123: exit;
! 124: } else {
! 125: print "\n";
! 126: }
! 127: }
! 128:
! 129: my $dir = "$londocroot/res";
! 130: my %alreadyseen;
! 131:
! 132: my $logfh;
! 133: unless ($action eq 'dryrun') {
! 134: if (!open($logfh,'>>',"$londaemons/logs/unsubresources.log")) {
! 135: print &mt('Could not open log file: [_1] for writing.',
! 136: "'$londaemons/logs/unsubresources.log'")."\n".
! 137: &mt('Stopping.')."\n";
! 138: exit;
! 139: } else {
! 140: &start_logging($logfh,$action);
! 141: }
! 142: }
! 143: &check_directory($action,$dir,$logfh,\@ids,\%alreadyseen);
! 144: unless ($action eq 'dryrun') {
! 145: &stop_logging($logfh);
! 146: }
! 147: print "\n".&mt('Done')."\n";
! 148: exit;
! 149:
! 150: sub check_directory {
! 151: my ($action,$dir,$fh,$idsref,$seenref,$currhome) = @_;
! 152: my $msg;
! 153: if (opendir(my $dirh,$dir)) {
! 154: while (my $item=readdir($dirh)) {
! 155: next if ($item =~ /^\./);
! 156: if (-d "$dir/$item") {
! 157: if ($dir eq "$londocroot/res") {
! 158: next if (($item eq 'adm') || ($item eq 'lib') || ($item eq 'res'));
! 159: if (&Apache::lonnet::domain($item) ne '') {
! 160: my %servers = &Apache::lonnet::get_unique_servers($item);
! 161: my @libservers;
! 162: foreach my $server (keys(%servers)) {
! 163: if (&Apache::lonnet::is_library($server)) {
! 164: push(@libservers,$server);
! 165: }
! 166: }
! 167: if (@libservers == 1) {
! 168: if ((ref($idsref) eq 'ARRAY') && (grep(/^\Q$libservers[0]\E$/,@{$idsref}))) {
! 169: $msg = &mt('Skipping directory for [_1] as [_2] is the single library node for the domain',
! 170: $item,$libservers[0])."\n";
! 171: if ($action eq 'execute') {
! 172: print $fh $msg;
! 173: } else {
! 174: print $msg;
! 175: }
! 176: next;
! 177: }
! 178: }
! 179: &check_directory($action,"$dir/$item",$fh,$idsref,$seenref);
! 180: } else {
! 181: $msg = &mt('Domain [_1] in [_2] is unavailable',
! 182: $item,$dir)."\n";
! 183: if ($action eq 'execute') {
! 184: print $fh $msg;
! 185: } else {
! 186: print $msg;
! 187: }
! 188: next;
! 189: }
! 190: } elsif ($dir =~ m{^\Q$londocroot/res\E/($match_domain)$}) {
! 191: my $udom = $1;
! 192: if ($item =~ /^($match_username)$/) {
! 193: my $uname = $1;
! 194: $currhome = &Apache::lonnet::homeserver($uname,$udom,1);
! 195: if ($currhome eq 'no_host') {
! 196: $msg = &mt('No homeserver for user: [_1] domain: [_2]',
! 197: $uname,$udom)."\n";
! 198: if ($action eq 'execute') {
! 199: print $fh $msg;
! 200: } else {
! 201: print $msg;
! 202: }
! 203: } elsif ((ref($idsref) eq 'ARRAY') && (grep(/^\Q$currhome\E$/,@{$idsref}))) {
! 204: $msg = &mt("Skipping user: [_1] in domain: [_2] as this is the user's homeserver.",
! 205: $uname,$udom)."\n";
! 206: if ($action eq 'execute') {
! 207: print $fh $msg;
! 208: } else {
! 209: print $msg;
! 210: }
! 211: } else {
! 212: &check_directory($action,"$dir/$item",$fh,$idsref,$seenref,$currhome);
! 213: }
! 214: } else {
! 215: $msg = &mt('Username: [_1] in domain: [_2] is invalid',
! 216: $item,$udom)."\n";
! 217: if ($action eq 'execute') {
! 218: print $fh $msg;
! 219: } else {
! 220: print $msg;
! 221: }
! 222: }
! 223: } else {
! 224: &check_directory($action,"$dir/$item",$fh,$idsref,$seenref,$currhome);
! 225: }
! 226: } elsif (-f "$dir/$item") {
! 227: if ($dir =~ m{^\Q$londocroot/res\E/$match_domain/$match_username}) {
! 228: next if ($seenref->{"$dir/$item"});
! 229: if ($action eq 'execute') {
! 230: if (unlink("$dir/$item")) {
! 231: if ($item =~ /\.meta$/) {
! 232: my $nonmeta = $item;
! 233: $nonmeta =~ s/\.meta$//;
! 234: next if ((-e "$dir/$nonmeta") || ($seenref->{"$dir/$nonmeta"}));
! 235: } elsif (-e "$dir/$item.meta") {
! 236: unlink("$dir/$item.meta");
! 237: }
! 238: if ($currhome ne '') {
! 239: my $result = &Apache::lonnet::reply("unsub:$dir/$item",$currhome);
! 240: if ($result eq 'ok') {
! 241: print $fh &mt('Unsub complete for [_1] at [_2]',
! 242: "$dir/$item",$currhome)."\n";
! 243: } else {
! 244: print $fh &mt('Result of unsub for [_1] at [_2] was: [_3]',
! 245: "$dir/$item",$currhome,$result)."\n";
! 246: }
! 247: }
! 248: $seenref->{"$dir/$item"} = 1;
! 249: } else {
! 250: print $fh &mt('Failed to unlink [_1]',"$dir/$item")."\n";
! 251: }
! 252: } else {
! 253: if ($item =~ /\.meta$/) {
! 254: my $nonmeta = $item;
! 255: $nonmeta =~ s/\.meta$//;
! 256: next if (-e "$dir/$nonmeta");
! 257: print &mt('Would unlink [_1] and send unsub to [_2]',
! 258: "$dir/$item",$currhome)."\n";
! 259: } elsif (-e "$dir/$item.meta") {
! 260: print &mt('Would unlink [_1] and [_2], and send unsub to [_3]',
! 261: "$dir/$item","$dir/$item.meta",$currhome)."\n";
! 262: $seenref->{"$dir/$item.meta"} = 1;
! 263: } else {
! 264: print &mt('Would unlink [_1] and send unsub to [_2]',
! 265: "$dir/$item",$currhome)."\n";
! 266: }
! 267: $seenref->{"$dir/$item"} = 1;
! 268: }
! 269: } else {
! 270: $msg = &mt('Invalid directory [_1]',$dir)."\n";
! 271: if ($action eq 'execute') {
! 272: print $fh $msg;
! 273: } else {
! 274: print $msg;
! 275: }
! 276: }
! 277: }
! 278: }
! 279: closedir($dirh);
! 280: } else {
! 281: $msg = &mt('Could not open directory: [_1]',$dir)."\n";
! 282: if ($action eq 'execute') {
! 283: print $fh $msg;
! 284: } else {
! 285: print $msg;
! 286: }
! 287: }
! 288: return;
! 289: }
! 290:
! 291: sub get_user_selection {
! 292: my ($defaultrun) = @_;
! 293: my $do_action = 0;
! 294: my $choice = <STDIN>;
! 295: chomp($choice);
! 296: $choice =~ s/(^\s+|\s+$)//g;
! 297: my $yes = &mt('y');
! 298: if ($defaultrun) {
! 299: if (($choice eq '') || ($choice =~ /^\Q$yes\E/i)) {
! 300: $do_action = 1;
! 301: }
! 302: } else {
! 303: if ($choice =~ /^\Q$yes\E/i) {
! 304: $do_action = 1;
! 305: }
! 306: }
! 307: return $do_action;
! 308: }
! 309:
! 310: sub start_logging {
! 311: my ($fh,$action) = @_;
! 312: my $start = localtime(time);
! 313: print $fh "*****************************************************\n".
! 314: &mt('[_1] - mode is [_2].',
! 315: 'unsubresources.pl',"'$action'")."\n".
! 316: &mt('Started -- time: [_1]',$start)."\n".
! 317: "*****************************************************\n\n";
! 318: return;
! 319: }
! 320:
! 321: sub stop_logging {
! 322: my ($fh) = @_;
! 323: my $end = localtime(time);
! 324: print $fh "*****************************************************\n".
! 325: &mt('Ended -- time: [_1]',$end)."\n".
! 326: "*****************************************************\n\n\n";
! 327: close($fh);
! 328: return;
! 329: }
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