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

#!/usr/bin/perl
#
# The LearningOnline Network
#
# When an access node is being taken offline either permanently
# or for a long period of time, it would be friendly to domains
# which have library nodes from which resources have been replicated
# to unsubscribe from the resources, to avoid accumulation of
# delayed "update" transactions in lonnet.perm.log on the library
# nodes which are the home servers for the authors of the replicated
# resources, in the event that the author publishes updated version(s).
#
# $Id: unsubresources.pl,v 1.2 2020/05/13 17:44:06 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
#################################################

use strict;
use lib '/home/httpd/lib/perl/';
use LONCAPA::Configuration;
use LONCAPA qw(:DEFAULT :match);
use Apache::lonlocal;
use Apache::lonnet;

my ($londocroot,$londaemons);

BEGIN {
    my $perlvar=&LONCAPA::Configuration::read_conf();
    if (ref($perlvar) eq 'HASH') {
        $londocroot = $perlvar->{'lonDocRoot'};
        $londaemons = $perlvar->{'lonDaemons'};
    }
    undef($perlvar);
}

my $lang = &Apache::lonlocal::choose_language();
&Apache::lonlocal::get_language_handle(undef,$lang);

my $parameter=$ARGV[0];
$parameter =~ s/^\s+//;
$parameter =~ s/\s+$//;

if ((@ARGV > 1) || (($parameter ne '') && ($parameter ne 'execute'))) {
    print &mt('usage: [_1]','unsubresources.pl [dryrun|execute]')."\n\n".
          &mt('You should enter either no arguments, or just one argument: execute.')."\n".
          &mt("execute - to unlink resources in [_1], and send unsub request to homeserver of resource author",
              "$londocroot/res/'")."\n".
          &mt('no argument to do a dry run, without actually unlinking or unsubscribing anything.')."\n";
    exit;
}

my $wwwid=getpwnam('www');
if ($wwwid!=$<) {
    print &mt('This must be run as user www in order to unsubscribe previously subscribed resources.')."\n".
          &mt('Stopping')."\n";
    exit;
}

if ($londocroot eq '') {
    print &mt('Could not determine location of [_1] directory.',"'lonDocRoot'")."\n".
          &mt('Stopping')."\n";
    exit;
}
if ($londaemons eq '') {
    print &mt('Could not determine location of [_1] directory.',"'lonDaemons'")."\n".
          &mt('Stopping')."\n";
    exit;
}

# Get machine IDs
my @ids=&Apache::lonnet::current_machine_ids();

print "\n".&mt("Unlinking and unsubscribing resources in $londocroot/res/")."\n".
      &mt('No changes will occur for resources for which this server is the homeserver of the author of the resource.')."\n".
      "-----------------------------\n\n".
      &mt('If run without an argument, the script will report what it would do when unlinking and unsubscribing resources in [_1].',
          "'$londocroot/res/'")."\n\n";

my ($action) = ($parameter=~/^(execute)$/);
if ($action eq '') {
    $action = 'dryrun';
}

if ($action eq 'dryrun') {
    print "\n".
          &mt('Running in exploratory mode ...')."\n\n".
          &mt('Run with argument [_1] to actually unlink and unsubscribe resources in [_2], i.e., [_3]',
              "'execute'","'$londocroot/res/'","\n\nperl unsubresources.pl execute")."\n\n\n".
          &mt('Continue? ~[y/N~] ');
    if (!&get_user_selection()) {
        exit;
    } else {
        print "\n";
    }
} else {
    print "\n *** ".&mt('Running in a mode where changes will be made.')." ***\n";
    print "\n".
          &mt('Mode is [_1] -- replicated resources in [_2] will be unlinked and unsubscribed.',
              "'$action'","'$londocroot/res/'")."\n".
          &mt('Results will be logged in [_1].',"$londaemons/logs/unsubresources.log")."\n";
    print &mt('Continue? ~[y/N~] ');
    if (!&get_user_selection()) {
        exit;
    } else {
        print "\n";
    }
}

my $dir = "$londocroot/res";
my %alreadyseen;

my $logfh;
unless ($action eq 'dryrun') {
    if (!open($logfh,'>>',"$londaemons/logs/unsubresources.log")) {
        print &mt('Could not open log file: [_1] for writing.',
                  "'$londaemons/logs/unsubresources.log'")."\n".
              &mt('Stopping.')."\n";
        exit;
    } else {
        &start_logging($logfh,$action);
    }
}
&check_directory($action,$dir,$logfh,\@ids,\%alreadyseen);
unless ($action eq 'dryrun') {
    &stop_logging($logfh);
}
print "\n".&mt('Done')."\n";
exit;

