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.

468 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 ( &copy_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 (&copy_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>
";
}