[LON-CAPA-cvs] cvs: loncom /debugging_tools check_authoring_spaces.pl
raeburn
raeburn at source.lon-capa.org
Mon Oct 9 18:17:06 EDT 2017
raeburn Mon Oct 9 22:17:06 2017 EDT
Added files:
/loncom/debugging_tools check_authoring_spaces.pl
Log:
- For published files, if last modification date of published file (Resource
Space) is later than last modification date of corresponding file in
Authoring Space, the two files should contain the same contents.
- This script can be run to detect cases where that is not true, and can
be used to overwrite the file in Authoring Space with the newer file
from Resource Space.
-------------- next part --------------
Index: loncom/debugging_tools/check_authoring_spaces.pl
+++ loncom/debugging_tools/check_authoring_spaces.pl
#!/usr/bin/perl
#
# The LearningOnline Network
#
# Compare last modification dates for files in Authoring Space with last
# modification dates for corresponding files in Resource Space.
# If file in Authoring Space is older than file in Resource Space, and
# file is not a binary file, check if files are the same.
# If files are not the same include in list for potentially overwriting
# file in Authoring space with file in Resource space.
#
# $Id: check_authoring_spaces.pl,v 1.1 2017/10/09 22:17:05 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 File::Compare;
use File::Copy;
my ($lonusersdir,$londocroot,$londaemons);
BEGIN {
my $perlvar=&LONCAPA::Configuration::read_conf();
if (ref($perlvar) eq 'HASH') {
$lonusersdir = $perlvar->{'lonUsersDir'};
$londocroot = $perlvar->{'lonDocRoot'};
$londaemons = $perlvar->{'lonDaemons'};
}
undef($perlvar);
}
my $lang = &Apache::lonlocal::choose_language();
&Apache::lonlocal::get_language_handle(undef,$lang);
if ($< != 0) {
print &mt('You must be root in order to check Authoring Spaces.')."\n".
&mt('Stopping')."\n";
exit;
}
if ($lonusersdir eq '') {
print &mt('Could not determine location of [_1] directory.',"'lonUsersDir'")."\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;
}
# Abort if more than one argument.
my $parameter=$ARGV[0];
$parameter =~ s/^\s+//;
$parameter =~ s/\s+$//;
my (undef,undef,$uid,$gid) = getpwnam('www');
if ((@ARGV > 1) || (($parameter ne '') && ($parameter !~ /^(copy|undo)$/))) {
print &mt('usage: [_1]','check_authoring_spaces.pl [copy|undo]')."\n\n".
&mt('You should enter either no arguments, or just one argument -- either copy or undo.')."\n".
&mt("copy - to copy files from Resources Space [_1] to Authoring Space [_2]",
"'$londocroot/res/'","'$londocroot/priv/'")."\n".
&mt('undo - to reverse those changes and restore overwritten files in Authoring Space back from: [_1] to [_2].',
"'/home/httpd/overwritten","'$londocroot/priv'")."\n".
&mt('no argument to do a dry run of the copy option, without actually copying anything.')."\n";
exit;
}
print "\n".&mt("Comparing last modification date for files in published authors' Authoring Spaces with files in Resource Space.")."\n".
"--------------------------------------------------------------------------------------------------------------\n\n".
&mt('If run without an argument, the script will report what it would do when copying Resource Space files to Authoring Space, i.e., from [_1] to [_2], for which: (a) the last modification time for the file in /priv predates the last modification time for the corresponding file in /res, and (b) the contents of the files differ, and (c) the file is not a binary file.',
"'$londocroot/res'","'$londocroot/priv/'")."\n\n";
my (undef,undef,$uid,$gid) = getpwnam('www');
my ($action) = ($parameter=~/^(copy|undo)$/);
if ($action eq '') {
$action = 'dryrun';
}
if ($action eq 'dryrun') {
print "\n\n".
&mt('Running in exploratory mode ...')."\n\n".
&mt('Run with argument [_1] to actually copy files from Resource Space ([_2]) to Authoring Space ([_3]), i.e., [_4]',
"'copy'","'$londocroot/res'","'$londocroot/priv'","\n\nperl check_authoring_spaces.pl copy")."\n\n\n".
&mt('Run with argument [_1] to restore previously overwritten Authoring Spaces back to [_2], i.e., [_3]',
"'undo'","'$londocroot/priv'","\n\nperl check_authoring_spaces.pl undo")."\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";
if ($action eq 'copy') {
print "\n".
&mt('Mode is [_1] -- files will be copied to [_2].',
"'$action'","'$londocroot/priv'")."\n";
} else {
print "\n".
&mt('Mode is [_1] -- files will be copied back to [_2].',
"'$action'","'$londocroot/priv'")."\n";
}
print &mt('Continue? ~[y/N~] ');
if (!&get_user_selection()) {
exit;
} else {
print "\n";
}
}
my $logfh;
if ($action ne 'dryrun') {
if (!open($logfh,">>$londaemons/logs/check_authoring_spaces.log")) {
print &mt('Could not open log file: [_1] for writing.',
"'$londaemons/logs/check_authoring_spaces.log'")."\n".
&mt('Stopping.')."\n";
exit;
} else {
&start_logging($logfh,$action);
}
}
# Authors hosted on this server
my %allauthors;
my %pubusers;
my @allskipped;
my @machinedoms;
my ($dir,$output);
if ($lonusersdir) {
if (opendir($dir,$lonusersdir)) {
my @contents = (grep(!/^\.{1,2}$/,readdir($dir)));
closedir($dir);
foreach my $item (@contents) {
if (-d "$lonusersdir/$item") {
if ($item =~ /^$match_domain$/) {
my $domain = $item;
unless (grep(/^\Q$domain\E$/, at machinedoms)) {
push(@machinedoms,$domain);
}
}
}
}
} else {
$output = &mt('Could not open [_1].',"'$lonusersdir'")."\n";
print $output;
unless ($action eq 'dryrun') {
&stop_logging($logfh,$output);
}
print &mt('Stopping')."\n";
exit;
}
}
if ($action eq 'undo') {
my (%allcopied, at allskipped);
if (-d "$londaemons/logs/checked_authoring_spaces") {
if (opendir($dir,"$londaemons/logs/checked_authoring_spaces")) {
my @contents = (grep(!/^\.{1,2}$/,readdir($dir)));
closedir($dir);
foreach my $dom (@contents) {
if ((grep(/^\Q$dom\E/, at machinedoms)) && (-d "$londaemons/logs/checked_authoring_spaces/$dom")) {
my $domdir;
if (opendir($domdir,"$londaemons/logs/checked_authoring_spaces/$dom")) {
my @unames = (grep(!/^\.{1,2}$/,readdir($domdir)));
closedir($domdir);
foreach my $uname (@unames) {
my %oldfiles;
my $skipped;
&descend_preserved_tree('',$londaemons,$dom,$uname,\%oldfiles);
print &mt('User: [_1], in domain: [_2] has [quant,_3,file].',$uname,$dom,scalar(keys(%oldfiles)))."\n".
&mt('Continue? ~[y/N~] ');
if (!&get_user_selection()) {
print &mt('Enter [_1] to skip this user.','1')."\n".
&mt('Enter [_1] to stop.','2')."\n".
&mt('Your input: ');
my $choice=<STDIN>;
chomp($choice);
$choice =~ s/^\s+//;
$choice =~ s/\s+$//;
if ($choice == 1) {
my $output = &mt('Skipping user: [_1].',"'$uname'")."\n";
print $output;
print $logfh $output;
push(@allskipped,$uname);
next;
}
if ($choice == 2) {
print &mt('Stopped.')."\n";
my $output = &mt('Stopped at user: [_1].',"'$uname'")."\n";
&stop_logging($logfh,$output);
exit;
} else {
print &mt('Invalid response:')." $choice\n";
my $output = &mt('Skipping user: [_1].',"'$uname'")."\n";
print $output;
print $logfh $output;
push(@allskipped,$uname);
next;
}
}
foreach my $key (sort(keys(%oldfiles))) {
my $output;
unless ($key eq '') {
my $source_path="$londaemons/logs/checked_authoring_spaces/$dom/$uname/$key";
my $target_path="$londocroot/priv/$dom/$uname/$key";
if (-e $source_path) {
if (File::Copy::copy($source_path,$target_path)) {
chown($uid,$gid,$target_path);
system("touch -r $source_path $target_path");
$output .= &mt('Copied [_1] to [_2].',
"'$source_path'","'$target_path'")."\n";
push(@{$allcopied{$dom}{$uname}},$key);
my $logfile;
my $logname = $target_path.'.log';
if (-e $logname) {
if (open($logfile,">>$logname")) {
print $logfile
"\n\n================= Retrieve ".localtime()." ================\n".
"Version: new\nSource: $source_path\nTarget: $target_path\n".
"Copied sucessfully.\n\n";
close($logfile);
} else {
$output .= &mt('Could not open logfile [_1] to log retrieval.',$logname)."\n";
}
} else {
$output .= &mt('Logfile [_1] does not exist.',$logname)."\n";
}
}
} else {
$output .= &mt('Source file [_1] does not exist.',$source_path)."\n";
}
}
print $logfh $output;
}
}
}
}
}
}
} else {
print &mt('Directory: [_1] does not exist',"$londaemons/logs/checked_authoring_spaces");
}
my ($copyinfo,$skipcount);
if (keys(%allcopied) == 0) {
$copyinfo = &mt('None')."\n";
} else {
foreach my $dom (sort(keys(%allcopied))) {
if (ref($allcopied{$dom}) eq 'HASH') {
$copyinfo .= "\n ".&mt('Domain: [_1], number of authors: [_2]',
"'$dom'",scalar(keys(%{$allcopied{$dom}})));
}
}
}
$skipcount = scalar(@allskipped);
print "\n";
my $output;
if ($skipcount) {
$output = &mt('You skipped: [_1].',$skipcount)."\n".
join("\n",sort(@allskipped))."\n\n";
}
$output .= &mt('Copied back ... [_1]',$copyinfo)."\n";
print $output;
print "\n".&mt('Done.')."\n";
print $logfh $output;
&stop_logging($logfh);
exit;
} elsif (($londocroot ne '') && (-d "$londocroot/res")) {
if (-d "$londocroot/res") {
my ($dir,$domdir);
if (opendir($dir,"$londocroot/res")) {
my @contents = (grep(!/^\.{1,2}$/,readdir($dir)));
closedir($dir);
foreach my $dom (@contents) {
if ((grep(/^\Q$dom\E/, at machinedoms)) && (-d "$londocroot/res/$dom")) {
if (opendir($domdir,"$londocroot/res/$dom")) {
my @unames = (grep(!/^\.{1,2}$/,readdir($domdir)));
closedir($domdir);
foreach my $uname (@unames) {
if ($uname =~ /^$match_username$/) {
push(@{$pubusers{$uname}},$dom);
}
}
}
}
}
}
}
my %allcopied;
# Iterate over directories in /home/httpd/html/res
foreach my $uname (sort(keys(%pubusers))) {
if (ref($pubusers{$uname}) eq 'ARRAY') {
foreach my $dom (@{$pubusers{$uname}}) {
my %allfiles;
&descend_res_tree('',$londocroot,$dom,$uname,\%allfiles);
if (keys(%allfiles)) {
print &mt('User: [_1], in domain: [_2] has [quant,_3,file].',$uname,$dom,scalar(keys(%allfiles)))."\n".
&mt('Continue? ~[y/N~] ');
if (!&get_user_selection()) {
print &mt('Enter [_1] to skip this user.','1')."\n".
&mt('Enter [_1] to stop.','2')."\n".
&mt('Your input: ');
my $choice=<STDIN>;
chomp($choice);
$choice =~ s/^\s+//;
$choice =~ s/\s+$//;
if ($choice == 1) {
my $output = &mt('Skipping user: [_1].',"'$uname:$dom'")."\n";
print $output;
unless ($action eq 'dryrun') {
print $logfh $output;
}
push(@allskipped,"$uname:$dom");
next;
}
if ($choice == 2) {
print &mt('Stopped.')."\n";
my $output = &mt('Stopped at user: [_1].',"'$uname'")."\n";
&stop_logging($logfh,$output);
exit;
} else {
print &mt('Invalid response:')." $choice\n";
my $output = &mt('Skipping user: [_1].',"'$uname:$dom'")."\n";
print $output;
unless ($action eq 'dryrun') {
print $logfh $output;
}
push(@allskipped,$uname);
next;
}
}
foreach my $key (sort(keys(%allfiles))) {
if ($key ne '') {
my $source_path="$londocroot/res/$dom/$uname/$key";
my $target_path="$londocroot/priv/$dom/$uname/$key";
if ($action eq 'copy') {
my $output;
if (!-e "$londaemons/logs/checked_authoring_spaces") {
mkdir("$londaemons/logs/checked_authoring_spaces",0755);
chown($uid,$gid,"$londaemons/logs/checked_authoring_spaces");
}
if (!-e "$londaemons/logs/checked_authoring_spaces/$dom") {
mkdir("$londaemons/logs/checked_authoring_spaces/$dom",0755);
chown($uid,$gid,"$londaemons/logs/checked_authoring_spaces/$dom");
}
if (!-e "$londaemons/logs/checked_authoring_spaces/$dom/$uname") {
mkdir("$londaemons/logs/checked_authoring_spaces/$dom/$uname",0755);
chown($uid,$gid,"$londaemons/logs/checked_authoring_spaces/$dom/$uname");
}
if (-e "$londaemons/logs/checked_authoring_spaces/$dom/$uname") {
my $saveold_path = "$londaemons/logs/checked_authoring_spaces/$dom/$uname/$key";
if ($key =~ m{/}) {
my @subdirs = split(/\//,$key);
my $file = pop(@subdirs);
my $path = "$londaemons/logs/checked_authoring_spaces/$dom/$uname";
while (@subdirs) {
my $dir = pop(@subdirs);
$path .= '/'.$dir;
if (!-e $path) {
mkdir($path,0755);
chown($uid,$gid,$path);
}
}
}
if (-e $target_path) {
if (File::Copy::copy($target_path,$saveold_path)) {
chown($uid,$gid,$saveold_path);
system("touch -r $target_path $saveold_path");
$output .= &mt('Copied [_1] to [_2].',
"'$target_path'","'$saveold_path'")."\n";
if (-e $source_path) {
if (File::Copy::copy($source_path,$target_path)) {
chown($uid,$gid,$target_path);
system("touch -r $source_path $target_path");
$output .= &mt('Copied [_1] to [_2].',
"'$source_path'","'$target_path'")."\n";
push(@{$allcopied{$dom}{$uname}},$key);
my $logfile;
my $logname = $target_path.'.log';
if (-e $logname) {
if (open($logfile,">>$logname")) {
print $logfile
"\n\n================= Retrieve ".localtime()." ================\n".
"Version: new\nSource: $source_path\nTarget: $target_path\n".
"Copied sucessfully.\n\n";
close($logfile);
} else {
$output .= &mt('Could not open logfile [_1] to log retrieval.',$logname)."\n";
}
} else {
$output .= &mt('Logfile [_1] does not exist.',$logname)."\n";
}
} else {
$output .= &mt('Failed to copy [_1] to [_2].',
"'$source_path'","'$target_path'")."\n";
}
} else {
$output .= &mt('Source file [_1] does not exist.',$source_path),"\n";
}
} else {
$output .= &mt('Failed to copy [_1] to [_2].',
"'$target_path'","'$saveold_path'")."\n";
}
} else {
$output .= &mt('Target file [_1] does not exist.',$target_path);
}
} else {
$output .= &mt('Directory needed to preserve pre-dated file from Authoring Space (prior to overwriting) not available.')."\n";
}
print $output;
print $logfh $output;
} elsif ($action eq 'dryrun') {
push(@{$allcopied{$dom}{$uname}},$key);
print &mt('Would copy [_1] to [_2].',"'$source_path'","'$target_path'")."\n";
}
}
}
}
}
}
}
my ($copyinfo,$skipcount);
if (keys(%allcopied) == 0) {
$copyinfo = &mt('None')."\n";
} else {
foreach my $dom (sort(keys(%allcopied))) {
if (ref($allcopied{$dom}) eq 'HASH') {
$copyinfo .= "\n ".&mt('Domain: [_1], number of authors: [_2]',
"'$dom'",scalar(keys(%{$allcopied{$dom}})));
}
}
}
$skipcount = scalar(@allskipped);
print "\n";
if ($action ne 'dryrun') {
my $output = &mt('You skipped: [_1].',$skipcount)."\n".
join("\n",sort(@allskipped))."\n\n".
&mt('Copied ... [_1]',$copyinfo)."\n";
print $output;
print $logfh $output;
&stop_logging($logfh);
} else {
if ($skipcount) {
print &mt('You would have skipped: [_1].',$skipcount)."\n".
join("\n",sort(@allskipped))."\n\n";
}
print &mt('You would have copied ... [_1]',$copyinfo);
}
print "\n\n".&mt('Done.')."\n";
}
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].',
'check_authoring_spaces.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;
}
sub descend_res_tree {
my ($dir,$londocroot,$dom,$uname,$allfiles) = @_;
my $path = "$londocroot/res/$dom/$uname";
if ($dir ne '') {
$path .= "/$dir";
}
if (-d $path) {
opendir(DIR,"$path");
my @contents = grep(!/^\./,readdir(DIR));
closedir(DIR);
foreach my $item (@contents) {
if (-d "$path/$item") {
my $newdir;
if ($dir eq '') {
$newdir = $item;
} else {
$newdir = $dir.'/'.$item;
}
&descend_res_tree($newdir,$londocroot,$dom,$uname,$allfiles);
} else {
my $newpath;
if ($dir eq '') {
$newpath = $item;
} else {
$newpath = "$dir/$item";
}
if (-f "$londocroot/res/$dom/$uname/$newpath") {
next if ($item =~ /\.(tmp|subscription|meta)$/);
next if (-B "$londocroot/res/$dom/$uname/$newpath");
my $resfile = "$londocroot/res/$dom/$uname/$newpath";
my $cstrfile = "$londocroot/priv/$dom/$uname/$newpath";
if (-f $cstrfile) {
my $lastmodres = (stat($resfile))[9];
my $lastmodcstr = (stat($cstrfile))[9];
my $delta = $lastmodres - $lastmodcstr;
if ($delta > 0) {
if (&File::Compare::compare($resfile,$cstrfile)) {
$allfiles->{$newpath} = $delta;
}
}
}
}
}
}
}
}
sub descend_preserved_tree {
my ($dir,$londaemons,$dom,$uname,$allfiles) = @_;
my $path = "$londaemons/logs/checked_authoring_spaces/$dom/$uname";
if ($dir ne '') {
$path .= "/$dir";
}
if (-d $path) {
opendir(DIR,"$path");
my @contents = grep(!/^\./,readdir(DIR));
closedir(DIR);
foreach my $item (@contents) {
if (-d "$path/$item") {
my $newdir;
if ($dir eq '') {
$newdir = $item;
} else {
$newdir = $dir.'/'.$item;
}
&descend_preserved_tree($newdir,$londaemons,$dom,$uname,$allfiles);
} elsif (-f "$path/$item") {
my $newpath;
if ($dir eq '') {
$newpath = $item;
} else {
$newpath = "$dir/$item";
}
$allfiles->{$newpath} = 1;
}
}
}
}
More information about the LON-CAPA-cvs
mailing list