[LON-CAPA-cvs] cvs: loncom /debugging_tools move_construction_spaces.pl

raeburn raeburn at source.lon-capa.org
Wed Oct 26 10:19:43 EDT 2011


raeburn		Wed Oct 26 14:19:43 2011 EDT

  Added files:                 
    /loncom/debugging_tools	move_construction_spaces.pl 
  Log:
  - Script to move Construction Spaces from /home to /home/httpd/html/priv
    and vice versa.
    Work in progress.
  
  
-------------- next part --------------

Index: loncom/debugging_tools/move_construction_spaces.pl
+++ loncom/debugging_tools/move_construction_spaces.pl
#!/usr/bin/perl
#
# Move Construction Spaces from /home/$user/public_html
# to /home/httpd/html/priv/$domain/$user and vice versa
# 

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


my ($parameter)=(@ARGV);
my $lang = &Apache::lonlocal::choose_language();
&Apache::lonlocal::get_language_handle(undef,$lang);
print"\n";

# Abort if more than one argument.
if (@ARGV > 1) {
    print &mt('usage: [_1]','move_construction_spaces.pl [move|undo]')."\n\n".
          &mt('You should enter either no arguments, or just one argument -- either move or undo.')."\n".
          &mt("move - to move authors' Construction Spaces from: /home to /home/httpd/html/priv/domain")."\n".
          &mt('undo - to reverse those changes and move Construction Spaces back from: /home/httpd/html/priv/domain to /home')."\n".
          &mt('no argument to do a dry run of the move option, without actually moving anything.')."\n";
    exit;
}

print "\nMoving authors' Construction Spaces\n".
      "-----------------------------\n\n".
      "If run without an argument, the script will report what it would do\n".
      "when moving Construction Spaces from /home to /home/httpd/html/priv/.\n\n".
      "If there are ambiguities (i.e., the same username belongs to two domains)\n".
      "this will be flagged, and you will be able to decide how to proceed.\n";

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

my $parameter=$ARGV[0];
$parameter =~ s/^\s+//;
$parameter =~ s/\s+$//;
my (undef,undef,$uid,$gid) = getpwnam('www');
my ($action) = ($parameter=~/^(move|undo)$/);
if ($action eq '') {
    $action = 'dryrun';
}

if ($action eq 'dryrun') {
    print "\nRunning in exploratory mode.\n".
          "Run with parameter 'move' to actually move the author spaces, i.e. \n".
          "move_construction_spaces.pl move\n\n".
          "Run with parameter 'undo' to move author spaces back to /home, i.e. \n".
          "move_construction_spaces.pl undo\n\n";
} else {
    print "\n *** Running in a mode where changes will be made.\n";
    if ($action eq 'move') {
        print "\nMode is $action -- directories will be moved to $londocroot/priv\n";
    } else {
        print "\nMode is $action -- directories will be moved back to /home\n";
    }
    print &mt('Continue? ~[y/N~] ');

    if (!&get_user_selection()) {
        exit;
    }
}

# Authors hosted on this server
my %allauthors;
my %pubusers;

if ($action eq 'move') {
    if (-d "$londocroot/priv") {
        print "New Construction Spaces directory: '$londocroot/priv' already exists.\n";
    } else {
        print "\nCreating new directory: '$londocroot/priv' for Construction Spaces.\n";
        if (mkdir("$londocroot/priv",0755)) {
            if (chown($uid,$gid,"$londocroot/priv")) {
                print "Creation Successful\n";
            } else {
                print "Failed to changer ownership to $uid:$gid\n";
                exit;
            }
        } else {
            print "Failed to create directory\n";
            exit; 
        }
    }
}

