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