Annotation of loncom/debugging_tools/move_construction_spaces.pl, revision 1.1

1.1     ! raeburn     1: #!/usr/bin/perl
        !             2: #
        !             3: # Move Construction Spaces from /home/$user/public_html
        !             4: # to /home/httpd/html/priv/$domain/$user and vice versa
        !             5: # 
        !             6: 
        !             7: use strict;
        !             8: use lib '/home/httpd/lib/perl/';
        !             9: use LONCAPA::Configuration;
        !            10: use LONCAPA qw(:DEFAULT :match);
        !            11: use Apache::lonlocal;
        !            12: use File::Copy;
        !            13: use GDBM_File;
        !            14: 
        !            15: 
        !            16: my ($parameter)=(@ARGV);
        !            17: my $lang = &Apache::lonlocal::choose_language();
        !            18: &Apache::lonlocal::get_language_handle(undef,$lang);
        !            19: print"\n";
        !            20: 
        !            21: # Abort if more than one argument.
        !            22: if (@ARGV > 1) {
        !            23:     print &mt('usage: [_1]','move_construction_spaces.pl [move|undo]')."\n\n".
        !            24:           &mt('You should enter either no arguments, or just one argument -- either move or undo.')."\n".
        !            25:           &mt("move - to move authors' Construction Spaces from: /home to /home/httpd/html/priv/domain")."\n".
        !            26:           &mt('undo - to reverse those changes and move Construction Spaces back from: /home/httpd/html/priv/domain to /home')."\n".
        !            27:           &mt('no argument to do a dry run of the move option, without actually moving anything.')."\n";
        !            28:     exit;
        !            29: }
        !            30: 
        !            31: print "\nMoving authors' Construction Spaces\n".
        !            32:       "-----------------------------\n\n".
        !            33:       "If run without an argument, the script will report what it would do\n".
        !            34:       "when moving Construction Spaces from /home to /home/httpd/html/priv/.\n\n".
        !            35:       "If there are ambiguities (i.e., the same username belongs to two domains)\n".
        !            36:       "this will be flagged, and you will be able to decide how to proceed.\n";
        !            37: 
        !            38: my $perlvar=&LONCAPA::Configuration::read_conf();
        !            39: my ($lonuserdir,$londocroot);
        !            40: if (ref($perlvar) eq 'HASH') {
        !            41:     $lonuserdir = $perlvar->{'lonUsersDir'};
        !            42:     $londocroot = $perlvar->{'lonDocRoot'};
        !            43: }
        !            44: undef($perlvar);
        !            45: 
        !            46: my $parameter=$ARGV[0];
        !            47: $parameter =~ s/^\s+//;
        !            48: $parameter =~ s/\s+$//;
        !            49: my (undef,undef,$uid,$gid) = getpwnam('www');
        !            50: my ($action) = ($parameter=~/^(move|undo)$/);
        !            51: if ($action eq '') {
        !            52:     $action = 'dryrun';
        !            53: }
        !            54: 
        !            55: if ($action eq 'dryrun') {
        !            56:     print "\nRunning in exploratory mode.\n".
        !            57:           "Run with parameter 'move' to actually move the author spaces, i.e. \n".
        !            58:           "move_construction_spaces.pl move\n\n".
        !            59:           "Run with parameter 'undo' to move author spaces back to /home, i.e. \n".
        !            60:           "move_construction_spaces.pl undo\n\n";
        !            61: } else {
        !            62:     print "\n *** Running in a mode where changes will be made.\n";
        !            63:     if ($action eq 'move') {
        !            64:         print "\nMode is $action -- directories will be moved to $londocroot/priv\n";
        !            65:     } else {
        !            66:         print "\nMode is $action -- directories will be moved back to /home\n";
        !            67:     }
        !            68:     print &mt('Continue? ~[y/N~] ');
        !            69: 
        !            70:     if (!&get_user_selection()) {
        !            71:         exit;
        !            72:     }
        !            73: }
        !            74: 
        !            75: # Authors hosted on this server
        !            76: my %allauthors;
        !            77: my %pubusers;
        !            78: 
        !            79: if ($action eq 'move') {
        !            80:     if (-d "$londocroot/priv") {
        !            81:         print "New Construction Spaces directory: '$londocroot/priv' already exists.\n";
        !            82:     } else {
        !            83:         print "\nCreating new directory: '$londocroot/priv' for Construction Spaces.\n";
        !            84:         if (mkdir("$londocroot/priv",0755)) {
        !            85:             if (chown($uid,$gid,"$londocroot/priv")) {
        !            86:                 print "Creation Successful\n";
        !            87:             } else {
        !            88:                 print "Failed to changer ownership to $uid:$gid\n";
        !            89:                 exit;
        !            90:             }
        !            91:         } else {
        !            92:             print "Failed to create directory\n";
        !            93:             exit; 
        !            94:         }
        !            95:     }
        !            96: }
        !            97: 
        !            98: my @machinedoms;
        !            99: if ($lonuserdir) {
        !           100:     my $dir;
        !           101:     if (opendir($dir,$lonuserdir)) {
        !           102:         my @contents = (grep(!/^\.{1,2}$/,readdir($dir)));
        !           103:         foreach my $item (@contents) {
        !           104:             if (-d "$lonuserdir/$item") {
        !           105:                 if ($item =~ /^$match_domain$/) {
        !           106:                     my $domain = $item;
        !           107:                     unless (grep(/^\Q$domain\E$/,@machinedoms)) {
        !           108:                         push(@machinedoms,$domain);  
        !           109:                     }
        !           110:                     my $dom_target="/home/httpd/html/priv/$domain";
        !           111:                     if ($action eq 'move') {
        !           112:                         if (!-e $dom_target) {
        !           113:                             if (mkdir($dom_target,0755)) {
        !           114:                                 chown($uid,$gid,$dom_target);
        !           115:                                 print "Made $dom_target\n";
        !           116:                             } else {
        !           117:                                 print "Failed to make $dom_target. Stopping\n";
        !           118:                                 exit;
        !           119:                             }
        !           120:                         } elsif ($action eq 'dryrun') {
        !           121:                             print "Would make $dom_target\n";
        !           122:                         }
        !           123:                     }
        !           124:                     my %authors=();
        !           125:                     my $fname = "$lonuserdir/$domain/nohist_domainroles.db";
        !           126:                     my $dbref;
        !           127:                     if (-e $fname) {
        !           128:                         $dbref=&LONCAPA::locking_hash_tie($fname,&GDBM_READER());
        !           129:                     }
        !           130:                     if (!$dbref) {
        !           131:                         print "Unable to tie to $fname";
        !           132:                     } elsif (ref($dbref) eq 'HASH') {
        !           133:                         foreach my $key (keys(%{$dbref})) {
        !           134:                             $key = &unescape($key);
        !           135:                             if ($key =~ /^au\:($match_username)\Q:$domain\E/) {
        !           136:                                 push(@{$allauthors{$1}},$domain);
        !           137:                             }
        !           138:                         }
        !           139:                         &LONCAPA::locking_hash_untie($dbref);
        !           140:                     }
        !           141:                 }
        !           142:             }
        !           143:         }
        !           144:         closedir($dir);
        !           145:     } else {
        !           146:         print "Could not open $lonuserdir.  Stopping\n";
        !           147:         exit;
        !           148:     }
        !           149: }
        !           150: 
        !           151: if ($londocroot ne '') {
        !           152:     if (-d "$londocroot/res") {
        !           153:         my ($dir,$domdir);
        !           154:         if (opendir($dir,"$londocroot/res")) {
        !           155:             my @contents = (grep(!/^\.{1,2}$/,readdir($dir)));
        !           156:             foreach my $dom (@contents) {
        !           157:                 if ((grep(/^\Q$dom\E/,@machinedoms)) && (-d "$londocroot/res/$dom")) {
        !           158:                     if (opendir($domdir,"$londocroot/res/$dom")) {
        !           159:                         my @unames = (grep(!/^\.{1,2}$/,readdir($domdir)));
        !           160:                         foreach my $uname (@unames) {
        !           161:                             if ($uname =~ /^$match_username$/) {
        !           162:                                 push(@{$pubusers{$uname}},$dom);
        !           163:                             }
        !           164:                         }
        !           165:                     }
        !           166:                 }
        !           167:             }
        !           168:         }
        !           169:     }
        !           170: }
        !           171: 
        !           172: if ($action eq 'undo') {
        !           173:     my %privspaces;
        !           174:     if ($londocroot ne '') {
        !           175:         if (-d "$londocroot/priv") {
        !           176:             my ($dir,$domdir);
        !           177:             if (opendir($dir,"$londocroot/priv")) {
        !           178:                 my @contents = (grep(!/^\.{1,2}/,readdir($dir)));
        !           179:                 foreach my $dom (@contents) {
        !           180:                     next if (!-d "$londocroot/priv/$dom");
        !           181:                     if (opendir($domdir,"$londocroot/priv/$dom")) {
        !           182:                         my @unames = (grep(!/^\.{1,2}$/,readdir($domdir)));
        !           183:                         foreach my $uname (@unames) {
        !           184:                             if ($uname =~ /^$match_username$/) {
        !           185:                                 push(@{$privspaces{$uname}},$dom);
        !           186:                             }
        !           187:                         }
        !           188:                     }
        !           189:                 }
        !           190:             }
        !           191:         }
        !           192:     }
        !           193:     foreach my $uname (keys(%privspaces)) {
        !           194:         if (ref($privspaces{$uname}) eq 'ARRAY') {
        !           195:             if (@{$privspaces{$uname}} > 1) {
        !           196:                 print "Same username used for authors in multiple domains\n".
        !           197:                       "This configuration is not supported where Construction Spaces are located in /home.\n".
        !           198:                       "You will be able to move files for just one of the domains, choose which one: \n".
        !           199:                       "The domains to choose from are: ".join(', ',@{$privspaces{$uname}})."\n".
        !           200:                       "Enter choice: ";
        !           201:                 my $choice=<STDIN>;
        !           202:                 chomp($choice);
        !           203:                 if (grep(/^\Q$choice\E$/,@{$privspaces{$uname}})) {
        !           204:                     &move_priv_to_home($londocroot,$uname,$choice);
        !           205:                 } else {
        !           206:                     print "Invalid choice of domain: $choice\n".
        !           207:                           "Skipping this user: $uname\n";
        !           208:                     next;
        !           209:                 }
        !           210:             } elsif (@{$privspaces{$uname}} == 1) {
        !           211:                     &move_priv_to_home($londocroot,$uname,$privspaces{$uname}[0]);
        !           212:             } else {
        !           213:                 print "User $uname found in $londocroot/priv was not within a domain\n";
        !           214:             }
        !           215:         }
        !           216:     }
        !           217:     print "Done\n";
        !           218:     exit;
        !           219: }
        !           220: 
        !           221: # Iterate over directories in /home
        !           222: if (opendir(my $dir,"/home")) {
        !           223:     foreach my $item (grep(!/^\.{1,2}$/,readdir($dir))) {
        !           224:         next if ($item eq 'www');
        !           225:         if (-d "/home/$item") {
        !           226: # Is there a public_html-directory?
        !           227:             if (-d "/home/$item/public_html") {
        !           228:                 my $author = $item;
        !           229:                 my ($domain,$skipped);
        !           230:                 if (ref($pubusers{$author}) eq 'ARRAY') {
        !           231:                     ($domain,$skipped) = &choose_domain($action,$author,$pubusers{$author});
        !           232:                 }
        !           233:                 if (($domain eq '') && (!$skipped)) {
        !           234:                     if (ref($allauthors{$author}) eq 'ARRAY') {
        !           235:                         ($domain,$skipped) = &choose_domain($action,$author,$allauthors{$author});
        !           236:                     }
        !           237:                 }
        !           238:                 if ($domain) { 
        !           239:                     my $source_path="/home/$author/public_html";
        !           240:                     my $target_path="$londocroot/priv/$domain/$author";
        !           241:                     if ($action eq 'move') {
        !           242:                         move($source_path,$target_path);
        !           243:                             chown($uid,$gid,$target_path);
        !           244:                             chmod($target_path,0755);
        !           245:                         print "Moved $source_path to $target_path\n";
        !           246:                     } elsif ($action eq 'dryrun') {
        !           247:                         print "Would move $source_path to $target_path\n";
        !           248:                     }
        !           249:                 } elsif (!$skipped) {
        !           250:                     print "*** WARNING: $author has no domain.\n".
        !           251:                           "Enter 1: do nothing, continue\n".
        !           252:                           "Enter 2: stop\n".
        !           253:                           "or enter domain for user to be placed into\n".
        !           254:                           "Your input: ";
        !           255:                     my $choice=<STDIN>;
        !           256:                     chomp($choice);
        !           257:                     next if ($choice ==1);
        !           258:                     if ($choice == 2) { print "Stopped.\n"; exit; } 
        !           259:                     if ($choice =~ /^$match_domain$/) {
        !           260:                         my $dompath="$londocroot/priv/$choice";
        !           261:                         my $newpath="$londocroot/priv/$choice/$author";
        !           262:                         unless (-e $dompath) {
        !           263:                             print "*** WARNING: $dompath does not yet exist.\n";
        !           264:                         }
        !           265:                         if ($action eq 'move') {
        !           266:                             print "Making author $author in domain $choice\n";
        !           267:                             unless (-e $dompath) {
        !           268:                                 print "Making $dompath\n";
        !           269:                                 mkdir($dompath,0755);
        !           270:                                 chown($uid,$gid,$dompath);
        !           271:                             }
        !           272:                             print "Making $newpath\n";
        !           273:                             mkdir($newpath,0755);
        !           274:                             chown($uid,$gid,$newpath);
        !           275:                         } elsif ($action eq 'dryrun') {
        !           276:                            print "Would make author $author in domain $choice\n";
        !           277:                            unless (-e $dompath) {
        !           278:                                print "Would make $dompath\n";
        !           279:                            }
        !           280:                            print "Would make $newpath\n";
        !           281:                         }
        !           282:                     }
        !           283:                 }
        !           284:             }
        !           285:         }
        !           286:     }
        !           287: }
        !           288: print "\nDone.\n";
        !           289: 
        !           290: sub choose_domain { 
        !           291:     my ($action,$author,$domarrayref) = @_;
        !           292:     my ($domain,$skipped);
        !           293:     if (ref($domarrayref) eq 'ARRAY') {
        !           294:          if (@{$domarrayref} > 1) {
        !           295:              print "*** ERROR: $author found in multiple domains\n".
        !           296:                    "Enter a number to choose what action to take\n";
        !           297:              my $num = 1;
        !           298:              for (my $i=0; $i<@{$domarrayref}; $i++) {
        !           299:                  print "To use: $domarrayref->[$i] enter $num\n";
        !           300:                  $num ++;
        !           301:              }
        !           302:              print "To skip this user enter: $num\n".
        !           303:                    "Your choice: ";
        !           304:              my $choice=<STDIN>;
        !           305:              chomp($choice);
        !           306:              if ($choice =~ /^\d+$/) {
        !           307:                  if (($choice == $num) || ($choice > $num)) {
        !           308:                      $skipped = 1;       
        !           309:                  } elsif (($choice < $num) && ($choice > 0)) {
        !           310:                      $domain = $domarrayref->[$choice-1];
        !           311:                  } else {
        !           312:                      print "Invalid choice\n";
        !           313:                      $skipped = 1;
        !           314:                  }
        !           315:              } else {
        !           316:                  print "Invalid choice\n";
        !           317:                  $skipped = 1;
        !           318:              }
        !           319:          } elsif (@{$domarrayref} == 1) {
        !           320:              $domain = $domarrayref->[0];
        !           321:              if ($action eq 'dryrun') {
        !           322:                  print "Would use domain: $domain for author: $author\n";
        !           323:              }
        !           324:          }
        !           325:     }
        !           326:     return ($domain,$skipped);
        !           327: }
        !           328: 
        !           329: sub move_priv_to_home {
        !           330:     my ($londocroot,$uname,$domain) = @_;
        !           331:     if ($uname =~ /^$match_username$/ && $domain =~ /^$match_domain$/) {
        !           332:         my $source_path="$londocroot/priv/$domain/$uname";
        !           333:         my $target_path="/home/$uname/public_html";
        !           334:         if (!-e "/home/$uname") {
        !           335:             if (mkdir("/home/$uname",0755)) {
        !           336:                 chown($uid,$gid,"/home/$uname");
        !           337:             } else {
        !           338:                 print "Failed to create directory /home/$uname -- not moving $source_path\n";
        !           339:             }
        !           340:         }
        !           341:         if (!-e $target_path) {
        !           342:              move($source_path,$target_path);
        !           343:              chown($uid,$gid,$target_path);
        !           344:              chmod($target_path,0755);
        !           345:              print "Moved $source_path to $target_path\n";
        !           346:         } else {
        !           347:              print "Directory $target_path already exists -- not moving $source_path\n";
        !           348:         }
        !           349:     }
        !           350:     return;
        !           351: }
        !           352: 
        !           353: sub get_user_selection {
        !           354:     my ($defaultrun) = @_;
        !           355:     my $do_action = 0;
        !           356:     my $choice = <STDIN>;
        !           357:     chomp($choice);
        !           358:     $choice =~ s/(^\s+|\s+$)//g;
        !           359:     my $yes = &mt('y');
        !           360:     if ($defaultrun) {
        !           361:         if (($choice eq '') || ($choice =~ /^\Q$yes\E/i)) {
        !           362:             $do_action = 1;
        !           363:         }
        !           364:     } else {
        !           365:         if ($choice =~ /^\Q$yes\E/i) {
        !           366:             $do_action = 1;
        !           367:         }
        !           368:     }
        !           369:     return $do_action;
        !           370: }
        !           371: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>