You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
467 lines
13 KiB
467 lines
13 KiB
#!/usr/bin/perl
|
|
#
|
|
# $Id: sclient.pl,v 1.12 2006/11/28 21:07:48 psims Exp $
|
|
#
|
|
# Source File: sclient.pl
|
|
|
|
# Get config
|
|
require 'sitecfg.pl';
|
|
require 'languagelib.pl';
|
|
|
|
&app_initialize;
|
|
|
|
print "Content-Type: text/html\n\n";
|
|
|
|
|
|
if (&get_session($FORM{'tid'})) {
|
|
&LanguageSupportInit();
|
|
$ok = GetLanguageElement($SESSION{lang}, 566);
|
|
if ($FORM{'dbop'} eq 'cnew') {
|
|
&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "Create New Client");
|
|
&open_results;
|
|
if ($FORM{'restore'} eq '') {
|
|
&client_create_response;
|
|
} else {
|
|
&client_restore_response;
|
|
}
|
|
&close_results;
|
|
} else {
|
|
if ( $FORM{'dbop'} eq 'cupd') {
|
|
&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "Edit Client $FORM{'clid'}");
|
|
&open_results;
|
|
if ($SESSION{'uac'} eq 'gadmin') {
|
|
&client_update_response;
|
|
} else {
|
|
print "Illegal attempt to access this page.\n";
|
|
}
|
|
&close_results;
|
|
} elsif ( $FORM{'dbop'} eq 'ccupd') {
|
|
&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "Edit Client $FORM{'clid'}");
|
|
&open_results;
|
|
if ($SESSION{'uac'} eq 'admin' || $SESSION{'uac'} eq 'madmin') {
|
|
&put_client_profile("0");
|
|
&get_client_profile($FORM{'clid'});
|
|
&pushEmlAcl($FORM{'clid'}, $FORM{'emlaclstr'});
|
|
print "Company Profile $CLIENT{'clid'} $CLIENT{'clnmc'} saved ...<BR>\n";
|
|
} else {
|
|
print "Illegal attempt to access this page.\n";
|
|
}
|
|
&close_results;
|
|
} else {
|
|
print "Illegal attempt to access this page.\n";
|
|
}
|
|
}
|
|
} else {
|
|
&logger::logwarn("Bogus session for form tid '$FORM{'tid'}'");
|
|
}
|
|
|
|
sub client_update_response {
|
|
&put_client_profile("0");
|
|
&get_client_profile($FORM{'clid'});
|
|
print "Profile $CLIENT{'clid'} $CLIENT{'clnmc'} Saved ...<BR>\n";
|
|
|
|
# upload logos
|
|
&process_client_logos;
|
|
|
|
# copy tests
|
|
&process_copy_tests;
|
|
|
|
# recreate index.htm
|
|
&get_client_profile($FORM{'clid'});
|
|
$infile = join($pathsep, $dataroot, "index.std");
|
|
open (TMPFILE, "<$infile");
|
|
@copylines = <TMPFILE>;
|
|
close (TMPFILE);
|
|
$tofile = join($pathsep, $pubroot, "$CLIENT{'clid'}", "index.htm");
|
|
$SYSTEM{'message'} = "";
|
|
open (TMPFILE, ">$tofile");
|
|
foreach $copyline (@copylines) {
|
|
if ($copyline =~ /<%=CLIENT\.(.*)%>/i ) {
|
|
for (keys %CLIENT) {
|
|
$repl = $CLIENT{$_};
|
|
$srch = join('', "<%=CLIENT.", $_, "%>");
|
|
$copyline =~ s/$srch/$repl/g;
|
|
}
|
|
}
|
|
print TMPFILE $copyline;
|
|
}
|
|
close TMPFILE;
|
|
print "$CLIENT{'clid'} $CLIENT{'clnmc'} home page updated ...<BR>\n";
|
|
}
|
|
|
|
sub process_client_logos {
|
|
for $imgfile (clorgaimg,cldeptaimg,clunitaimg) {
|
|
my $uimgfile = upload($imgfile);
|
|
if (defined($uimgfile)) {
|
|
# some browsers send path info - gotta remove it
|
|
my $imgfilename = param($imgfile);
|
|
$imgfilename =~ s/\//;/g;
|
|
$imgfilename =~ s/\\/;/g;
|
|
my @imgfilepath = split(/;/, $imgfilename);
|
|
$imgfilename = $imgfilepath[$#imgfilepath];
|
|
my @imgfilenameparts = split(/\./, $imgfilename);
|
|
my $imgfilenameext = $imgfilenameparts[$#imgfilenameparts];
|
|
@imgfilepath = ();
|
|
@imgfilenameparts = ();
|
|
|
|
if ($imgfile eq 'clorgaimg') {
|
|
$upfile = join($pathsep, $pubroot, "graphic", "$CLIENT{'clorga'}.$imgfilenameext");
|
|
} elsif ($imgfile eq 'cldeptaimg') {
|
|
$upfile = join($pathsep, $pubroot, "graphic", "$CLIENT{'clorga'}.$CLIENT{'cldepta'}.$imgfilenameext");
|
|
} elsif ($imgfile eq 'clunitaimg') {
|
|
$upfile = join($pathsep, $pubroot, "graphic", "$CLIENT{'clorga'}.$CLIENT{'cldepta'}.$CLIENT{'clunita'}.$imgfilenameext");
|
|
} else {
|
|
$upfile = "";
|
|
}
|
|
unless ($upfile eq '') {
|
|
print "Uploading $upfile ...";
|
|
open (OUTFILE, ">$upfile") or $msg="failed";
|
|
if ($msg ne "failed") {
|
|
while (<$uimgfile>) {
|
|
print OUTFILE $_;
|
|
}
|
|
|
|
close OUTFILE;
|
|
$chmodok = chmod 0666, $upfile;
|
|
}
|
|
print "$ok<BR>\n";
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
sub process_copy_tests {
|
|
opendir (GDIR, "$testgraphic");
|
|
@dots = readdir(GDIR);
|
|
closedir GDIR;
|
|
|
|
@testlist = &get_data("tests.std");
|
|
@copytests = split(/\&/, $FORM{'copytests'});
|
|
shift(@copytests);
|
|
$tofile = join($pathsep, $dataroot, "tests.$CLIENT{'clid'}");
|
|
open (UPDFILE, ">>$tofile");
|
|
foreach $testtocopy (@testlist) {
|
|
($id, $trash) = split(/&/, $testtocopy);
|
|
foreach $copytest (@copytests) {
|
|
if ($id eq $copytest) {
|
|
print UPDFILE "$testtocopy";
|
|
|
|
# copy all test questions
|
|
$fromfile = join($pathsep, $questionroot, "$copytest.std");
|
|
$tofile = join($pathsep, $questionroot, "$copytest.$CLIENT{'clid'}");
|
|
print "Creating $tofile ...";
|
|
if ( ©_file($tofile, $fromfile, 0) ) {
|
|
print "$ok<BR>\n";
|
|
} else {
|
|
print "Unable to copy $tofile : $! <BR>\n";
|
|
}
|
|
# copy files
|
|
my @testfiles;
|
|
my @files;
|
|
opendir (DIR, "$dataroot");
|
|
@testfiles = grep /$copytest\.std/, readdir(DIR);
|
|
closedir DIR;
|
|
foreach $testfile (@testfiles) {
|
|
$back = substr($testfile, rindex($testfile,"\.")+1);
|
|
$fromfile = join($pathsep, $dataroot, $testfile);
|
|
$tofile = join($pathsep, $questionroot, "$copytest.$CLIENT{'clid'}.$back");
|
|
print "Creating $tofile ...";
|
|
if (©_file($tofile, $fromfile, 0) ) {
|
|
print "$ok<BR>\n";
|
|
} else {
|
|
print "Unable to copy $tofile : $! <BR>\n";
|
|
}
|
|
#print "This is $copytest.$CLIENT{'clid'}.$back <BR>\n";
|
|
}
|
|
|
|
$rmmask = "std.$copytest.";
|
|
foreach $rmfile (@dots) {
|
|
if ($rmfile =~ /$rmmask/ ) {
|
|
$fromfile = join($pathsep, $testgraphic, $rmfile);
|
|
$rmfile =~ s/std/$CLIENT{'clid'}/;
|
|
$tofile = join($pathsep, $testgraphic, $rmfile);
|
|
print "Creating $tofile ... ";
|
|
if ( cpbin($fromfile, $tofile) ) {
|
|
print "$ok<BR>\n";
|
|
} else {
|
|
print "Unable to copy $tofile : $! ...<BR>\n";
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
close UPDFILE;
|
|
@testlist = ();
|
|
@dots = ();
|
|
}
|
|
|
|
sub client_create_response {
|
|
$folderfound=0;
|
|
$clientDir = "$pubroot/$FORM{'clid'}";
|
|
print "Checking for $FORM{'clid'} folder in $pubroot ... ";
|
|
&logger::logdbg("Checking for $FORM{'clid'} folder in $pubroot ... ");
|
|
if ( ! -d $clientDir ) {
|
|
print "<BR>Creating profile [$FORM{'clid'}] ... ";
|
|
if ( ! mkdir($clientDir, $clientDir_umask) ) {
|
|
$reason = $!;
|
|
$message = "Profile folder [$FORM{'clid'}] cannot be created. Reason: $reason\n";
|
|
&logger::logerr($message);
|
|
print qq{<FONT COLOR="#FF0000">$message</FONT><BR>\n};
|
|
print "Contact the host webmaster to correct this issue.<BR>\n";
|
|
return;
|
|
} else {
|
|
&logmsg(sprintf("mkdir $clientDir %o", $clientDir_umask));
|
|
print "$ok<BR>\n";
|
|
}
|
|
} elsif ( ! -r $clientDir ) {
|
|
$message = "Profile folder [$FORM{'clid'}] is not readable.\n";
|
|
&logger::logerr($message);
|
|
print qq{<FONT COLOR="#FF0000">$message</FONT><BR>\n};
|
|
print "Contact the host webmaster to correct this issue.<BR>\n";
|
|
return;
|
|
} else {
|
|
&logmsg("Directory '$clientDir' already exists, no need to create, but might mean someone is continuing to create it manually when the software now does it automatically (training issue).");
|
|
print "$ok<BR>\n";
|
|
}
|
|
&put_client_profile("1");
|
|
&get_client_profile($FORM{'clid'});
|
|
print "Profile $CLIENT{'clid'} $CLIENT{'clnmc'} saved ...<BR>\n";
|
|
|
|
# upload logos
|
|
&process_client_logos;
|
|
|
|
# create cnd file
|
|
$fromfile = join($pathsep, $dataroot, "cnd.std");
|
|
$tofile = join($pathsep, $dataroot, "cnd.$CLIENT{'clid'}");
|
|
print "Creating $tofile ...\n";
|
|
if ( &make_file($tofile, $fromfile, 1) ) {
|
|
print "$ok<BR>\n";
|
|
} else {
|
|
print "Unable to create $tofile : $! <BR>\n";
|
|
}
|
|
|
|
# create reports file
|
|
$fromfile = join($pathsep, $dataroot, "reports.std");
|
|
$tofile = join($pathsep, $dataroot, "reports.$CLIENT{'clid'}");
|
|
print "Creating $tofile ...\n";
|
|
if ( &make_file($tofile, $fromfile, 0) ) {
|
|
print "$ok<BR>\n";
|
|
} else {
|
|
print "Unable to create $tofile : $! <BR>\n";
|
|
}
|
|
|
|
# create tests file
|
|
$fromfile = join($pathsep, $dataroot, "tests.std");
|
|
$tofile = join($pathsep, $dataroot, "tests.$CLIENT{'clid'}");
|
|
print "Creating $tofile ...\n";
|
|
if ( &make_file($tofile, $fromfile, 1) ) {
|
|
print "$ok<BR>\n";
|
|
} else {
|
|
print "Unable to create $tofile : $! <BR>\n";
|
|
}
|
|
|
|
# copy tests
|
|
&process_copy_tests;
|
|
|
|
# create index.htm
|
|
&get_client_profile($FORM{'clid'});
|
|
$infile = join($pathsep, $dataroot, "index.std");
|
|
open (TMPFILE, "<$infile");
|
|
@copylines = <TMPFILE>;
|
|
close (TMPFILE);
|
|
$tofile = join($pathsep, $pubroot, "$CLIENT{'clid'}", "index.htm");
|
|
print "Generating $tofile ...";
|
|
$SYSTEM{'message'} = "";
|
|
open (TMPFILE, ">$tofile");
|
|
foreach $copyline (@copylines) {
|
|
if ($copyline =~ /<%=CLIENT\.(.*)%>/i ) {
|
|
for (keys %CLIENT) {
|
|
$repl = $CLIENT{$_};
|
|
$srch = join('', "<%=CLIENT.", $_, "%>");
|
|
$copyline =~ s/$srch/$repl/g;
|
|
}
|
|
}
|
|
print TMPFILE $copyline;
|
|
}
|
|
close TMPFILE;
|
|
print "OK<BR>\n";
|
|
|
|
# add administrative login
|
|
$id = $CLIENT{'clid'};
|
|
$id =~ s/\.//g;
|
|
$crec = join('&', $id, $FORM{'pwd'}, "admin", $CLIENT{'clid'});
|
|
my $adminfile = join($pathsep, $dataroot, "admin.dat");
|
|
print "Creating admin login ...";
|
|
if ( open (TMPFILE, ">>$adminfile") ) {
|
|
print TMPFILE "$crec\n";
|
|
close TMPFILE;
|
|
print "$ok<BR>\n";
|
|
} else {
|
|
print "Unable to create admin login in $adminfile : $! ...<BR>\n";
|
|
&logger::logerr("Unable to create admin login in $adminfile : $!\n");
|
|
}
|
|
}
|
|
|
|
sub client_restore_response {
|
|
# open preservation file
|
|
$trash = join($pathsep, $dataroot, "$FORM{'clid'}.dat");
|
|
$trash =~ s/$docroot/$archiveroot/g;
|
|
if ($FORM{'clnmc'} eq '') {
|
|
open (ARCHFILE, "<$trash") or return 0;
|
|
@archrecs = <ARCHFILE>;
|
|
close ARCHFILE;
|
|
$cnt = unlink $trash;
|
|
|
|
@crecs = &get_data("clients.dat");
|
|
@flds = split(/&/, $crecs[0]);
|
|
$nflds = $#flds;
|
|
@crecs = ();
|
|
@archvals = split(/&/, $archrecs[0]);
|
|
for (0 .. $nflds) {
|
|
$FORM{$flds[$_]} = $archvals[$_];
|
|
}
|
|
@archvals = ();
|
|
@flds = ();
|
|
@crecs = ();
|
|
} else {
|
|
$cnt = unlink $trash;
|
|
}
|
|
|
|
&put_client_profile("1");
|
|
&get_client_profile($FORM{'clid'});
|
|
print "Profile $CLIENT{'clid'} $CLIENT{'clnmc'} Restored ...<BR>\n";
|
|
|
|
# restore graphics
|
|
$dir1 = join($pathsep, $pubroot, "graphic");
|
|
$dir1 =~ s/$docroot/$archiveroot/g;
|
|
opendir (GDIR, "$dir1");
|
|
@dots = readdir(GDIR);
|
|
closedir GDIR;
|
|
foreach $rmfile (@dots) {
|
|
if ($rmfile =~ /$CLIENT{'clid'}./ ) {
|
|
$tofile = join($pathsep, $pubroot, "graphic", "$rmfile");
|
|
$fromfile = $tofile;
|
|
$fromfile =~ s/$docroot/$archiveroot/ ;
|
|
rename $fromfile, $tofile;
|
|
$chmodok = chmod 0666, $tofile;
|
|
print "$tofile restored ...<BR>\n";
|
|
}
|
|
}
|
|
|
|
# upload logos
|
|
&process_client_logos;
|
|
|
|
# restore cnd file
|
|
$tofile = join($pathsep, $dataroot, "cnd.$CLIENT{'clid'}");
|
|
$fromfile = $tofile;
|
|
$fromfile =~ s/$docroot/$archiveroot/g;
|
|
rename $fromfile, $tofile;
|
|
$chmodok = chmod 0666, $tofile;
|
|
print "$tofile restored ...<BR>\n";
|
|
|
|
# restore reports file
|
|
$tofile = join($pathsep, $dataroot, "reports.$CLIENT{'clid'}");
|
|
$fromfile = $tofile;
|
|
$fromfile =~ s/$docroot/$archiveroot/g;
|
|
rename $fromfile, $tofile;
|
|
$chmodok = chmod 0666, $tofile;
|
|
print "$tofile restored ...<BR>\n";
|
|
|
|
# create tests file
|
|
$tofile = join($pathsep, $dataroot, "tests.$CLIENT{'clid'}");
|
|
$fromfile = $tofile;
|
|
$fromfile =~ s/$docroot/$archiveroot/g;
|
|
rename $fromfile, $tofile;
|
|
$chmodok = chmod 0666, $tofile;
|
|
print "$tofile restored ...<BR>\n";
|
|
|
|
# restore test graphics
|
|
$dir1 = $testgraphic;
|
|
$dir1 =~ s/$docroot/$archiveroot/g;
|
|
opendir (GDIR, "$dir1");
|
|
@dots = readdir(GDIR);
|
|
closedir GDIR;
|
|
foreach $rmfile (@dots) {
|
|
if ($rmfile =~ /$CLIENT{'clid'}./ ) {
|
|
$tofile = join($pathsep, $testgraphic, "$rmfile");
|
|
$fromfile = $tofile;
|
|
$fromfile =~ s/$docroot/$archiveroot/ ;
|
|
rename $fromfile, $tofile;
|
|
$chmodok = chmod 0666, $tofile;
|
|
print "$tofile restored ...<BR>\n";
|
|
}
|
|
}
|
|
|
|
# restore test questions
|
|
$dir1 = $questionroot;
|
|
$dir1 =~ s/$docroot/$archiveroot/g;
|
|
opendir (GDIR, "$dir1");
|
|
@dots = readdir(GDIR);
|
|
closedir GDIR;
|
|
foreach $rmfile (@dots) {
|
|
if ($rmfile =~ /.$CLIENT{'clid'}/ ) {
|
|
$tofile = join($pathsep, $questionroot, "$rmfile");
|
|
$fromfile = $tofile;
|
|
$fromfile =~ s/$docroot/$archiveroot/ ;
|
|
rename $fromfile, $tofile;
|
|
$chmodok = chmod 0666, $tofile;
|
|
print "$tofile restored ...<BR>\n";
|
|
}
|
|
}
|
|
|
|
# create index.htm
|
|
&get_client_profile($FORM{'clid'});
|
|
$infile = join($pathsep, $dataroot, "index.std");
|
|
open (TMPFILE, "<$infile");
|
|
@copylines = <TMPFILE>;
|
|
close (TMPFILE);
|
|
$tofile = join($pathsep, $pubroot, "$CLIENT{'clid'}", "index.htm");
|
|
print "Generating $tofile ...";
|
|
$SYSTEM{'message'} = "";
|
|
open (TMPFILE, ">$tofile");
|
|
foreach $copyline (@copylines) {
|
|
if ($copyline =~ /<%=CLIENT\.(.*)%>/i ) {
|
|
for (keys %CLIENT) {
|
|
$repl = $CLIENT{$_};
|
|
$srch = join('', "<%=CLIENT.", $_, "%>");
|
|
$copyline =~ s/$srch/$repl/g;
|
|
}
|
|
}
|
|
print TMPFILE $copyline;
|
|
}
|
|
close TMPFILE;
|
|
print "$tofile created $! ...<BR>\n";
|
|
|
|
# add administrative login
|
|
$trash = join($pathsep, $dataroot, "admin.dat");
|
|
open (TMPFILE, ">>$trash");
|
|
if ($FORM{'clnmc'} eq '') {
|
|
print TMPFILE "$archrecs[1]";
|
|
($id, $pwd, $trash) = split (/&/, $archrecs[1]);
|
|
} else {
|
|
$id = $FORM{'clid'};
|
|
$id =~ s/\.//g;
|
|
$crec = join('&', $id, $FORM{'pwd'}, "admin", $FORM{'clid'});
|
|
print TMPFILE "$crec\n";
|
|
($id, $pwd, $trash) = split (/&/, $crec);
|
|
}
|
|
close TMPFILE;
|
|
print "admin login \($id $pwd\) restored ...<BR>\n";
|
|
@archrecs = ();
|
|
|
|
return 1;
|
|
}
|
|
|
|
sub open_results {
|
|
print "<HTML>
|
|
<BODY>
|
|
";
|
|
}
|
|
|
|
sub close_results {
|
|
print "
|
|
</BODY>
|
|
</HTML>
|
|
";
|
|
}
|
|
|