my @machinedoms;
if ($lonuserdir) {
    my $dir;
    if (opendir($dir,$lonuserdir)) {
        my @contents = (grep(!/^\.{1,2}$/,readdir($dir)));
        foreach my $item (@contents) {
            if (-d "$lonuserdir/$item") {
                if ($item =~ /^$match_domain$/) {
                    my $domain = $item;
                    unless (grep(/^\Q$domain\E$/, at machinedoms)) {
                        push(@machinedoms,$domain);  
                    }
                    my $dom_target="/home/httpd/html/priv/$domain";
                    if ($action eq 'move') {
                        if (!-e $dom_target) {
                            if (mkdir($dom_target,0755)) {
                                chown($uid,$gid,$dom_target);
                                print "Made $dom_target\n";
                            } else {
                                print "Failed to make $dom_target. Stopping\n";
                                exit;
                            }
                        } elsif ($action eq 'dryrun') {
                            print "Would make $dom_target\n";
                        }
                    }
                    my %authors=();
                    my $fname = "$lonuserdir/$domain/nohist_domainroles.db";
                    my $dbref;
                    if (-e $fname) {
                        $dbref=&LONCAPA::locking_hash_tie($fname,&GDBM_READER());
                    }
                    if (!$dbref) {
                        print "Unable to tie to $fname";
                    } elsif (ref($dbref) eq 'HASH') {
                        foreach my $key (keys(%{$dbref})) {
                            $key = &unescape($key);
                            if ($key =~ /^au\:($match_username)\Q:$domain\E/) {
                                push(@{$allauthors{$1}},$domain);
                            }
                        }
                        &LONCAPA::locking_hash_untie($dbref);
                    }
                }
            }
        }
        closedir($dir);
    } else {
        print "Could not open $lonuserdir.  Stopping\n";
        exit;
    }
}

if ($londocroot ne '') {
    if (-d "$londocroot/res") {
        my ($dir,$domdir);
        if (opendir($dir,"$londocroot/res")) {
            my @contents = (grep(!/^\.{1,2}$/,readdir($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)));
                        foreach my $uname (@unames) {
                            if ($uname =~ /^$match_username$/) {
                                push(@{$pubusers{$uname}},$dom);
                            }
                        }
                    }
                }
            }
        }
    }
}

if ($action eq 'undo') {
    my %privspaces;
    if ($londocroot ne '') {
        if (-d "$londocroot/priv") {
            my ($dir,$domdir);
            if (opendir($dir,"$londocroot/priv")) {
                my @contents = (grep(!/^\.{1,2}/,readdir($dir)));
                foreach my $dom (@contents) {
                    next if (!-d "$londocroot/priv/$dom");
                    if (opendir($domdir,"$londocroot/priv/$dom")) {
                        my @unames = (grep(!/^\.{1,2}$/,readdir($domdir)));
                        foreach my $uname (@unames) {
                            if ($uname =~ /^$match_username$/) {
                                push(@{$privspaces{$uname}},$dom);
                            }
                        }
                    }
                }
            }
        }
    }
    foreach my $uname (keys(%privspaces)) {
        if (ref($privspaces{$uname}) eq 'ARRAY') {
            if (@{$privspaces{$uname}} > 1) {
                print "Same username used for authors in multiple domains\n".
                      "This configuration is not supported where Construction Spaces are located in /home.\n".
                      "You will be able to move files for just one of the domains, choose which one: \n".
                      "The domains to choose from are: ".join(', ',@{$privspaces{$uname}})."\n".
                      "Enter choice: ";
                my $choice=<STDIN>;
                chomp($choice);
                if (grep(/^\Q$choice\E$/,@{$privspaces{$uname}})) {
                    &move_priv_to_home($londocroot,$uname,$choice);
                } else {
                    print "Invalid choice of domain: $choice\n".
                          "Skipping this user: $uname\n";
                    next;
                }
            } elsif (@{$privspaces{$uname}} == 1) {
                    &move_priv_to_home($londocroot,$uname,$privspaces{$uname}[0]);
            } else {
                print "User $uname found in $londocroot/priv was not within a domain\n";
            }
        }
    }
    print "Done\n";
    exit;
}