sub check_directory {
    my ($action,$dir,$fh,$idsref,$seenref,$currhome) = @_;
    my $msg;
    if (opendir(my $dirh,$dir)) {
        while (my $item=readdir($dirh)) {
            next if ($item =~ /^\./);
            if (-d "$dir/$item") {
                if ($dir eq "$londocroot/res") {
                    next if (($item eq 'adm') || ($item eq 'lib') || ($item eq 'res'));
                    if (&Apache::lonnet::domain($item) ne '') {
                        my %servers = &Apache::lonnet::get_unique_servers($item);
                        my @libservers;
                        foreach my $server (keys(%servers)) {
                            if (&Apache::lonnet::is_library($server)) {
                                push(@libservers,$server); 
                            }
                        }
                        if (@libservers == 1) {
                            if ((ref($idsref) eq 'ARRAY') && (grep(/^\Q$libservers[0]\E$/,@{$idsref}))) {
                                $msg = &mt('Skipping directory for [_1] as [_2] is the single library node for the domain',
                                           $item,$libservers[0])."\n";
                                if ($action eq 'execute') {
                                    print $fh $msg;
                                } else {
                                    print $msg;
                                }
                                next;
                            }
                        }
                        &check_directory($action,"$dir/$item",$fh,$idsref,$seenref);
                    } else {
                        $msg = &mt('Domain [_1] in [_2] is unavailable',
                                   $item,$dir)."\n";
                        if ($action eq 'execute') {
                            print $fh $msg;
                        } else {
                            print $msg;
                        }
                        next;
                    }
                } elsif ($dir =~ m{^\Q$londocroot/res\E/($match_domain)$}) {
                    my $udom = $1;
                    if ($item =~ /^($match_username)$/) {
                        my $uname = $1;
                        $currhome = &Apache::lonnet::homeserver($uname,$udom,1);
                        if ($currhome eq 'no_host') {
                            $msg = &mt('No homeserver for user: [_1] domain: [_2]',
                                       $uname,$udom)."\n";
                            if ($action eq 'execute') {
                                print $fh $msg;
                            } else {
                                print $msg;
                            }
                        } elsif ((ref($idsref) eq 'ARRAY') && (grep(/^\Q$currhome\E$/,@{$idsref}))) {
                            $msg = &mt("Skipping user: [_1] in domain: [_2] as this is the user's homeserver.",
                                       $uname,$udom)."\n"; 
                            if ($action eq 'execute') {
                                print $fh $msg;
                            } else {
                                print $msg;
                            }
                        } else {
                            &check_directory($action,"$dir/$item",$fh,$idsref,$seenref,$currhome);
                        }
                    } else {
                        $msg = &mt('Username: [_1] in domain: [_2] is invalid',
                                   $item,$udom)."\n";
                        if ($action eq 'execute') {
                            print $fh $msg;
                        } else {
                            print $msg;
                        }
                    }
                } else {
                    &check_directory($action,"$dir/$item",$fh,$idsref,$seenref,$currhome);
                }
            } elsif (-f "$dir/$item") {
                if ($dir =~ m{^\Q$londocroot/res\E/$match_domain/$match_username}) {
                    next if ($seenref->{"$dir/$item"});
                    if ($action eq 'execute') {
                        if (unlink("$dir/$item")) {
                            if ($item =~ /\.meta$/) {
                                my $nonmeta = $item;
                                $nonmeta =~ s/\.meta$//;
                                next if ((-e "$dir/$nonmeta") || ($seenref->{"$dir/$nonmeta"}));
                            } elsif (-e "$dir/$item.meta") {
                                unlink("$dir/$item.meta");
                            }
                            if ($currhome ne '') {
                                my $result = &Apache::lonnet::unsubscribe("$dir/$item");
                                if ($result eq 'ok') {
                                    print $fh &mt('Unsub complete for [_1] at [_2]',
                                                     "$dir/$item",$currhome)."\n";
                                } else {
                                    print $fh &mt('Result of unsub for [_1] at [_2] was: [_3]',
                                                     "$dir/$item",$currhome,$result)."\n";
                                }
                            }
                            $seenref->{"$dir/$item"} = 1;
                        } else {
                            print $fh &mt('Failed to unlink [_1]',"$dir/$item")."\n"; 
                        }
                    } else {
                        if ($item =~ /\.meta$/) {
                            my $nonmeta = $item;
                            $nonmeta =~ s/\.meta$//;
                            next if (-e "$dir/$nonmeta");
                            print &mt('Would unlink [_1] and send unsub to [_2]',
                                      "$dir/$item",$currhome)."\n";
                        } elsif (-e "$dir/$item.meta") {
                            print &mt('Would unlink [_1] and [_2], and send unsub to [_3]',
                                      "$dir/$item","$dir/$item.meta",$currhome)."\n";
                            $seenref->{"$dir/$item.meta"} = 1;
                        } else {
                            print &mt('Would unlink [_1] and send unsub to [_2]',
                                      "$dir/$item",$currhome)."\n";
                        }
                        $seenref->{"$dir/$item"} = 1;
                    }
                } else {
                    $msg = &mt('Invalid directory [_1]',$dir)."\n";
                    if ($action eq 'execute') {
                        print $fh $msg;
                    } else {
                        print $msg;
                    }
                }
            }
        }
        closedir($dirh);
    } else {
        $msg = &mt('Could not open directory: [_1]',$dir)."\n";
        if ($action eq 'execute') {
            print $fh $msg;
        } else {
            print $msg;
        }
    }
    return;
}

sub get_user_selection {
    my ($defaultrun) = @_;
    my $do_action = 0;
    my $choice = <STDIN>;
    chomp($choice);
    $choice =~ s/(^\s+|\s+$)//g;
    my $yes = &mt('y');
    if ($defaultrun) {
        if (($choice eq '') || ($choice =~ /^\Q$yes\E/i)) {
            $do_action = 1;
        }
    } else {
        if ($choice =~ /^\Q$yes\E/i) {
            $do_action = 1;
        }
    }
    return $do_action;
}

sub start_logging {
    my ($fh,$action) = @_;
    my $start = localtime(time);
    print $fh "*****************************************************\n".
              &mt('[_1] - mode is [_2].',
                  'unsubresources.pl',"'$action'")."\n".
              &mt('Started -- time: [_1]',$start)."\n".
              "*****************************************************\n\n";
    return;
}

sub stop_logging {
    my ($fh) = @_;
    my $end = localtime(time);
    print $fh "*****************************************************\n".
               &mt('Ended -- time: [_1]',$end)."\n".
              "*****************************************************\n\n\n";
    close($fh);
    return;
}