Return to unsubresources.pl CVS log

Up to [LON-CAPA] / loncom / debugging_tools

- Add &unsubscribe() subroutine, and use in place of lonnet::reply() in
  unsubresources.pl and in &remove_stale_resfile() in lonnet.pm

    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.2 2020/05/13 17:44:06 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:           &mt('Results will be logged in [_1].',"$londaemons/logs/unsubresources.log")."\n";
  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 '') {
  240:                                 my $result = &Apache::lonnet::unsubscribe("$dir/$item");
  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: }