# Iterate over directories in /home
if (opendir(my $dir,"/home")) {
    foreach my $item (grep(!/^\.{1,2}$/,readdir($dir))) {
        next if ($item eq 'www');
        if (-d "/home/$item") {
# Is there a public_html-directory?
            if (-d "/home/$item/public_html") {
                my $author = $item;
                my ($domain,$skipped);
                if (ref($pubusers{$author}) eq 'ARRAY') {
                    ($domain,$skipped) = &choose_domain($action,$author,$pubusers{$author});
                }
                if (($domain eq '') && (!$skipped)) {
                    if (ref($allauthors{$author}) eq 'ARRAY') {
                        ($domain,$skipped) = &choose_domain($action,$author,$allauthors{$author});
                    }
                }
                if ($domain) { 
                    my $source_path="/home/$author/public_html";
                    my $target_path="$londocroot/priv/$domain/$author";
                    if ($action eq 'move') {
                        move($source_path,$target_path);
                            chown($uid,$gid,$target_path);
                            chmod($target_path,0755);
                        print "Moved $source_path to $target_path\n";
                    } elsif ($action eq 'dryrun') {
                        print "Would move $source_path to $target_path\n";
                    }
                } elsif (!$skipped) {
                    print "*** WARNING: $author has no domain.\n".
                          "Enter 1: do nothing, continue\n".
                          "Enter 2: stop\n".
                          "or enter domain for user to be placed into\n".
                          "Your input: ";
                    my $choice=<STDIN>;
                    chomp($choice);
                    next if ($choice ==1);
                    if ($choice == 2) { print "Stopped.\n"; exit; } 
                    if ($choice =~ /^$match_domain$/) {
                        my $dompath="$londocroot/priv/$choice";
                        my $newpath="$londocroot/priv/$choice/$author";
                        unless (-e $dompath) {
                            print "*** WARNING: $dompath does not yet exist.\n";
                        }
                        if ($action eq 'move') {
                            print "Making author $author in domain $choice\n";
                            unless (-e $dompath) {
                                print "Making $dompath\n";
                                mkdir($dompath,0755);
                                chown($uid,$gid,$dompath);
                            }
                            print "Making $newpath\n";
                            mkdir($newpath,0755);
                            chown($uid,$gid,$newpath);
                        } elsif ($action eq 'dryrun') {
                           print "Would make author $author in domain $choice\n";
                           unless (-e $dompath) {
                               print "Would make $dompath\n";
                           }
                           print "Would make $newpath\n";
                        }
                    }
                }
            }
        }
    }
}
print "\nDone.\n";

sub choose_domain { 
    my ($action,$author,$domarrayref) = @_;
    my ($domain,$skipped);
    if (ref($domarrayref) eq 'ARRAY') {
         if (@{$domarrayref} > 1) {
             print "*** ERROR: $author found in multiple domains\n".
                   "Enter a number to choose what action to take\n";
             my $num = 1;
             for (my $i=0; $i<@{$domarrayref}; $i++) {
                 print "To use: $domarrayref->[$i] enter $num\n";
                 $num ++;
             }
             print "To skip this user enter: $num\n".
                   "Your choice: ";
             my $choice=<STDIN>;
             chomp($choice);
             if ($choice =~ /^\d+$/) {
                 if (($choice == $num) || ($choice > $num)) {
                     $skipped = 1;       
                 } elsif (($choice < $num) && ($choice > 0)) {
                     $domain = $domarrayref->[$choice-1];
                 } else {
                     print "Invalid choice\n";
                     $skipped = 1;
                 }
             } else {
                 print "Invalid choice\n";
                 $skipped = 1;
             }
         } elsif (@{$domarrayref} == 1) {
             $domain = $domarrayref->[0];
             if ($action eq 'dryrun') {
                 print "Would use domain: $domain for author: $author\n";
             }
         }
    }
    return ($domain,$skipped);
}

sub move_priv_to_home {
    my ($londocroot,$uname,$domain) = @_;
    if ($uname =~ /^$match_username$/ && $domain =~ /^$match_domain$/) {
        my $source_path="$londocroot/priv/$domain/$uname";
        my $target_path="/home/$uname/public_html";
        if (!-e "/home/$uname") {
            if (mkdir("/home/$uname",0755)) {
                chown($uid,$gid,"/home/$uname");
            } else {
                print "Failed to create directory /home/$uname -- not moving $source_path\n";
            }
        }
        if (!-e $target_path) {
             move($source_path,$target_path);
             chown($uid,$gid,$target_path);
             chmod($target_path,0755);
             print "Moved $source_path to $target_path\n";
        } else {
             print "Directory $target_path already exists -- not moving $source_path\n";
        }
    }
    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;
}



More information about the LON-CAPA-cvs mailing list