#!/usr/local/bin/perl -w
print "Content-type: text/html\n\n";
print qq~
Survey Administration
~;
#use strict;
sub duplicates
{
my @projectfiles = @_;
my $existing; #in the checks directory
my @inis; #ini's in upload directory
my @multiples; #holds return value of function, code in first entry
my @duplicates; #matches files in the checks directory
my @dirs = '';
foreach(@projectfiles)
{
my $filename = substr($_, 10);
#print "projectfilesdup = ".$filename;
#print "
";
if($filename =~ /.ini$/)
{#print"filename0= ".$filename;
#print"
";
if($filename !~ /^cgi.ini$/)
{
unshift(@inis, $filename);
#print"filename2= ".$filename;
#print"
";
}
}
}
#print "inis1 =".@inis;
#print "
";
foreach(@inis)
{
#print "inis =".$_;
#print"
";
}
#return that there are no ini's(code 1)
if(@inis < 0)
{
unshift(@multiples, '1');
#print"multiples0 = ".@multiples;
return @multiples;
}
#return that there is more than 1 ini (code2)
elsif(@inis > 1)
{
unshift(@multiples, @inis);
unshift(@multiples, '2');
#print"multiples1 = ".@multiples;
#foreach(@multiples)
#{
#print"multiples=".$_;
#print"
";
#}
return @multiples;
}
# has 1 ini, check that it does not duplicate an existing project
elsif(@inis == 1)
{#print "there is 1 ini file";
$existing=candelete($inis[0]);
#print"inisexisting= ".$existing;
if($existing eq $inis[0])
{
my $duplicate = $inis[0];
unshift(@multiples, $duplicate);
unshift(@multiples, '3');
#print"multiples2 = ".@multiples;
#return code 3, single ini is a duplicate of existing project, name of duplicated project
return @multiples;
}
#return code 0, and file name of unique project
else
{
@multiples = ('0', $inis[0]);
return @multiples;
}
}
}#end sub duplicates
#takes in an array of file names, returns array of directories.
sub isdirectory
{
my @projectfiles = @_;
my @directories;
my @dirs;
#foreach(@directories)
#{
#print"at_dir =".$_;
#print"
";
# }
foreach(@projectfiles)
{
# print"projfi_in_sub_is_dir =".$_;
#print"
";
if(-d $_)
{
unshift(@directories, $_);
#print"unshift";
#print"
";
}
}
if(@directories < 1 )
{
@directories = '0';
@dirs = @directories;
return @dirs;
}
else
{
unshift(@directories, '1');
@dirs = @directories;
return @dirs;
}
} #end sub isdirectory
sub extensions
{
# all files in the upload directory, + the projectfilename in [0]
my @projectfiles = @_;
#print"insideextensions";
# files that have names and extentions that could be for valid project files, key = full file path, value = extended extension code
my %validfiles;
# holds codes corresponding with required file names in the upload directory, key = extension code, value = file name
my %required;
# holds file name of valid .asc, .htm, .html files that might already exist in html directory, key = file name, value = 0 or 1
my %multiple;
# extensions that are allowed to be uploaded, key = extension, value = extension code
my %validextensions=('.ini'=>'1','.val'=>'2','.sum'=>'3','.html'=>'4','.htm'=>'5','.asc'=>'6','.asc.ndx'=>'7','.asc.bak'=>'8','.asc.ndx.bak'=>'9','.rep'=>'10','.xml'=>'11','.xml.bak'=>'12','.gif'=>'13');
my $projectname = shift(@projectfiles);
#print"afterprojname";
$projectname = substr($projectname,0, -4);
#print"projectnameext = ".$projectname;
foreach(@projectfiles)
{
my $fullpathname = $_;
#print"fullpathname= ".$_;
#print"
";
#parse out extension
my $lcpath = lc($_);
#print"lcpath= ".$lcpath;
#print"
";
#print"has the default variable been lowercased? = ".$_;
#print"
";
my $ext;
my $lastdot = rindex($lcpath, '.');
my $lastdot2;
my $string2;
my $lastindex;
my $end;
my $theend;
#if there is no extension don't analyze the file
if($lastdot < 10)
{
next;
}
$lastindex = $lastdot +1;
#print"lastindex= ".$lastindex;
#print"
";
$string2 = substr($lcpath,0, $lastdot);
#print"string2= ".$string2;
#print"
";
$lastdot2 = rindex($string2, '.');
#print"lastdot2= ".$lastdot2;
#print"
";
if($lastdot2 > 10)
{
if($lcpath =~ /.bak$/)
{
if($lcpath =~ /.xml.bak$/)
{
$ext = '.xml.bak';
}
elsif($lcpath =~ /.asc.ndx.bak$/)
{
$ext = '.asc.ndx.bak';
}
elsif($lcpath =~ /.asc.bak$/)
{
$ext = '.asc.bak';
}
}
elsif($lcpath =~ /.asc.ndx$/)
{
$ext = '.asc.ndx';
}
}
else
{
$ext = substr($lcpath, $lastdot);
}
#print"ext= ".$ext;
#print"
";
#print"complxindx =".(index($lcpath, $ext));
#print"
";
$end = length($ext);
#print"end =".$end;
#print"
";
$theend = 0 - $end;
#print"theend =".$theend;
#print"
";
my $filefirst = substr($lcpath, 10, $theend);
#print"filefirst= ".$filefirst;
#print"
";
my $filename = substr($lcpath, 10);
#print"filename= ".$filename;
#print"
";
my $filetype = '';
if(exists $validextensions{$ext})
{
$filetype = $validextensions{$ext};
if($filetype eq '1')
{
if($filefirst eq $projectname)
{
$validfiles{$fullpathname} = '1';
$required{'1'} = $filename;
}
if($filefirst =~ /^cgi$/)
{
$validfiles{$fullpathname} = '1A';
$required{'1A'} = $filename;
}
}
if($filetype eq '2')
{
if($filefirst eq $projectname)
{
$validfiles{$fullpathname} = '2';
$required{'2'} = $filename;
}
}
if($filetype eq '3')
{
if($filefirst eq $projectname)
{
$validfiles{$fullpathname} = '3';
}
}
if($filetype eq '4')
{
if($filefirst eq $projectname)
{
$validfiles{$fullpathname} = '4';
$required{'4'} = $filename;
}
}
if($filetype eq '6')
{
if($filefirst eq $projectname)
{
$validfiles{$fullpathname} = '6';
$required{'6'} = $filename;
}
}
if($filetype eq '7')
{
if($filefirst eq $projectname)
{
$validfiles{$fullpathname} = '7';
$required{'7'} = $filename;
}
}
if($filetype eq '8')
{
if($filefirst eq $projectname)
{
$validfiles{$fullpathname} = '8';
}
}
if($filetype eq '9')
{
if($filefirst eq $projectname)
{
$validfiles{$fullpathname} = '9';
}
}
if($filetype eq '10')
{
if($filefirst eq $projectname)
{
$validfiles{$fullpathname} = '10';
}
if($filefirst =~ /2$/)
{
$validfiles{$fullpathname} = '10A';
}
}
if($filetype eq '11')
{
if($filefirst eq $projectname)
{
$validfiles{$fullpathname} = '11';
}
}
if($filetype eq '12')
{
if($filefirst eq $projectname)
{
$validfiles{$fullpathname} = '12';
}
}
if($filetype eq '13')
{
if($filefirst =~ /ezspower/)
{
$validfiles{$fullpathname} = '13';
}
}
}# close type designation loop
}# close foreach@projectfiles
#verify required files are keys in %validfiles, checking for each key of %requiredcodes is a key in %required(holds file names of required files that do exist)
my %requiredcodes=('1'=>'0','1A'=>'0','2'=>'0','4'=>'0','6'=>'0','7'=>'0');
#keys = required codes, values = file name of required file
my %requirednames;
foreach (keys %requiredcodes)
{
if($_ eq '1')
{
$requirednames{$_} = $projectname.'.ini';
}
if($_ eq '1A')
{
$requirednames{$_} = 'cgi.ini';
}
if($_ eq '2')
{
$requirednames{$_} = $projectname.'.val';
}
if($_ eq '4')
{
$requirednames{$_} = $projectname.'.html';
}
if($_ eq '6')
{
$requirednames{$_} = $projectname.'.asc';
}
if($_ eq '7')
{
$requirednames{$_} = $projectname.'.asc.ndx';
}
}
#CHECK 1
#sets values in %requiredcodes to '1' of code exists as a key in %required
my @missingfiles;
foreach (keys %requiredcodes)
{
if(exists $validfiles{$_})
{
$requiredcodes{$_} = '1';
}
}
foreach (keys %requiredcodes)
{
my $keyexists = exists($required{$_});
if($keyexists == 0)
{
unshift(@missingfiles, $requirednames{$_});
}
}
#CHECK 2
#check that non-required .asc, .htm and .html files don't duplicate files in the html directory
#use File::Glob ':glob';
#my @currentfiles = bsd_glob('../html/*');
#
# list of duplicated file names
#my @currentduplicates;
#
#foreach(@currentfiles)
# {
# my $currentfilename = substr($_, 8);
# if(exists $multiple{$currentfilename})
# {
# unshift(@currentduplicates, $currentfilename);
# }
#
#
# }
if(@missingfiles > 0)
{
unshift(@missingfiles, '0');
return @missingfiles;
}
#elsif(@currentduplicates > 0)
# {
# unshift(@currentduplicates, '1');
# return @currentduplicates;
# }
else
#return list of all complete file paths, with original case. (no errors)
{
my @verifiedfiles = keys(%validfiles);
unshift(@verifiedfiles, '2');
return @verifiedfiles;
}
}#end sub extensions
sub candelete
{
#my $eqindex = rindex($_, '=');
my $filename = $_[0];
my $verified = '0';
##print"can = ".$_[0];
#print"canfile = ".$filename;
open(USRDEL, "<../checks/useruploads.record") || print"error";
flock(USRDEL, 1);
while()
{
if($_ =~ /^$filename/)
{
#print "exists";
$verified= $filename;
#chomp $verified;
}
}
close(USRDEL);
#print"verified = ".$verified;
return $verified;
} # end candelete();
sub currentlevel
{
$subcontents = $_[0]."/*";
use File::Glob ':glob';
my @currentcontents;
my @subfiles = bsd_glob($subcontents);
foreach(@subfiles)
{
if(-d $_)
{
push(@currentcontents, $_);
}
}
if(@currentcontents)
{
#print"Current Level: ".$subcontents;
#print"
";
#print" Number of subdirectories in Current Level: ".@currentcontents;
#print"
";
foreach(@currentcontents)
{
# print"- ".$_;
# print"
";
}
}
else {#print"currentcontents is empty: ".$subcontents.".
";
}
return @currentcontents;
} #end currentlevel()
#input the name of the directory to start in
sub makepaths
{
my $startingdirectory= $_[0];
my @closedpaths;
my @openpaths;
unshift(@openpaths, $startingdirectory);
do{
my $currentdirectory = shift(@openpaths);
if(my @subs = currentlevel($currentdirectory))
{
push(@openpaths, @subs);
}
else
{
push(@closedpaths, $currentdirectory);
}
}while(@openpaths);
return @closedpaths;
} #end makepaths()
######################################################################################
#have this script take a projectname as an argument that way, user can choose which project they want to upload.
$localpath = $ENV{HTTP_HOST};
$accountname = substr($localpath, 0, -19);
use File::Glob ':glob';
my @list = bsd_glob('../upload/*');
my $chosenproject = $ENV{'QUERY_STRING'};
my @hasduplicates;
my $projectname;
#when duplicate inis are identified, the user is taken back to the useradmin page and asked to choose a project.
if($chosenproject eq '')
{
#how many ini files are there?
@hasduplicates= duplicates(@list);
if($hasduplicates[0] eq '3')
{
#matches live project
print "";
print "If your browser does not support META refresh. Return to Survey Administration page";
exit;
}
if($hasduplicates[0] eq '2')
{
# 2 or more ini's
print "";
print "If your browser does not support META refresh. Return to Survey Administration page";
exit;
}
if($hasduplicates[0] eq '1')
{
#missing files
print "";
print "If your browser does not support META refresh. Return to Survey Administration page";
exit;
}
if($hasduplicates[0] eq '0')
{
$projectname = $hasduplicates[1];
#print"hasdup=".$projectname;
}
}
elsif($chosenproject =~ /\.ini$/)
{
$projectname = $chosenproject;
$hasduplicates[0] = '1';
$hasduplicates[1] = $chosenproject;
}
else
{
$projectname = 'undefined';
$hasduplicates[0] = '1';
$hasduplicates[1] = 'undefined';
}
#print"
";
foreach(@hasduplicates)
{
#print"hasduplicates = ".$_;
#print"
";
}
@hasdirectories = isdirectory(@list);
foreach(@hasdirectories)
{
#print"directory=".$_;
#print"
";
}
#If there are subdirectories of the project level folders, check them for subdirectories
#record these names in @leveltwosubs so they can be deleted later.
#make this into a subroutine
#actually, only need verify the directory with the project name. change not made yet.
unshift(@list, $projectname);
#print"list0 =".$list[0];
my @allvalidfiles = extensions(@list);
#print"allvalidfiles = ".$allvalidfiles[0];
foreach(@allvalidfiles)
{
#print"allvalidfiles=".$_;
#print"
";
}
my $extensioncode = shift(@allvalidfiles); #code 2 is valid
#print"extensioncode= ".$extensioncode;
if($extensioncode eq '0')
{
#missing required files - output to step4:
print "";
print "If your browser does not support META refresh. Return to Survey Administration page";
exit;
}
if($extensioncode eq '1')
{
# some files duplicate existing files (.asc, .htm, .html)
print "";
print "If your browser does not support META refresh. Return to Survey Administration page";
exit;
}
my $numberoflines = @allvalidfiles;
open (USRUPL, ">>../checks/useruploads.record");
flock(USRUPL, 1);
print USRUPL "$projectname=$numberoflines\n";
foreach(@allvalidfiles)
{
my $filename = substr($_, 10);
print USRUPL "$filename\n";
}
close (USRUPL);
#move files from the upload directory into html
foreach(@allvalidfiles)
{
my $filename = substr($_, 10);
rename($_, $filename);
}
my $projectdirectoryname=substr($projectname, 0, -4);
#print"
";
#print"PROJECTdirNAME=".$projectdirectoryname;
#print"
";
if(-d "../upload/$projectdirectoryname")
{
my @substodelete = makepaths("../upload/$projectdirectoryname");
foreach(@substodelete)
{
chomp;
#print "
current directory: ".$_;
if ($_ !~ /$projectdirectoryname$/)
{
#print "
current directory: ".$_;
#print "
unlink contents: ".
unlink<$_/*>;
#print"
";
#print "remove directory: ".
rmdir($_);
#print"
";
#print"-------------------------------------------";
#print"
";
}
}
}
#print"
rename project directory =".
rename("../upload/$projectdirectoryname", $projectdirectoryname);
###print"
unlink project directory contents =".unlink<../upload/$projectdirectoryname/*>;
#print"
unlink .htaccess file =".
unlink("../upload/.htaccess");
#print"
";
#my $fullpath = "../upload/".$projectdirectoryname;
#print"fullpath = ".
if(-d "../upload/$projectdirectoryname")
{
my $fullpath = "../upload/".$projectdirectoryname;
#print"
myfullpath= ".$fullpath;
#print"
unlink upload directory contents =".
unlink<$fullpath/*>;
#print"rmdir directory= ".
rmdir($fullpath);
#print"
";
}
my $uploadpath = "../upload/";
###my $dir = "upload";
if(-d $uploadpath)
{
#alternative to glob_bsd()- open the directory for reading
#print"open uploadpath = ".
opendir(UPLOAD, $uploadpath);
my @contents = readdir(UPLOAD);
closedir(UPLOAD);
#print"
Contents = ".@contents;
foreach(@contents)
{
#print"
contents: ".$_;
if($_ !~ /(^\.$|^\.\.$)/)
{
#print"
iswriteable".(-w "../upload/$_");
if(-d "../upload/$_")#if the uploaded item is a directory
{
#resursive delete contents of unused project folders in the uplod directory
my @substodelete = makepaths("../upload/");
my @directorytree = reverse(@substodelete);
foreach(@directorytree)
{
chomp;
#print "
current directory: ".$_;
#print "
current directory: ".$_;
#print"
iswriteable".(-w $_);
#print"open uploadpath = ".
opendir(UPLOAD, $_);
my $subpath = $_;
my @contents = readdir(UPLOAD);
closedir(UPLOAD);
#print"
Contents = ".@contents;
foreach(@contents)
{
if($_ !~ /(^\.$|^\.\.$)/)
{
#print"
filename = $subpath/$_";
#print"
iswriteable".(-w "$subpath/$_");
#print"
unlink: ".
unlink("$subpath/$_");
}
}
#print "
unlink contents: ".unlink<$_/*>;
#print"
";
#print "remove directory: ".
rmdir($subpath);
#print"
";
#print"-------------------------------------------";
#print"
";
}
}else {
#print"
unlink: ".
unlink("../upload/$_");
}
}
}
#print"
stragglers deleted";#.unlink<$dir/*>;
}
#print"
unlink upload directory stragglers:".;
print "";
print "If your browser does not support META refresh. Return to Survey Administration page";