diff --git a/README.md b/README.md index 55ae45a95..f652cc646 100644 --- a/README.md +++ b/README.md @@ -5,6 +5,8 @@ The following is a first list of the stuff we should know how to do. ssh actswac@104.238.116.218 +Qbttxpsea1! + - Find names of software packages in the official CentOS repositories. Sample commands diff --git a/survey-nginx/cgi-bin/login.pl b/survey-nginx/cgi-bin/login.pl index 0e7a4d367..8cce178d0 100755 --- a/survey-nginx/cgi-bin/login.pl +++ b/survey-nginx/cgi-bin/login.pl @@ -11,215 +11,220 @@ require 'testlib.pl'; &traceoutput("login.pl"); # TRACE IF ACTIVE &app_initialize; -$SESSION{'temptime'} = time(); +$SESSION{'temptime'} = time(); $SESSION{'clid'} = $FORM{'clid'}; $SESSION{'lang'} = $FORM{'lang'}; + &get_client_configuration(); &traceoutput("login.pl:$FORM{'clid'}:$FORM{'uid'}:$FORM{'pwd'}"); # TRACE IF ACTIVE &setbrowsertype(); ## DED Patch for secure_html/tests dir permission problem 2006/10/11 if (! -x $testroot) { - print STDERR "PERMS: $testroot is not X\n"; - chmod(0777, $testroot); + print STDERR "PERMS: $testroot is not X\n"; + chmod(0777, $testroot); } if ($FORM{'selfregister'} eq "Y") { - unless ($SESSION{'clid'}) { - warn "ERROR: Empty Client ID in Form $FORM{'clid'} " ; - &show_illegal_access_warning("user"); - exit(); - } - &get_client_profile($SESSION{'clid'}); - unless (%CLIENT) { - warn "ERROR: Invalid Client ID $FORM{'clid'} " ; - &show_illegal_access_warning("user"); - exit(); - } - $CANDIDATE{'new'}="Y"; - print "Content-Type: text/html\n\n"; - &show_template("regsas"); + unless ($SESSION{'clid'}) { + warn "ERROR: Empty Client ID in Form $FORM{'clid'} " ; + print STDERR "ERROR: Empty Client ID in Form $FORM{'clid'} " ; +# &show_illegal_access_warning("user"); + exit(); + } + &get_client_profile($SESSION{'clid'}); + unless (%CLIENT) { + warn "ERROR: Invalid Client ID $FORM{'clid'} " ; + print STDERR "ERROR: Invalid Client ID $FORM{'clid'} " ; +# &show_illegal_access_warning("user"); + exit(); + } + $CANDIDATE{'new'}="Y"; + print "Content-Type: text/html\n\n"; + &show_template("regsas"); } elsif (&verifyaccess) { - &init_session; - &LanguageSupportInit(); - &log_entry($SESSION{'clid'}, $SESSION{'uid'}, "1"); - $FORM{'notice'} = $SYSTEM{'message'}; + &init_session; + &LanguageSupportInit(); + &log_entry($SESSION{'clid'}, $SESSION{'uid'}, "1"); + $FORM{'notice'} = $SYSTEM{'message'}; - ### For redirect to regcnd & regsas - $vars{'tid'} = $SESSION{'tid'}; - $vars{'lang'} = $SESSION{'lang'}; - $vars{'testid'} = $FORM{'testid'} if ($FORM{'testid'}) ; - $vars{'badid'} = $FORM{'badid'} unless !(defined($FORM{'badid'})); #This is used if badid is passed from regsas for autorefresh location trick - $vars{'direction'} = $FORM{'direction'} unless !(defined($FORM{'direction'})); - unless ($SESSION{'clid'}) { - warn "ERROR: Empty Client ID in Form $FORM{'clid'} " ; - &show_illegal_access_warning("user"); - exit(); - } - &get_client_profile($SESSION{'clid'}); - unless (%CLIENT || $SESSION{'clid'} eq 'std') { - warn "ERROR: Invalid Client ID $FORM{'clid'} " ; - &show_illegal_access_warning("user"); - exit(); - } - if ($SESSION{'taclid'} ne '') { + ### For redirect to regcnd & regsas + $vars{'tid'} = $SESSION{'tid'}; + $vars{'lang'} = $SESSION{'lang'}; + $vars{'testid'} = $FORM{'testid'} if ($FORM{'testid'}) ; + $vars{'badid'} = $FORM{'badid'} unless !(defined($FORM{'badid'})); #This is used if badid is passed from regsas for autorefresh location trick + $vars{'direction'} = $FORM{'direction'} unless !(defined($FORM{'direction'})); + unless ($SESSION{'clid'}) { + warn "ERROR: Empty Client ID in Form $FORM{'clid'} " ; + print STDERR "ERROR: Empty Client ID in Form $FORM{'clid'} " ; +# &show_illegal_access_warning("user"); + exit(); + } + &get_client_profile($SESSION{'clid'}); + unless (%CLIENT || $SESSION{'clid'} eq 'std') { + warn "ERROR: Invalid Client ID $FORM{'clid'} " ; + print STDERR "ERROR: Invalid Client ID $FORM{'clid'} " ; +# &show_illegal_access_warning("user"); + exit(); + } + if ($SESSION{'taclid'} ne '') { + print "Content-Type: text/html\n\n"; + my $opts = { restrict_to_availability_window => 1 }; + &set_session($SESSION{'tid'},'taclauthtests',$SESSION{'taclauthtests'}); + &set_session($SESSION{'tid'},'uid',$SESSION{'taclid'}); + if ($FORM{'pwd'} eq '_____') { + &get_tacl_profile("regauto"); + ®dusr("regauto"); + } else { + &get_tacl_profile(); + ®dusr("regtacl"); + } + } elsif ($FORM{'sas'} ne '') { + ## ^ support for wilcard login + # register an account to the candidate + my $opts = { restrict_to_availability_window => 1 }; + unless ($SESSION{'uid'}) { + warn "ERROR: Empty Candidate ID in Session data " ; + } + &get_candidate_profile($SESSION{'clid'}, $SESSION{'uid'}, $opts); + #®dusr("regsas"); + &redirect("regsas", \%vars); + } else { + if ($FORM{'sadm'} ne '') { + print "Content-Type: text/html\n\n"; + if ($SESSION{'uac'} eq 'gadmin') { + # Site administration + $CLIENT{'active'} = "X"; + $CLIENT{'logo'} = "\n"; + $CLIENT{'clorg'} = "ACTS Corporation"; + ®dusr("frsadmin"); + } elsif ($SESSION{'uac'} =~ /txlatr./ ) { + ($FORM{'uac'},$FORM{'lang'}) = split(/\./, $SESSION{'uac'}); + $CLIENT{'active'} = "X"; + $CLIENT{'logo'} = "\n"; + $CLIENT{'clorg'} = "ACTS Corporation"; + print "\n"; + print "\n"; + print "\n"; + print "\n"; + print "\n"; + print "\n"; + print "\n"; + } elsif ($SESSION{'uac'} eq 'madmin') { + # Multiple-client admin + ®dusr("madmin"); + } else { + # Client Test Administration + &get_client_profile($SESSION{'clid'}); + ®dusr("frsadmin"); + } + } else { + if ($FORM{'tadm'} ne '') { print "Content-Type: text/html\n\n"; - my $opts = { restrict_to_availability_window => 1 }; - &set_session($SESSION{'tid'},'taclauthtests',$SESSION{'taclauthtests'}); - &set_session($SESSION{'tid'},'uid',$SESSION{'taclid'}); - if ($FORM{'pwd'} eq '_____') { - &get_tacl_profile("regauto"); - ®dusr("regauto"); + if ($SESSION{'uac'} eq 'madmin') { + # Multiple-client admin + ®dusr("madmin"); } else { - &get_tacl_profile(); - ®dusr("regtacl"); + # Client Test Administration + &get_client_profile($SESSION{'clid'}); + ®dusr("frsadmin"); } - } elsif ($FORM{'sas'} ne '') { -## ^ support for wilcard login - # register an account to the candidate - my $opts = { restrict_to_availability_window => 1 }; - unless ($SESSION{'uid'}) { - warn "ERROR: Empty Candidate ID in Session data " ; - } - &get_candidate_profile($SESSION{'clid'}, $SESSION{'uid'}, $opts); - #®dusr("regsas"); - &redirect("regsas", \%vars); - } else { - if ($FORM{'sadm'} ne '') { - print "Content-Type: text/html\n\n"; - if ($SESSION{'uac'} eq 'gadmin') { - # Site administration - $CLIENT{'active'} = "X"; - $CLIENT{'logo'} = "\n"; - $CLIENT{'clorg'} = "ACTS Corporation"; - ®dusr("frsadmin"); - } elsif ($SESSION{'uac'} =~ /txlatr./ ) { - ($FORM{'uac'},$FORM{'lang'}) = split(/\./, $SESSION{'uac'}); - $CLIENT{'active'} = "X"; - $CLIENT{'logo'} = "\n"; - $CLIENT{'clorg'} = "ACTS Corporation"; - print "\n"; - print "\n"; - print "\n"; - print "\n"; - print "\n"; - print "\n"; - print "\n"; - } elsif ($SESSION{'uac'} eq 'madmin') { - # Multiple-client admin - ®dusr("madmin"); - } else { - # Client Test Administration - &get_client_profile($SESSION{'clid'}); - ®dusr("frsadmin"); - } + } else { + if (&checkinprogress($SESSION{'clid'}, $FORM{'uid'}) ) { + # resume test at point of pause + &resumetest; } else { - if ($FORM{'tadm'} ne '') { - print "Content-Type: text/html\n\n"; - if ($SESSION{'uac'} eq 'madmin') { - # Multiple-client admin - ®dusr("madmin"); - } else { - # Client Test Administration - &get_client_profile($SESSION{'clid'}); - ®dusr("frsadmin"); - } + if ($FORM{'cnd'} ne '') { + &get_client_profile($SESSION{'clid'}); + my $opts = { restrict_to_availability_window => 1 }; + &get_candidate_profile($SESSION{'clid'}, $FORM{'uid'}, $opts); + #print STDERR "clid: $SESSION{'clid'}, uid: $FORM{'uid'}, opts: $opts\n"; + if ($CANDIDATE{'grpowner'} eq 'Y') { + print "Content-Type: text/html\n\n"; + &show_template("frcnd"); + } elsif ($CANDIDATE{'registrar'} eq 'Y') { + print "Content-Type: text/html\n\n"; + &show_template("frcnd"); } else { - if (&checkinprogress($SESSION{'clid'}, $FORM{'uid'}) ) { - # resume test at point of pause - &resumetest; - } else { - if ($FORM{'cnd'} ne '') { - &get_client_profile($SESSION{'clid'}); - my $opts = { restrict_to_availability_window => 1 }; - &get_candidate_profile($SESSION{'clid'}, $FORM{'uid'}, $opts); - #print STDERR "clid: $SESSION{'clid'}, uid: $FORM{'uid'}, opts: $opts\n"; - if ($CANDIDATE{'grpowner'} eq 'Y') { - print "Content-Type: text/html\n\n"; - &show_template("frcnd"); - } elsif ($CANDIDATE{'registrar'} eq 'Y') { - print "Content-Type: text/html\n\n"; - &show_template("frcnd"); - } else { - &redirect("regcnd", \%vars); - } - } else { - &get_candidate_profile($SESSION{'clid'}, $FORM{'uid'}); - #®dusr("regsas"); - &redirect("regsas", \%vars); - } - } + &redirect("regcnd", \%vars); } + } else { + &get_candidate_profile($SESSION{'clid'}, $FORM{'uid'}); + #®dusr("regsas"); + &redirect("regsas", \%vars); + } } + } } + } } else { - # Load Index.html - print "Content-Type: text/html\n\n"; - if ($FORM{'home'} eq 'client') { - &get_client_profile($FORM{'clid'}); - @lines = &get_template("cindex"); + # Load Index.html + print "Content-Type: text/html\n\n"; + if ($FORM{'home'} eq 'client') { + &get_client_profile($FORM{'clid'}); + @lines = &get_template("cindex"); + } else { + @lines = &get_template("shome"); + } + if ($ipfilter ne '') { + if ($ipfilter =~ /$ENV{'REMOTE_ADDR'}/ ) { + # ip blocked + if ($FORM{'sas'} eq '') { + # uid or password were incorrect + $SYSTEM{'message'} = "\"System"; + } else { + # uid is used + $SYSTEM{'message'} = "\"Requested"; + } } else { - @lines = &get_template("shome"); + &logger::loginfo("Incorrect passwd 4"); + $SYSTEM{'message'} = "\"Incorrect"; } - if ($ipfilter ne '') { - if ($ipfilter =~ /$ENV{'REMOTE_ADDR'}/ ) { - # ip blocked - if ($FORM{'sas'} eq '') { - # uid or password were incorrect - $SYSTEM{'message'} = "\"System"; - } else { - # uid is used - $SYSTEM{'message'} = "\"Requested"; - } + } else { + if ($SYSTEM{'IP_ACCESS_FILTER'} ne '') { + if ($SYSTEM{'IP_ACCESS_FILTER'} =~ /$ENV{'REMOTE_ADDR'}/ ) { + if ($FORM{'sas'} eq '') { + # uid or password were incorrect + &logger::loginfo("Incorrect passwd 3"); + $SYSTEM{'message'} = "\"Incorrect"; } else { - &logger::loginfo("Incorrect passwd 4"); - $SYSTEM{'message'} = "\"Incorrect"; + # uid is used + $SYSTEM{'message'} = "\"Requested"; } + } else { + &logger::loginfo("Incorrect passwd 2"); + $SYSTEM{'message'} = "\"Incorrect"; + } } else { - if ($SYSTEM{'IP_ACCESS_FILTER'} ne '') { - if ($SYSTEM{'IP_ACCESS_FILTER'} =~ /$ENV{'REMOTE_ADDR'}/ ) { - if ($FORM{'sas'} eq '') { - # uid or password were incorrect - &logger::loginfo("Incorrect passwd 3"); - $SYSTEM{'message'} = "\"Incorrect"; - } else { - # uid is used - $SYSTEM{'message'} = "\"Requested"; - } - } else { - &logger::loginfo("Incorrect passwd 2"); - $SYSTEM{'message'} = "\"Incorrect"; - } - } else { - if ($FORM{'sas'} eq '') { - # uid or password were incorrect - &logger::loginfo("Incorrect passwd 1"); - $SYSTEM{'message'} = "\"Incorrect"; - } else { - # uid is used - $SYSTEM{'message'} = "\"Requested"; - } - } - } - foreach $line (@lines) { - $line = &xlatline($line); + if ($FORM{'sas'} eq '') { + # uid or password were incorrect + &logger::loginfo("Incorrect passwd 1"); + $SYSTEM{'message'} = "\"Incorrect"; + } else { + # uid is used + $SYSTEM{'message'} = "\"Requested"; + } } + } + foreach $line (@lines) { + $line = &xlatline($line); + } } sub resumetest { - print "RESUMING TEST
\n"; - print "
\n"; - print "
\n"; - print "
\n"; - print "
\n"; + print "RESUMING TEST
\n"; + print "
\n"; + print "
\n"; + print "
\n"; + print "
\n"; } sub test { - print "
\n"; - print "
\n"; - print "
\n"; - print "
\n"; - &showenv; + print "
\n"; + print "
\n"; + print "
\n"; + print "
\n"; + &showenv; } diff --git a/survey-nginx/cgi-bin/sadmin.pl b/survey-nginx/cgi-bin/sadmin.pl index 434a66780..87d9e9891 100755 --- a/survey-nginx/cgi-bin/sadmin.pl +++ b/survey-nginx/cgi-bin/sadmin.pl @@ -4,7 +4,15 @@ # # Source File: sadmin.pl +#use strict; +use warnings; +use CGI::Carp qw(warningsToBrowser fatalsToBrowser); + +#warningsToBrowser(1); +#fatalsToBrowser(1); + # Get config + require 'sitecfg.pl'; require 'testlib.pl'; @@ -12,120 +20,121 @@ require 'testlib.pl'; print "Content-Type: text/html\n\n"; -if (&get_session($FORM{'tid'})) { - &LanguageSupportInit(); - unless ($SESSION{'clid'}) { - warn "ERROR: Empty Client ID in Session data for Session ID $FORM{'tid'} " ; - &show_illegal_access_warning("user"); - exit(); - } - if ($SESSION{'clid'} ne 'std') { - &get_client_profile($SESSION{'clid'}); - unless (%CLIENT) { - warn "ERROR: Invalid Client ID $SESSION{'clid'} in Session ID $FORM{'tid'} " ; - &show_illegal_access_warning("user"); - exit(); +#print $logroot; +my $tid = $FORM{'tid'}; + +if (&get_session($tid)) { + &LanguageSupportInit(); + unless ($SESSION{'clid'}) { + warn "ERROR: Empty Client ID in Session data for Session ID $FORM{'tid'} " ; + #&show_illegal_access_warning("user"); + exit(); + } + if ($SESSION{'clid'} ne 'std') { + &get_client_profile($SESSION{'clid'}); + unless (%CLIENT) { + warn "ERROR: Invalid Client ID $SESSION{'clid'} in Session ID $FORM{'tid'} " ; + #&show_illegal_access_warning("user"); + exit(); } - if ($SESSION{'uac'} eq 'admin' || $SESSION{'uac'} eq 'madmin') { - $FORM{'pageid'} = "Group"; - $FORM{'PAGEID'} = "GROUP"; - $mainttmplt = "frgrpadmin"; - } else { - &get_candidate_profile($SESSION{'clid'}, $SESSION{'uid'}); - unless (%CANDIDATE) { + if ($SESSION{'uac'} eq 'admin' || $SESSION{'uac'} eq 'madmin') { + $FORM{'pageid'} = "Group"; + $FORM{'PAGEID'} = "GROUP"; + $mainttmplt = "frgrpadmin"; + } else { + &get_candidate_profile($SESSION{'clid'}, $SESSION{'uid'}); + unless (%CANDIDATE) { warn "ERROR: Invalid Candidate ID $SESSION{'uid'} for Client $SESSION{'clid'} in Session ID $FORM{'tid'} " ; - &show_illegal_access_warning("user"); + #&show_illegal_access_warning("user"); exit(); - } - $FORM{'pageid'} = "Gradebook"; - $FORM{'PAGEID'} = "GRADEBOOK"; - $mainttmplt = "frgradebooks"; - } + } + $FORM{'pageid'} = "Gradebook"; + $FORM{'PAGEID'} = "GRADEBOOK"; + $mainttmplt = "frgradebooks"; } + } - my @tempacl = &popEmlAcl($SESSION{'clid'}); - foreach (@tempacl) { - $CLIENT{'emlaclstr'} .= "$_,"; - } - $CLIENT{'emlaclstr'} =~ s/@//g; - $CLIENT{'emlaclstr'} =~ s/,$//g; - + my @tempacl = &popEmlAcl($SESSION{'clid'}); + foreach (@tempacl) { + $CLIENT{'emlaclstr'} .= "$_,"; + } + $CLIENT{'emlaclstr'} =~ s/@//g; + $CLIENT{'emlaclstr'} =~ s/,$//g; - - if ($FORM{'idx'} eq '1') { - &log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/I"); - if ($SESSION{'uac'} eq 'admin' || $SESSION{'uac'} eq 'gadmin' || $SESSION{'uac'} eq 'madmin') { - &show_template("sadminidx"); - } else { - &show_template("cndidx"); - } - } elsif ($FORM{'dtl'} eq '0') { - print "\n$xlatphrase[539]
$xlatphrase[540]\n"; - } elsif ($FORM{'dtl'} eq '1') { - &log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/CM"); - if ($SESSION{'uac'} eq 'gadmin') { - &show_admin_request("maintclient"); - } else { - $FORM{'dbop'} = 'ccupd'; - &show_admin_request("cdef"); - } - } elsif ($FORM{'dtl'} eq '12') { - &log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/TR"); - &show_admin_request("treplicaframe"); - } elsif ($FORM{'dtl'} eq '13') { - &log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/TO"); - &show_admin_request("tocrinpframe"); - } elsif ($FORM{'dtl'} eq '2') { - &log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/TM"); - $TEST{'id'} = $FORM{'tstid'}; - &show_admin_request("tdefframe"); - } elsif ($FORM{'dtl'} eq '21') { - if ($SESSION{'uac'} eq 'cnd') { - $CANDIDATE{'ownedtests'} = &get_group_tests($SESSION{'clid'}, $SESSION{'uid'}, 0); - } - &show_admin_request("mainttest"); - } elsif ($FORM{'dtl'} eq '99') { - &show_template("selectpg"); - } elsif ($FORM{'dtl'} eq '3') { - &log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/R"); - &show_admin_request("maintreport"); - } elsif ($FORM{'dtl'} eq '4') { - &log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/DL"); - &show_admin_downloads; - } elsif ($FORM{'dtl'} eq '5') { - &log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/DB"); - &show_admin_request("maintdb"); - } elsif ($FORM{'dtl'} eq '6') { - &log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/CF"); - # set FORM.colors - $trash = join( $pathsep, $dataroot, "config.$SESSION{'clid'}"); - $omsg = ""; - open( CFGFILE, "<$trash" ) or $omsg="not found"; - if ($omsg eq 'not found') { - $trash = join( $pathsep, $dataroot, "config.std"); - open( CFGFILE, "<$trash" ) or return; - } - @cfgentries = ; - close CFGFILE; - $langdef = "enu"; - $FORM{'colors'} = ""; - for (0 .. $#cfgentries) { - chop ($cfgentries[$_]); - ($entrykey,$entryvalue) = split(/=/, $cfgentries[$_]); - if ($entrykey eq 'DEFAULTLANG') { - $langdef = $entryvalue; - $langselfr = ($langdef eq 'fr') ? " SELECTED" : ""; - $langselsp = ($langdef eq 'sp') ? " SELECTED" : ""; - $langseldeu = ($langdef eq 'deu') ? " SELECTED" : ""; - $langselenu = ($langdef eq 'enu') ? " SELECTED" : ""; - $langselena = ($langdef eq 'ena') ? " SELECTED" : ""; - $langseleuv = ($langdef eq 'euv') ? " SELECTED" : ""; - $langselcyr = ($langdef eq 'cyr') ? " SELECTED" : ""; - $langselmy = ($langdef eq 'my') ? " SELECTED" : ""; - $langselkor = ($langdef eq 'kor') ? " SELECTED" : ""; - $langselafr = ($langdef eq 'afr') ? " SELECTED" : ""; - $langselhin = ($langdef eq 'hin') ? " SELECTED" : ""; - $colortag = " + if ($FORM{'idx'} eq '1') { + &log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/I"); + if ($SESSION{'uac'} eq 'admin' || $SESSION{'uac'} eq 'gadmin' || $SESSION{'uac'} eq 'madmin') { + &show_template("sadminidx"); + } else { + &show_template("cndidx"); + } + } elsif ($FORM{'dtl'} eq '0') { + print "\n$xlatphrase[539]
$xlatphrase[540]\n"; + } elsif ($FORM{'dtl'} eq '1') { + &log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/CM"); + if ($SESSION{'uac'} eq 'gadmin') { + &show_admin_request("maintclient"); + } else { + $FORM{'dbop'} = 'ccupd'; + &show_admin_request("cdef"); + } + } elsif ($FORM{'dtl'} eq '12') { + &log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/TR"); + &show_admin_request("treplicaframe"); + } elsif ($FORM{'dtl'} eq '13') { + &log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/TO"); + &show_admin_request("tocrinpframe"); + } elsif ($FORM{'dtl'} eq '2') { + &log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/TM"); + $TEST{'id'} = $FORM{'tstid'}; + &show_admin_request("tdefframe"); + } elsif ($FORM{'dtl'} eq '21') { + if ($SESSION{'uac'} eq 'cnd') { + $CANDIDATE{'ownedtests'} = &get_group_tests($SESSION{'clid'}, $SESSION{'uid'}, 0); + } + &show_admin_request("mainttest"); + } elsif ($FORM{'dtl'} eq '99') { + &show_template("selectpg"); + } elsif ($FORM{'dtl'} eq '3') { + &log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/R"); + &show_admin_request("maintreport"); + } elsif ($FORM{'dtl'} eq '4') { + &log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/DL"); + &show_admin_downloads; + } elsif ($FORM{'dtl'} eq '5') { + &log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/DB"); + &show_admin_request("maintdb"); + } elsif ($FORM{'dtl'} eq '6') { + &log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/CF"); + # set FORM.colors + $trash = join( $pathsep, $dataroot, "config.$SESSION{'clid'}"); + $omsg = ""; + open( CFGFILE, "<$trash" ) or $omsg="not found"; + if ($omsg eq 'not found') { + $trash = join( $pathsep, $dataroot, "config.std"); + open( CFGFILE, "<$trash" ) or return; + } + @cfgentries = ; + close CFGFILE; + $langdef = "enu"; + $FORM{'colors'} = ""; + for (0 .. $#cfgentries) { + chop ($cfgentries[$_]); + ($entrykey,$entryvalue) = split(/=/, $cfgentries[$_]); + if ($entrykey eq 'DEFAULTLANG') { + $langdef = $entryvalue; + $langselfr = ($langdef eq 'fr') ? " SELECTED" : ""; + $langselsp = ($langdef eq 'sp') ? " SELECTED" : ""; + $langseldeu = ($langdef eq 'deu') ? " SELECTED" : ""; + $langselenu = ($langdef eq 'enu') ? " SELECTED" : ""; + $langselena = ($langdef eq 'ena') ? " SELECTED" : ""; + $langseleuv = ($langdef eq 'euv') ? " SELECTED" : ""; + $langselcyr = ($langdef eq 'cyr') ? " SELECTED" : ""; + $langselmy = ($langdef eq 'my') ? " SELECTED" : ""; + $langselkor = ($langdef eq 'kor') ? " SELECTED" : ""; + $langselafr = ($langdef eq 'afr') ? " SELECTED" : ""; + $langselhin = ($langdef eq 'hin') ? " SELECTED" : ""; + $colortag = " $xlatphrase[541]\ \; @@ -145,9 +154,9 @@ if (&get_session($FORM{'tid'})) { \n"; - $FORM{'language'} = join('', $colortag, $FORM{'language'}); - } elsif ($entrykey eq 'IP_ACCESS_FILTER') { - $FORM{'language'} = " + $FORM{'language'} = join('', $colortag, $FORM{'language'}); + } elsif ($entrykey eq 'IP_ACCESS_FILTER') { + $FORM{'language'} = " $xlatphrase[385]\ \; @@ -155,63 +164,63 @@ if (&get_session($FORM{'tid'})) { \n"; - } else { - if ($entrykey eq 'BACKGROUND') { - $colortag = " + } else { + if ($entrykey eq 'BACKGROUND') { + $colortag = " $entrykey:\ \; \n"; - } else { - if (($entrykey =~ /COLOR/) - || ($entrykey =~ 'LINK') - || ($entrykey =~ 'ALINK') - || ($entrykey =~ 'VLINK') - || ($entrykey eq 'TEXT') ) { - $gotfocus = "onFocus=\"return tGotFocus(this)\""; - } else { - $gotfocus = ""; - } - $colortag = " + } else { + if (($entrykey =~ /COLOR/) + || ($entrykey =~ 'LINK') + || ($entrykey =~ 'ALINK') + || ($entrykey =~ 'VLINK') + || ($entrykey eq 'TEXT') ) { + $gotfocus = "onFocus=\"return tGotFocus(this)\""; + } else { + $gotfocus = ""; + } + $colortag = " $entrykey:\ \; \n"; - } - $FORM{'colors'} = join('', $FORM{'colors'}, $colortag); - } } - &show_admin_request("maintcfg"); - } elsif ($FORM{'dtl'} eq '7') { - &log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/GP"); - &show_admin_request($mainttmplt); - } elsif ($FORM{'dtl'} eq '8') { -#Begin filtering - $filterbydate = $FORM{'filterbydate'}; - $day_filter = $FORM{'day_filter'}; - $date_filter = $FORM{'date_filter'}; - $cnd1_filter = $FORM{'cnd1'}; - $cnd2_filter = $FORM{'cnd2'}; - $cnd3_filter = $FORM{'cnd3'}; - $cnd4_filter = $FORM{'cnd4'}; -#End filtering - &log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/CC"); - &show_admin_request("maintcnd"); - } elsif ($FORM{'dtl'} eq '9') { - &log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/RG"); - &show_admin_request("regcnd"); - } elsif ($FORM{'dtl'} eq '10') { - &log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/IM"); - &show_admin_request("upimport"); - } elsif ($FORM{'dtl'} eq '11') { - &log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/LC"); - &show_admin_request("frlicadmin"); - } elsif ($FORM{'dbop'} ne '') { - &show_dbop_response; - } else { - &show_illegal_access_warning; + $FORM{'colors'} = join('', $FORM{'colors'}, $colortag); + } } + &show_admin_request("maintcfg"); + } elsif ($FORM{'dtl'} eq '7') { + &log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/GP"); + &show_admin_request($mainttmplt); + } elsif ($FORM{'dtl'} eq '8') { + #Begin filtering + $filterbydate = $FORM{'filterbydate'}; + $day_filter = $FORM{'day_filter'}; + $date_filter = $FORM{'date_filter'}; + $cnd1_filter = $FORM{'cnd1'}; + $cnd2_filter = $FORM{'cnd2'}; + $cnd3_filter = $FORM{'cnd3'}; + $cnd4_filter = $FORM{'cnd4'}; + #End filtering + &log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/CC"); + &show_admin_request("maintcnd"); + } elsif ($FORM{'dtl'} eq '9') { + &log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/RG"); + &show_admin_request("regcnd"); + } elsif ($FORM{'dtl'} eq '10') { + &log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/IM"); + &show_admin_request("upimport"); + } elsif ($FORM{'dtl'} eq '11') { + &log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/LC"); + &show_admin_request("frlicadmin"); + } elsif ($FORM{'dbop'} ne '') { + &show_dbop_response; + } else { + #&show_illegal_access_warning("else1"); + } } else { - &logger::logerr("Unable to get session with &get_session($FORM{'tid'})"); - &show_illegal_access_warning; + &logger::logerr("Unable to get session with &get_session($FORM{'tid'})"); + &show_illegal_access_warning("else2"); } sub show_license_request { @@ -479,5 +488,5 @@ window.onmouseup=right; } sub close_results { - print "\n\n"; + print "
HERE
\n\n"; } diff --git a/survey-nginx/cgi-bin/sdbtxt/de b/survey-nginx/cgi-bin/sdbtxt/de old mode 100644 new mode 100755 diff --git a/survey-nginx/cgi-bin/sdbtxt/en b/survey-nginx/cgi-bin/sdbtxt/en old mode 100644 new mode 100755 diff --git a/survey-nginx/cgi-bin/sdbtxt/es b/survey-nginx/cgi-bin/sdbtxt/es old mode 100644 new mode 100755 diff --git a/survey-nginx/cgi-bin/sdbtxt/fr b/survey-nginx/cgi-bin/sdbtxt/fr old mode 100644 new mode 100755 diff --git a/survey-nginx/cgi-bin/sdbtxt/it b/survey-nginx/cgi-bin/sdbtxt/it old mode 100644 new mode 100755 diff --git a/survey-nginx/cgi-bin/sitecfg.pl b/survey-nginx/cgi-bin/sitecfg.pl index e37cdd635..b79b26001 100755 --- a/survey-nginx/cgi-bin/sitecfg.pl +++ b/survey-nginx/cgi-bin/sitecfg.pl @@ -75,14 +75,15 @@ $fieldsep = ';'; $idmax = 1000; $hostid = 4; + require 'smilib.pl'; require 'cybertestlib.pl'; require 'maillib.pl'; - # # THIS IS DEVELOPMENT SETTING *ONLY*! DO NOT COMMIT THIS CHANGE!! # + $docroot = $ENV{DOCUMENT_ROOT}; $docroot =~ s/\/htdocs\s*$//g; $urlroot = "/cgi-bin"; @@ -115,7 +116,7 @@ $PATHS{'pubroot'} = $pubroot; $PATHS{'logroot'} = $logroot; $PATHS{'dataroot'} = $dataroot; $PATHS{'secroot'} = $secroot; -$PATHS{'logroot'} = $logroot; +#$PATHS{'logroot'} = $logroot; $PATHS{'resptmplt'} = $resptmplt; $PATHS{'questionroot'} = $questionroot; $PATHS{'testroot'} = $testroot; diff --git a/survey-nginx/cgi-bin/smilib.pl b/survey-nginx/cgi-bin/smilib.pl index c2a8acf1b..e89b8a1a2 100755 --- a/survey-nginx/cgi-bin/smilib.pl +++ b/survey-nginx/cgi-bin/smilib.pl @@ -15,185 +15,185 @@ my $HBI_Debug_smilib_template_file = 0 ; my $Debug_HBI_PreSelect_Test = 0 ; sub get_client_configuration { - $omsg = "not found"; - if ($_[0]) { - $trash = join( $pathsep, $dataroot, "config.$_[0]"); - $omsg = ""; - open( CFGFILE, "<$trash" ) or $omsg="not found"; - } - if ($omsg eq 'not found') { - $trash = join( $pathsep, $dataroot, "config.$SESSION{'clid'}"); - $omsg = ""; - open( CFGFILE, "<$trash" ) or $omsg="not found"; - } - if ($omsg eq 'not found') { - $trash = join( $pathsep, $dataroot, "config.std"); - open( CFGFILE, "<$trash" ) or return; - } - @cfgentries = ; - close CFGFILE; - for (0 .. $#cfgentries) { - chop ($cfgentries[$_]); - ($entrykey,$entryvalue) = split(/=/, $cfgentries[$_]); - $SYSTEM{$entrykey} = $entryvalue; - } - if (($SESSION{'clid'} ne 'sacc') && ($SESSION{'clid'} ne 'std')) { - $SYSTEM{'languagesupport'} = ($SYSTEM{'ALLOWEDLANGS'} eq '' || $SYSTEM{'ALLOWEDLANGS'} =~ /none/) ? "FALSE" : "TRUE"; - } else { - $SYSTEM{'languagesupport'} = "TRUE"; - } + $omsg = "not found"; + if ($_[0]) { + $trash = join( $pathsep, $dataroot, "config.$_[0]"); + $omsg = ""; + open( CFGFILE, "<$trash" ) or $omsg="not found"; + } + if ($omsg eq 'not found') { + $trash = join( $pathsep, $dataroot, "config.$SESSION{'clid'}"); + $omsg = ""; + open( CFGFILE, "<$trash" ) or $omsg="not found"; + } + if ($omsg eq 'not found') { + $trash = join( $pathsep, $dataroot, "config.std"); + open( CFGFILE, "<$trash" ) or return; + } + @cfgentries = ; + close CFGFILE; + for (0 .. $#cfgentries) { + chop ($cfgentries[$_]); + ($entrykey,$entryvalue) = split(/=/, $cfgentries[$_]); + $SYSTEM{$entrykey} = $entryvalue; + } + if (($SESSION{'clid'} ne 'sacc') && ($SESSION{'clid'} ne 'std')) { + $SYSTEM{'languagesupport'} = ($SYSTEM{'ALLOWEDLANGS'} eq '' || $SYSTEM{'ALLOWEDLANGS'} =~ /none/) ? "FALSE" : "TRUE"; + } else { + $SYSTEM{'languagesupport'} = "TRUE"; + } } sub put_client_configuration { - $omsg = "not found"; - if ($_[0]) { - $trash = join( $pathsep, $dataroot, "config.$_[0]"); - $omsg = ""; - open( CFGFILE, "<$trash" ) or $omsg="not found"; - } - if ($omsg eq 'not found') { - $trash = join( $pathsep, $dataroot, "config.$SESSION{'clid'}"); - $omsg = ""; - open( CFGFILE, "<$trash" ) or $omsg="not found"; - } - if ($omsg eq 'not found') { - $trash = join( $pathsep, $dataroot, "config.std"); - open( CFGFILE, "<$trash" ) or return; - } - @cfgentries = ; - close CFGFILE; - for (0 .. $#cfgentries) { - chop ($cfgentries[$_]); - ($entrykey,$entryvalue) = split(/=/, $cfgentries[$_]); - $key = "C$entrykey"; - $key =~ s/ /+/g; - if ($FORM{$key} ne '') { - $cfgentries[$_] = "$entrykey=$FORM{$key}"; - } else { - if ( $entrykey eq 'IP_ACCESS_FILTER') { - $cfgentries[$_] = "$entrykey=$FORM{'CIP_ACCESS_FILTER'}"; - } - } + $omsg = "not found"; + if ($_[0]) { + $trash = join( $pathsep, $dataroot, "config.$_[0]"); + $omsg = ""; + open( CFGFILE, "<$trash" ) or $omsg="not found"; + } + if ($omsg eq 'not found') { + $trash = join( $pathsep, $dataroot, "config.$SESSION{'clid'}"); + $omsg = ""; + open( CFGFILE, "<$trash" ) or $omsg="not found"; + } + if ($omsg eq 'not found') { + $trash = join( $pathsep, $dataroot, "config.std"); + open( CFGFILE, "<$trash" ) or return; + } + @cfgentries = ; + close CFGFILE; + for (0 .. $#cfgentries) { + chop ($cfgentries[$_]); + ($entrykey,$entryvalue) = split(/=/, $cfgentries[$_]); + $key = "C$entrykey"; + $key =~ s/ /+/g; + if ($FORM{$key} ne '') { + $cfgentries[$_] = "$entrykey=$FORM{$key}"; + } else { + if ( $entrykey eq 'IP_ACCESS_FILTER') { + $cfgentries[$_] = "$entrykey=$FORM{'CIP_ACCESS_FILTER'}"; + } } - $omsg = "not found"; - if ($_[0]) { - $trash = join( $pathsep, $dataroot, "config.$_[0]"); - $omsg = ""; - open( CFGFILE, ">$trash" ) or $omsg="not found"; - } - if ($omsg eq 'not found') { - $trash = join( $pathsep, $dataroot, "config.$SESSION{'clid'}"); - $omsg = ""; - open( CFGFILE, ">$trash" ) or $omsg="not found"; - } - if ($omsg ne 'not found') { - for (0 .. $#cfgentries) { - print CFGFILE "$cfgentries[$_]\n"; - } - close CFGFILE; + } + $omsg = "not found"; + if ($_[0]) { + $trash = join( $pathsep, $dataroot, "config.$_[0]"); + $omsg = ""; + open( CFGFILE, ">$trash" ) or $omsg="not found"; + } + if ($omsg eq 'not found') { + $trash = join( $pathsep, $dataroot, "config.$SESSION{'clid'}"); + $omsg = ""; + open( CFGFILE, ">$trash" ) or $omsg="not found"; + } + if ($omsg ne 'not found') { + for (0 .. $#cfgentries) { + print CFGFILE "$cfgentries[$_]\n"; } - $chmodok = chmod 0666, $trash; + close CFGFILE; + } + $chmodok = chmod 0666, $trash; } sub createtrace { - my $trash = join( $pathsep, $secroot, "$ENV{'REMOTE_ADDR'}.log"); - my $msg = ""; - open( TRACEFILE, "<$trash") or $msg = "notfound"; - if ($msg eq 'notfound') { - open( TRACEFILE, ">$trash" ) || return 0; - my $starttime= &format_date_time("yyyy-mm-dd hh:nn:ss GMT", "1", "0"); - print TRACEFILE "$starttime\n"; - close TRACEFILE; - my $chmodok = chmod 0666, $trash; - } else { - close TRACEFILE; - } - &opentrace(); + my $trash = join( $pathsep, $secroot, "$ENV{'REMOTE_ADDR'}.log"); + my $msg = ""; + open( TRACEFILE, "<$trash") or $msg = "notfound"; + if ($msg eq 'notfound') { + open( TRACEFILE, ">$trash" ) || return 0; + my $starttime= &format_date_time("yyyy-mm-dd hh:nn:ss GMT", "1", "0"); + print TRACEFILE "$starttime\n"; + close TRACEFILE; + my $chmodok = chmod 0666, $trash; + } else { + close TRACEFILE; + } + &opentrace(); } sub traceoutput { - if ($SYSTEM{'traceon'} != 1) { - if (&opentrace()) { - &createtrace(); - } + if ($SYSTEM{'traceon'} != 1) { + if (&opentrace()) { + &createtrace(); } - if ($SYSTEM{'traceon'} == 1) { - print TRACEFILE "$_[0]\n"; - }; + } + if ($SYSTEM{'traceon'} == 1) { + print TRACEFILE "$_[0]\n"; + }; } sub opentrace { - my $trash = join( $pathsep, $secroot, "$ENV{'REMOTE_ADDR'}.log"); - open( TRACEFILE, ">>$trash" ) || return 0; - $SYSTEM{'traceon'} = 1; - my $starttime= &format_date_time("yyyy-mm-dd hh:nn:ss GMT", "1", "0"); - &traceoutput($starttime); - return 1; + my $trash = join( $pathsep, $secroot, "$ENV{'REMOTE_ADDR'}.log"); + open( TRACEFILE, ">>$trash" ) || return 0; + $SYSTEM{'traceon'} = 1; + my $starttime= &format_date_time("yyyy-mm-dd hh:nn:ss GMT", "1", "0"); + &traceoutput($starttime); + return 1; } sub closetrace { - $SYSTEM{'traceon'} = 0; - my $starttime= &format_date_time("yyyy-mm-dd hh:nn:ss GMT", "1", "0"); - &traceoutput($starttime); - close TRACEFILE; + $SYSTEM{'traceon'} = 0; + my $starttime= &format_date_time("yyyy-mm-dd hh:nn:ss GMT", "1", "0"); + &traceoutput($starttime); + close TRACEFILE; } sub createdebug { - $trash = join( $pathsep, $secroot, "debug.$SESSION{'clid'}.txt"); - $msg = ""; - open( DBGFILE, "<$trash") or $msg = "notfound"; - if ($msg eq 'notfound') { - open( DBGFILE, ">$trash" ) || return 0; - $starttime= &format_date_time("yyyy-mm-dd hh:nn:ss GMT", "1", "0"); - &dbgprint("$starttime\n"); - close DBGFILE; - $chmodok = chmod 0666, $trash; - } else { - close DBGFILE; - } - &opendebug("debug.txt"); + $trash = join( $pathsep, $secroot, "debug.$SESSION{'clid'}.txt"); + $msg = ""; + open( DBGFILE, "<$trash") or $msg = "notfound"; + if ($msg eq 'notfound') { + open( DBGFILE, ">$trash" ) || return 0; + $starttime= &format_date_time("yyyy-mm-dd hh:nn:ss GMT", "1", "0"); + &dbgprint("$starttime\n"); + close DBGFILE; + $chmodok = chmod 0666, $trash; + } else { + close DBGFILE; + } + &opendebug("debug.txt"); } sub opendebug { - $trash = join( $pathsep, $secroot, "debug.$SESSION{'clid'}.txt"); - open( DBGFILE, ">>$trash" ) || return 0; - $debugon = 1; - return 1; + $trash = join( $pathsep, $secroot, "debug.$SESSION{'clid'}.txt"); + open( DBGFILE, ">>$trash" ) || return 0; + $debugon = 1; + return 1; } sub dbgprint { - my ($s) = @_; - &opendebug(); - print DBGFILE "$SESSION{'tid'}:$SESSION{'uid'}:$s"; - &closedebug(); + my ($s) = @_; + &opendebug(); + print DBGFILE "$SESSION{'tid'}:$SESSION{'uid'}:$s"; + &closedebug(); } sub closedebug { - $debugon = 0; - close DBGFILE; + $debugon = 0; + close DBGFILE; } sub showenv { - for (keys %ENV) { - if ($debugon) { - &dbgprint("$_ = $ENV{$_}\n"); - } else { - print "\n"; - } + for (keys %ENV) { + if ($debugon) { + &dbgprint("$_ = $ENV{$_}\n"); + } else { + print "\n"; } - $reqmeth = $ENV{'REQUEST_METHOD'}; - if ($reqmeth =~ /POST/i) { - read (STDIN, $qstr, $ENV{'CONTENT_LENGTH'}); - if ($debugon) { - &dbgprint("POSTED = $qstr\n"); - } else { - print "\n"; - } + } + $reqmeth = $ENV{'REQUEST_METHOD'}; + if ($reqmeth =~ /POST/i) { + read (STDIN, $qstr, $ENV{'CONTENT_LENGTH'}); + if ($debugon) { + &dbgprint("POSTED = $qstr\n"); + } else { + print "\n"; } + } } sub show_message_with_close { - print " + print "
@@ -210,157 +210,157 @@ $_[0]
### DED-03 8/6/2002 Added this function to replace show_message_with_close ### because it would close entire browser window sub show_message_with_back { - $URL="$PATHS{'cgiroot'}/sadmin.pl?tid=$SESSION{'tid'}&dtl=$_[1]&lang=$FORM{'lang'}"; - print " + $URL="$PATHS{'cgiroot'}/sadmin.pl?tid=$SESSION{'tid'}&dtl=$_[1]&lang=$FORM{'lang'}"; + print "
$_[0]

\n"; -if ($_[1] == 2) { + if ($_[1] == 2) { print "BACK\n"; -} else { + } else { print "BACK\n"; -} -print " + } + print " "; } sub file_exists { - open (TMPFILE,"<$_[0]") or return 0; - close TMPFILE; - return 1; + open (TMPFILE,"<$_[0]") or return 0; + close TMPFILE; + return 1; } sub file_exists_with_extension { - @feexts = split(/\;/, $_[1]); - foreach $feext (@feexts) { - $fename = "$_[0].$feext"; - if (&file_exists($fename)) { - @feexts = (); - $feext = ""; - return $fename; - } + @feexts = split(/\;/, $_[1]); + foreach $feext (@feexts) { + $fename = "$_[0].$feext"; + if (&file_exists($fename)) { + @feexts = (); + $feext = ""; + return $fename; } - @feexts = (); - $feext = ""; - $fename = ""; - return ""; + } + @feexts = (); + $feext = ""; + $fename = ""; + return ""; } sub app_initialize { - $FORM{servertime} = POSIX::strftime($UI{DATETIME_FMT}, localtime(time)); - my $HBI_Debug_Form = 1 ; - - # parse request parameters into variables - $query = new CGI; - %FORM = $query->Vars; - if ($HBI_Debug_Form) { - my $key ; - warn "Dump FORM " ; - foreach $key (sort keys %FORM) { - warn "Key ${key} Val $FORM{${key}} X\n" ; - } - warn "End Dump FORM " ; - } - - #foreach $key (keys(%FORM)) { - #if ($FORM{$key} =~ /\-\-$/) { - #chop($FORM{$key}); - #chop($FORM{$key}); - #} - #} + $FORM{servertime} = POSIX::strftime($UI{DATETIME_FMT}, localtime(time)); + my $HBI_Debug_Form = 1 ; + + # parse request parameters into variables + $query = new CGI; + %FORM = $query->Vars; + if ($HBI_Debug_Form) { + my $key ; + warn "Dump FORM " ; + foreach $key (sort keys %FORM) { + warn "Key ${key} Val $FORM{${key}} X\n" ; + } + warn "End Dump FORM " ; + } - ### DED Rip ALL this out, change UPLOADED_FILES references - ### to use "CGI::upload" - - #if ($ftype eq 'csv') { - #$content =~ s/\r//g; - #$content =~ s/\n\n/\n/g; - #} else { - #### DED 1/24/06 - ## Removed for png supt - ## but breaks reports - ##$content =~ s/(.*)\r\n/$1/; - #$content =~ s/(.*)\r\n/$1/; - #} - - # make sure connection is https + #foreach $key (keys(%FORM)) { + #if ($FORM{$key} =~ /\-\-$/) { + #chop($FORM{$key}); + #chop($FORM{$key}); + #} + #} + + ### DED Rip ALL this out, change UPLOADED_FILES references + ### to use "CGI::upload" + + #if ($ftype eq 'csv') { + #$content =~ s/\r//g; + #$content =~ s/\n\n/\n/g; + #} else { + #### DED 1/24/06 + ## Removed for png supt + ## but breaks reports + ##$content =~ s/(.*)\r\n/$1/; + #$content =~ s/(.*)\r\n/$1/; + #} + + # make sure connection is https + $set_https = 0; + if ($FORM{'clid'} ne '') { + &get_client_configuration($FORM{'clid'}); $set_https = 0; - if ($FORM{'clid'} ne '') { - &get_client_configuration($FORM{'clid'}); - $set_https = 0; - } elsif ($FORM{'tid'} ne '' && &get_session($FORM{'tid'})) { - &get_client_configuration($SESSION{'clid'}); - $set_https = 0; - } - if ($set_https) { - if ( ($ENV{'HTTPS'} ne "on") && ( ($SYSTEM{'FORCEHTTPSOVERRIDE'} eq "Yes") || ($SYSTEM{'FORCEHTTPSOVERRIDE'} ne "No" && $SYSTEM{'forcehttps'}) ) ) { - $url = "https://".$ENV{'SERVER_NAME'}; - if ($ENV{'SERVER_PORT'} != "80") { - $port = $ENV{'SERVER_PORT'} + 1; - $url .= ":".$port; - } - $url .= $ENV{'REQUEST_URI'}; - print "Location: $url\n"; - } + } elsif ($FORM{'tid'} ne '' && &get_session($FORM{'tid'})) { + &get_client_configuration($SESSION{'clid'}); + $set_https = 0; + } + if ($set_https) { + if ( ($ENV{'HTTPS'} ne "on") && ( ($SYSTEM{'FORCEHTTPSOVERRIDE'} eq "Yes") || ($SYSTEM{'FORCEHTTPSOVERRIDE'} ne "No" && $SYSTEM{'forcehttps'}) ) ) { + $url = "https://".$ENV{'SERVER_NAME'}; + if ($ENV{'SERVER_PORT'} != "80") { + $port = $ENV{'SERVER_PORT'} + 1; + $url .= ":".$port; + } + $url .= $ENV{'REQUEST_URI'}; + print "Location: $url\n"; } + } - if ($qstr) { - return 1; - } else { - return 0; - } + if ($qstr) { + return 1; + } else { + return 0; + } } sub copy_file { - system("cp $_[1] $_[0] -p"); - print "
File successfully copied...
"; - return 1; + system("cp $_[1] $_[0] -p"); + print "
File successfully copied...
"; + return 1; } sub make_file { - if ( ! open (TMPFILE, "<$_[1]") ) { - &logger::logerr("Unable to open $_[1] for reading: $!\n"); - return 0; - } - @copylines = ; - close TMPFILE; - if ( ! open (TMPFILE, ">$_[0]") ) { - &logger::logerr("Unable to open $_[0] for writing: $!\n"); - return 0; - } - if ($_[2] == 1) { - print TMPFILE "$copylines[0]"; - } else { - foreach $copyline (@copylines) { - print TMPFILE "$copyline"; - } + if ( ! open (TMPFILE, "<$_[1]") ) { + &logger::logerr("Unable to open $_[1] for reading: $!\n"); + return 0; + } + @copylines = ; + close TMPFILE; + if ( ! open (TMPFILE, ">$_[0]") ) { + &logger::logerr("Unable to open $_[0] for writing: $!\n"); + return 0; + } + if ($_[2] == 1) { + print TMPFILE "$copylines[0]"; + } else { + foreach $copyline (@copylines) { + print TMPFILE "$copyline"; } - close TMPFILE; - $chmodok = chmod 0666, $_[0]; - return 1; + } + close TMPFILE; + $chmodok = chmod 0666, $_[0]; + return 1; } sub get_io_file { - if ( ! open (TMPFILE, "<$_[0]") ) { - &logger::logerr("Unable to open $_[0] for reading: $!\n"); - return 0; - } - @copylines = ; - close TMPFILE; - if ( ! open (TMPFILE, ">$_[1]") ) { - &logger::logerr("Unable to open $_[1] for writing: $!\n"); - return 0; - } - foreach $copyline (@copylines) { - print TMPFILE "$copyline"; - } - close TMPFILE; - $chmodok = chmod 0666, $_[1]; - return 1; + if ( ! open (TMPFILE, "<$_[0]") ) { + &logger::logerr("Unable to open $_[0] for reading: $!\n"); + return 0; + } + @copylines = ; + close TMPFILE; + if ( ! open (TMPFILE, ">$_[1]") ) { + &logger::logerr("Unable to open $_[1] for writing: $!\n"); + return 0; + } + foreach $copyline (@copylines) { + print TMPFILE "$copyline"; + } + close TMPFILE; + $chmodok = chmod 0666, $_[1]; + return 1; } ############################################################################ @@ -383,1017 +383,1017 @@ sub get_io_file { # ############################################################################ sub cpbin { - my($fromfile, $tofile, $opts) = @_; + my($fromfile, $tofile, $opts) = @_; - my $clobber = $opts->{clobber}; + my $clobber = $opts->{clobber}; - if ( -f $tofile && ! $clobber ) { - &logger::logerr("Unable to open $fromfile for writing: File exists and no clobbering allowed. Set \$opts->{clobber} = 1 to force clobbering.\n"); - return 0; - } + if ( -f $tofile && ! $clobber ) { + &logger::logerr("Unable to open $fromfile for writing: File exists and no clobbering allowed. Set \$opts->{clobber} = 1 to force clobbering.\n"); + return 0; + } - if ( ! open (INFILE, "<$fromfile") ) { - &logger::logerr("Unable to open $fromfile for reading: $!\n"); - return 0; - } - binmode(INFILE); - @content = ; - close INFILE; + if ( ! open (INFILE, "<$fromfile") ) { + &logger::logerr("Unable to open $fromfile for reading: $!\n"); + return 0; + } + binmode(INFILE); + @content = ; + close INFILE; - if ( ! open (OUTFILE, ">$tofile") ) { - &logger::logerr("Unable to open $tofile for writing: $!\n"); - return 0; - } - binmode(OUTFILE); - foreach $content (@content) { - print OUTFILE $content; - } - close OUTFILE; + if ( ! open (OUTFILE, ">$tofile") ) { + &logger::logerr("Unable to open $tofile for writing: $!\n"); + return 0; + } + binmode(OUTFILE); + foreach $content (@content) { + print OUTFILE $content; + } + close OUTFILE; - return 1; + return 1; } sub gentid { - $coreid = time; - $spfmt = join('', "\%s\%0", sprintf("%d", length($idmax)), "d"); - $tid = sprintf( $spfmt, $coreid, (int(rand(0) * $idmax))); - return $tid; + $coreid = time; + $spfmt = join('', "\%s\%0", sprintf("%d", length($idmax)), "d"); + $tid = sprintf( $spfmt, $coreid, (int(rand(0) * $idmax))); + return $tid; } sub init_session { - if ($FORM{'clid'} eq 'sacc') { $FORM{'clid'} = 'std';} - $SESSION{'tid'} = &gentid; - $SESSION{'clid'}=$FORM{'clid'}; - $SESSION{'uid'}=$FORM{'uid'}; - $SESSION{'uac'}=$FORM{'uac'}; - $SESSION{'useragent'}=$ENV{'HTTP_USER_AGENT'}; - $SESSION{'ipaddr'}=$ENV{'REMOTE_ADDR'}; - $SESSION{'referer'}=$ENV{'HTTP_REFERER'}; - $SESSION{'home'}=$FORM{'home'}; - $SESSION{'lang'}=$FORM{'lang'}; - $SESSION{'loggedin'}=time; - if ($FORM{'browser'} eq '') { - if ($SESSION{'useragent'} =~ /MSIE/ ) { - $FORM{'browser'} = "MSIE/4"; - } else { - $FORM{'browser'} = "NSNV/4"; - } + if ($FORM{'clid'} eq 'sacc') { $FORM{'clid'} = 'std';} + $SESSION{'tid'} = &gentid; + $SESSION{'clid'}=$FORM{'clid'}; + $SESSION{'uid'}=$FORM{'uid'}; + $SESSION{'uac'}=$FORM{'uac'}; + $SESSION{'useragent'}=$ENV{'HTTP_USER_AGENT'}; + $SESSION{'ipaddr'}=$ENV{'REMOTE_ADDR'}; + $SESSION{'referer'}=$ENV{'HTTP_REFERER'}; + $SESSION{'home'}=$FORM{'home'}; + $SESSION{'lang'}=$FORM{'lang'}; + $SESSION{'loggedin'}=time; + if ($FORM{'browser'} eq '') { + if ($SESSION{'useragent'} =~ /MSIE/ ) { + $FORM{'browser'} = "MSIE/4"; + } else { + $FORM{'browser'} = "NSNV/4"; } - ($SESSION{'browserapp'}, $SESSION{'browserversion'}) = split(/\//, $FORM{'browser'}); - &put_session($SESSION{'tid'}, "y"); + } + ($SESSION{'browserapp'}, $SESSION{'browserversion'}) = split(/\//, $FORM{'browser'}); + &put_session($SESSION{'tid'}, "y"); } sub get_session { - my ($session_id, $skip_warning) = @_; - if (! defined $session_id) { - warn "HBI Undefined Session id" ; - } - if ($session_id eq "") { - &show_illegal_access_warning unless ($skip_warning); - warn "HBI Blank Session id" ; - return 0; - } - unless ($session_id =~ m/^\d{13,15}$/ ) { - # only 13, 14, or 15 digits is OK. - $session_id =~ tr/\000/,/ ; # Replace a null with a comma. - my $err_mesg = "HBI Bad Y Session id $session_id X " . length $session_id . " Z" ; - warn $err_mesg ; - $session_id =~ s/\,.*$// ; # Drop any comma and the fo;;owing characters. - } - $trash = join($pathsep, $logroot, "sess.$session_id"); - open (SESSFILE, "<$trash"); - @sessrecs = ; - close SESSFILE; - if ($#sessrecs == -1) { - &show_illegal_access_warning unless ($skip_warning); - warn "HBI No Lines in Session file, $trash ." ; - return 0; - } else { - foreach $sessrec (@sessrecs) { - chop ($sessrec); - ($nm,$vlu)=split(/=/,$sessrec); - $SESSION{$nm} = $vlu; - } - unless ($SESSION{'clid'}) { - warn "HBI Unknown Client ID in Session file." ; - } - unless ($SESSION{'uid'}) { - warn "HBI Unknown Candidate ID in Session file." ; - } - if ($SESSION{'clid'} eq 'sacc') { $SESSION{'clid'} = 'std';} - # FIXME: AOL's use of dynamically changing IP addresses on each - # FIXME: successive pageview breaks fails against this scheme. - # DED 2005-11-08 Removed to facilitate round-robin proxies - #$sameuser = ($SESSION{'ipaddr'} eq $ENV{'REMOTE_ADDR'}) ? 1 : 0; - #if ( $SESSION{'ipaddr'} ne $ENV{'REMOTE_ADDR'} ) { - # &logger::logwarn("SESSION{'ipaddr'} ($SESSION{'ipaddr'}) !== ENV{'REMOTE_ADDR'} ($ENV{'REMOTE_ADDR'}) for session ID $session_id"); - #} - #$sameuser = ($SESSION{'loggedout'} ne '') ? 0 : $sameuser; - $sameuser = ($SESSION{'loggedout'} ne '') ? 0 : 1; - if ( $SESSION{'loggedout'} ne '' ) { - &logger::logwarn("SESSION{'loggedout'} ($SESSION{'loggedout'}) !== '' for session ID $session_id ... meaning exactly what??"); - } - return $sameuser; + my ($session_id, $skip_warning) = @_; + if (! defined $session_id) { + warn "HBI Undefined Session id" ; + } + if ($session_id eq "") { + &show_illegal_access_warning unless ($skip_warning); + warn "HBI Blank Session id" ; + return 0; + } + unless ($session_id =~ m/^\d{13,15}$/ ) { + # only 13, 14, or 15 digits is OK. + $session_id =~ tr/\000/,/ ; # Replace a null with a comma. + my $err_mesg = "HBI Bad Y Session id $session_id X " . length $session_id . " Z" ; + warn $err_mesg ; + $session_id =~ s/\,.*$// ; # Drop any comma and the fo;;owing characters. + } + $trash = join($pathsep, $logroot, "sess.$session_id"); + open (SESSFILE, "<$trash"); + @sessrecs = ; + close SESSFILE; + if ($#sessrecs == -1) { + &show_illegal_access_warning unless ($skip_warning); + warn "HBI No Lines in Session file, $trash ." ; + return 0; + } else { + foreach $sessrec (@sessrecs) { + chop ($sessrec); + ($nm,$vlu)=split(/=/,$sessrec); + $SESSION{$nm} = $vlu; + } + unless ($SESSION{'clid'}) { + warn "HBI Unknown Client ID in Session file." ; + } + unless ($SESSION{'uid'}) { + warn "HBI Unknown Candidate ID in Session file." ; + } + if ($SESSION{'clid'} eq 'sacc') { $SESSION{'clid'} = 'std';} + # FIXME: AOL's use of dynamically changing IP addresses on each + # FIXME: successive pageview breaks fails against this scheme. + # DED 2005-11-08 Removed to facilitate round-robin proxies + #$sameuser = ($SESSION{'ipaddr'} eq $ENV{'REMOTE_ADDR'}) ? 1 : 0; + #if ( $SESSION{'ipaddr'} ne $ENV{'REMOTE_ADDR'} ) { + # &logger::logwarn("SESSION{'ipaddr'} ($SESSION{'ipaddr'}) !== ENV{'REMOTE_ADDR'} ($ENV{'REMOTE_ADDR'}) for session ID $session_id"); + #} + #$sameuser = ($SESSION{'loggedout'} ne '') ? 0 : $sameuser; + $sameuser = ($SESSION{'loggedout'} ne '') ? 0 : 1; + if ( $SESSION{'loggedout'} ne '' ) { + &logger::logwarn("SESSION{'loggedout'} ($SESSION{'loggedout'}) !== '' for session ID $session_id ... meaning exactly what??"); } + return $sameuser; + } } sub close_session { - $SESSION{'loggedout'}=time; - &put_session($SESSION{'tid'}); - $tofile = join($pathsep, $logroot, "sess.$_[0]"); - $archivefile = join($pathsep, $logroot, "sess.$_[0]"); - rename $tofile, $archivefile; + $SESSION{'loggedout'}=time; + &put_session($SESSION{'tid'}); + $tofile = join($pathsep, $logroot, "sess.$_[0]"); + $archivefile = join($pathsep, $logroot, "sess.$_[0]"); + rename $tofile, $archivefile; } sub set_session { - my $temp = $_[2]; - &get_session($_[0]); - $SESSION{$_[1]} = $temp; - &put_session($_[0]); + my $temp = $_[2]; + &get_session($_[0]); + $SESSION{$_[1]} = $temp; + &put_session($_[0]); } sub put_session { - if ($_[0] eq "") { - return 0; - } - $SESSION{'lastaccess'}=time; - $trash = join($pathsep, $logroot, "sess.$_[0]"); - open (SESSFILE, ">$trash"); - for (keys %SESSION) { - print SESSFILE "$_\=$SESSION{$_}\n"; - } - close SESSFILE; - if ($_[1] eq 'y') { $chmodok = chmod 0666, $trash;} + if ($_[0] eq "") { + return 0; + } + $SESSION{'lastaccess'}=time; + $trash = join($pathsep, $logroot, "sess.$_[0]"); + open (SESSFILE, ">$trash"); + for (keys %SESSION) { + print SESSFILE "$_\=$SESSION{$_}\n"; + } + close SESSFILE; + if ($_[1] eq 'y') { $chmodok = chmod 0666, $trash;} } sub show_illegal_access_warning { - my ($user) = @_; - &send_illegal_attempt; - print "\n"; - print "\n"; - print "\ 
\n"; - if ($user eq "user") { - print "Attention User:
\n"; - print "Either your IP address has changed or the session tracking mechanisms have encountered an error. \n"; - print "Please logoff and contact your administrator for assistance.
\n"; - } else { - print "Attention Site Administrators:
\n"; - print "You have either requested a service that is unavailable at this time, \n"; - print "or else the session tracking mechanisms have encountered an error. \n"; - print "Please try another selection, or logoff and logon again to reset session tracking.
\n"; - } - print "\ 
\n"; - print "\ 
\n"; -# print "Attention Hackers:
You have attempted to gain access to this secure site \n"; -# print "by bypassing the site security.
\n"; -# print "\ 
\n"; -# print "The contents of this site are protected by United States and International copyright laws.
\n"; -# print "The information on this site is proprietary and protected by United States and International information privacy laws.
\n"; -# print "\ 
\n"; -# print "This invalid attempt has been logged, the site administrator notified, and your access route traced.
"; -# print "Any further unauthorized access attempts from $ENV{'REMOTE_ADDR'} will result "; -# print "in further investigation and possible prosecution.
\n"; - print "\n"; - print "\n"; + my ($user) = @_; + &send_illegal_attempt; + print "\n"; + print "\n"; + print "\ 
\n"; + if ($user eq "user") { + print "Attention User:
\n"; + print "Either your IP address has changed or the session tracking mechanisms have encountered an error. \n"; + print "Please logoff and contact your administrator for assistance.
\n"; + } else { + print "Attention Site Administrators:
\n"; + print "You have either requested a service that is unavailable at this time, \n"; + print "or else the session tracking mechanisms have encountered an error. \n"; + print "Please try another selection, or logoff and logon again to reset session tracking.
\n"; + } + print "\ 
\n"; + print "\ 
\n"; + # print "Attention Hackers:
You have attempted to gain access to this secure site \n"; + # print "by bypassing the site security.
\n"; + # print "\ 
\n"; + # print "The contents of this site are protected by United States and International copyright laws.
\n"; + # print "The information on this site is proprietary and protected by United States and International information privacy laws.
\n"; + # print "\ 
\n"; + # print "This invalid attempt has been logged, the site administrator notified, and your access route traced.
"; + # print "Any further unauthorized access attempts from $ENV{'REMOTE_ADDR'} will result "; + # print "in further investigation and possible prosecution.
\n"; + print "\n"; + print "\n"; } sub check_admin_profiles { - my ($cndid) = @_; - @aprofs = &get_data("admin.dat"); - foreach $aprof (@aprofs) { - ($aid, $trash) = split(/&/, $aprof); - if ($aid eq $cndid) { - return 1; - } + my ($cndid) = @_; + @aprofs = &get_data("admin.dat"); + foreach $aprof (@aprofs) { + ($aid, $trash) = split(/&/, $aprof); + if ($aid eq $cndid) { + return 1; } - return 0; + } + return 0; } sub checkinprogress { - my ($clid, $uid) = @_; + my ($clid, $uid) = @_; -# FIXME: This code, which I commented out, is a nagging mystery. -# FIXME: Why was it here? Can't see how it worked? -efl, 1/2002 -# $tmpfile = join( $pathsep, $testroot, "inprog", "$uid.dat"); -# open (TMPFILE, "<$tmpfile") || return 0; -# @pairs = ; -# close TMPFILE; + # FIXME: This code, which I commented out, is a nagging mystery. + # FIXME: Why was it here? Can't see how it worked? -efl, 1/2002 + # $tmpfile = join( $pathsep, $testroot, "inprog", "$uid.dat"); + # open (TMPFILE, "<$tmpfile") || return 0; + # @pairs = ; + # close TMPFILE; - $testdir = join( $pathsep, $testroot, "inprog"); + $testdir = join( $pathsep, $testroot, "inprog"); - if ( ! opendir(DIR, $testdir) ) { - &logger::logerr("Unable to opendir $testdir: $!"); - return 0; - } + if ( ! opendir(DIR, $testdir) ) { + &logger::logerr("Unable to opendir $testdir: $!"); + return 0; + } @filenames = readdir(DIR); - closedir(DIR); - - my @inprogtests = (); - foreach my $srcfile ( @filenames ) { - if ( $srcfile =~ /^$clid\.$uid\.(.*)$/ ) { - my $testid = $1; - # - # Now check to see if we are within the availability window - # - if ( &within_availability_window($clid, $testid, time) ) { - -# FIXME: Don't actually note the inprogress test file because this code -# FIXME: never worked before and was compensated for elsewhere. If it -# FIXME: ain't broke, don't fix it. If you uncomment the line below, -# FIXME: then this code works, but test resumption does not. -efl, 1/2002 -# push( @inprogtests, $testid ); + closedir(DIR); - } - } - } + my @inprogtests = (); + foreach my $srcfile ( @filenames ) { + if ( $srcfile =~ /^$clid\.$uid\.(.*)$/ ) { + my $testid = $1; + # + # Now check to see if we are within the availability window + # + if ( &within_availability_window($clid, $testid, time) ) { - if ( scalar(@inprogtests) > 1 ) { - &logger::logerr("There are ".scalar(@inprogtests)." tests in progress and available for uid $uid, clid $clid: [".join(', ', @inprogtests)."]. It was previously assumed this would not happen. No interface yet to choose which one to resume."); + # FIXME: Don't actually note the inprogress test file because this code + # FIXME: never worked before and was compensated for elsewhere. If it + # FIXME: ain't broke, don't fix it. If you uncomment the line below, + # FIXME: then this code works, but test resumption does not. -efl, 1/2002 + # push( @inprogtests, $testid ); + + } } + } + + if ( scalar(@inprogtests) > 1 ) { + &logger::logerr("There are ".scalar(@inprogtests)." tests in progress and available for uid $uid, clid $clid: [".join(', ', @inprogtests)."]. It was previously assumed this would not happen. No interface yet to choose which one to resume."); + } - $FORM{'uac'} = ""; - return scalar(@inprogtests); + $FORM{'uac'} = ""; + return scalar(@inprogtests); } # returns 1 if current time is within availability window, 0 if not # # $time is in secs since 1970... sub within_availability_window { - my ($clid, $testid, $time) = @_; + my ($clid, $testid, $time) = @_; - my ($rc, $msg, $start, $end) = get_availability_window($clid, $testid); - if ( ! $rc ) { - &logger::logerr("Unable to retrieve availability window for clid '$clid', testid '$testid': $msg"); - return 0; - } + my ($rc, $msg, $start, $end) = get_availability_window($clid, $testid); + if ( ! $rc ) { + &logger::logerr("Unable to retrieve availability window for clid '$clid', testid '$testid': $msg"); + return 0; + } - if ( $time > $start && $time < $end ) { - return 1; - } else { - return 0; - } + if ( $time > $start && $time < $end ) { + return 1; + } else { + return 0; + } } sub get_availability_window( $ $ ) { - my ($clid, $testid) = @_; + my ($clid, $testid) = @_; - my ($rc, $msg, $start, $end) = (0, "N/A", 0, 0); + my ($rc, $msg, $start, $end) = (0, "N/A", 0, 0); - ### DED 11/19/02 Have to restore original test profile when done - my $holdtestid = $TEST{'id'}; + ### DED 11/19/02 Have to restore original test profile when done + my $holdtestid = $TEST{'id'}; - if ( ! &get_test_profile($clid, $testid) ) { - &logger::logerr("Failed to get profile for clid '$clid', testid '$testid'"); - ($rc, $msg, $start, $end) = (0, "Failed to retrieve test profile", 0,0); - &get_test_profile($clid, $holdtestid); - return ($rc, $msg, $start, $end); - } - - $start = datetime_to_secssince1970( $TEST{availon} ); - if ( ! defined($start) ) { - ($rc, $msg, $start, $end) = (0, "Unable to parse availability start: [$TEST{availon}]", 0,0); - &logger::logerr("Unable to parse \$TEST{availon} = $TEST{availon}"); - &get_test_profile($clid, $holdtestid); - return ($rc, $msg, $start, $end); - } + if ( ! &get_test_profile($clid, $testid) ) { + &logger::logerr("Failed to get profile for clid '$clid', testid '$testid'"); + ($rc, $msg, $start, $end) = (0, "Failed to retrieve test profile", 0,0); + &get_test_profile($clid, $holdtestid); + return ($rc, $msg, $start, $end); + } - $end = datetime_to_secssince1970( $TEST{availthru} ); - if ( ! defined($end) ) { - ($rc, $msg, $start, $end) = (0, "Unable to parse availability end: [$TEST{availthru}]", 0,0); - &logger::logerr("Unable to parse \$TEST{availthru} = $TEST{availthru}"); - &get_test_profile($clid, $holdtestid); - return ($rc, $msg, $start, $end); - } + $start = datetime_to_secssince1970( $TEST{availon} ); + if ( ! defined($start) ) { + ($rc, $msg, $start, $end) = (0, "Unable to parse availability start: [$TEST{availon}]", 0,0); + &logger::logerr("Unable to parse \$TEST{availon} = $TEST{availon}"); + &get_test_profile($clid, $holdtestid); + return ($rc, $msg, $start, $end); + } + $end = datetime_to_secssince1970( $TEST{availthru} ); + if ( ! defined($end) ) { + ($rc, $msg, $start, $end) = (0, "Unable to parse availability end: [$TEST{availthru}]", 0,0); + &logger::logerr("Unable to parse \$TEST{availthru} = $TEST{availthru}"); &get_test_profile($clid, $holdtestid); - return (1, $msg, $start, $end); + return ($rc, $msg, $start, $end); + } + + &get_test_profile($clid, $holdtestid); + return (1, $msg, $start, $end); } sub checkalreadyloggedin { - $luid = "$_[0].$_[1]"; - open (LOGINFILE, "<$logroot/ulog.dat"); - @loginrecs = ; - close LOGINFILE; - foreach $loginrec (@loginrecs) { - chop $loginrec; - ($lguid, $lgupid, $lgutm) = split(/&/, $loginrec); - if ($lguid eq $luid) { - return 1; - } + $luid = "$_[0].$_[1]"; + open (LOGINFILE, "<$logroot/ulog.dat"); + @loginrecs = ; + close LOGINFILE; + foreach $loginrec (@loginrecs) { + chop $loginrec; + ($lguid, $lgupid, $lgutm) = split(/&/, $loginrec); + if ($lguid eq $luid) { + return 1; } - open (LOGINFILE, ">>$logroot/ulog.dat"); - print LOGINFILE "$_[0]\&$_[1]\&$$\n"; - close LOGINFILE; - return 0; + } + open (LOGINFILE, ">>$logroot/ulog.dat"); + print LOGINFILE "$_[0]\&$_[1]\&$$\n"; + close LOGINFILE; + return 0; } ## v support for wildcard ids sub IsTaclID { - my ($clid,$taclid,$pwd,$testid) = @_; - - # - # see if there are any test access ids for this client - # - my @taclrecs=&get_data("tacl.$clid"); - unless ($#taclrecs > 0) { return 0;} - - # - # now build a list of available tests for the login id given - # - my @flds; - my $lctaclid=lc($taclid); - my $uctaclid=uc($taclid); - my $rec="($taclid|$uctaclid|$lctaclid)\&(.*)\&$pwd\&"; - my @trecs=grep( /$rec/, @taclrecs); - my $rec=shift @taclrecs; - @taclrecs=(); - unless ($#trecs != -1) { return 0}; - - # - # found some matches, now confirm the password to verifry the grep - # - my $taclauthtests=""; - my $tsep=""; - foreach $tacl (@trecs) { - chop ($tacl); - @flds=split(/&/,$tacl); - if ($flds[2] eq $pwd) { - $taclauthtests=join ('::',$taclauthtests,"$tacl"); - } - } - @trecs=(); - unless ($taclauthtests ne '') { return 0}; - $taclauthtests = substr($taclauthtests,2); - - # - # There is a list, so verify access for this id - # - ### DED 3/5/04 Added for auto-login support - if ($pwd eq "_____") { - $rec = "$taclid&$testid&$pwd"; - @trecs=grep( /$rec/, $taclauthtests); - unless ($#trecs != -1) { return 0}; - $SESSION{'taclid'}=get_anon_seqno($clid, $testid); - } else { - $SESSION{'taclid'}="$taclid.$pwd"; + my ($clid,$taclid,$pwd,$testid) = @_; + + # + # see if there are any test access ids for this client + # + my @taclrecs=&get_data("tacl.$clid"); + unless ($#taclrecs > 0) { return 0;} + + # + # now build a list of available tests for the login id given + # + my @flds; + my $lctaclid=lc($taclid); + my $uctaclid=uc($taclid); + my $rec="($taclid|$uctaclid|$lctaclid)\&(.*)\&$pwd\&"; + my @trecs=grep( /$rec/, @taclrecs); + my $rec=shift @taclrecs; + @taclrecs=(); + unless ($#trecs != -1) { return 0}; + + # + # found some matches, now confirm the password to verifry the grep + # + my $taclauthtests=""; + my $tsep=""; + foreach $tacl (@trecs) { + chop ($tacl); + @flds=split(/&/,$tacl); + if ($flds[2] eq $pwd) { + $taclauthtests=join ('::',$taclauthtests,"$tacl"); } - $SESSION{'taclauthtests'}=$taclauthtests; - $SESSION{'uac'} = "cnd"; - return 1; + } + @trecs=(); + unless ($taclauthtests ne '') { return 0}; + $taclauthtests = substr($taclauthtests,2); + + # + # There is a list, so verify access for this id + # + ### DED 3/5/04 Added for auto-login support + if ($pwd eq "_____") { + $rec = "$taclid&$testid&$pwd"; + @trecs=grep( /$rec/, $taclauthtests); + unless ($#trecs != -1) { return 0}; + $SESSION{'taclid'}=get_anon_seqno($clid, $testid); + } else { + $SESSION{'taclid'}="$taclid.$pwd"; + } + $SESSION{'taclauthtests'}=$taclauthtests; + $SESSION{'uac'} = "cnd"; + return 1; } ## ^ support for wildcard ids sub verifyaccess { - $FORM{'uac'} = ""; -## v support for wildcard ids - if (&IsTaclID($FORM{'clid'},$FORM{'uid'},$FORM{'pwd'},$FORM{'testid'})) { - return 1; - } -## ^ support for wildcard ids - if ($FORM{'tadm'} ne '' || $FORM{'sadm'} ne '') { - $tmpfile = "admin.dat"; - ($oldpass,$newpass,$confirmpass) = split(/\//, $FORM{'pwd'}); + $FORM{'uac'} = ""; + ## v support for wildcard ids + if (&IsTaclID($FORM{'clid'},$FORM{'uid'},$FORM{'pwd'},$FORM{'testid'})) { + return 1; + } + ## ^ support for wildcard ids + if ($FORM{'tadm'} ne '' || $FORM{'sadm'} ne '') { + $tmpfile = "admin.dat"; + ($oldpass,$newpass,$confirmpass) = split(/\//, $FORM{'pwd'}); + } else { + $oldpass = $FORM{'pwd'}; + $newpass = ""; + if ($FORM{'cnd'} ne '') { + $tmpfile = "cnd.$FORM{'clid'}"; } else { - $oldpass = $FORM{'pwd'}; - $newpass = ""; - if ($FORM{'cnd'} ne '') { - $tmpfile = "cnd.$FORM{'clid'}"; - } else { - # self assessment request - if ($FORM{'sar'} ne '') { - $tmpfile = "sar.$FORM{'clid'}"; - } else {$uacerror = 1;} - } + # self assessment request + if ($FORM{'sar'} ne '') { + $tmpfile = "sar.$FORM{'clid'}"; + } else {$uacerror = 1;} } - unless ($uacerror) { - @pairs = &get_data($tmpfile); - foreach $pair (@pairs) { - chop ($pair); - ($id, $pw, $pv, $clid) = split(/&/, $pair); - if ($id eq $FORM{'uid'}) { - if ($pw eq $oldpass) { - if ($FORM{'tadm'} ne '' || $FORM{'sadm'} ne '') { - $FORM{'uac'} = $pv; - $FORM{'clid'} = ($clid eq 'sacc') ? "std" : $clid; - if ($newpass ne '') { - if ($newpass eq $confirmpass) { - if (&change_password($id,$newpass,$pv,$clid)) { - $SYSTEM{'message'} = "Your password has been changed." - } else { - $SYSTEM{'message'} = "Your password could not be changed." - } - } else { - $SYSTEM{'pwchange'} = "Your password was not changed. The new password and confirming password did not match." - } - } else { - $SYSTEM{'pwchange'} = "" - } - } else { - @flds = split(/&/, $pair); - #if ($FORM{'sas'} ne '') - if ($flds[17] eq 'Y') { - $FORM{'uac'} = "sas"; - $FORM{'sas'} = "xxx"; - } else { - $FORM{'uac'} = "cnd"; - } - $FORM{'clid'} = $FORM{'clid'}; - } - if ($ipfilter ne '') { - if ($FORM{'uac'} ne 'gadmin') { - if (&ipfilteredaccess($ipfilter,$ENV{'REMOTE_ADDR'})) { - return 1; - } else { - return 0; - } - } else { - return 1; - } - } else { - $SESSION{'clid'} = $FORM{'clid'}; - &get_client_configuration(); - if ($SYSTEM{'IP_ACCESS_FILTER'} ne '') { - $SYSTEM{'message'} = "System is Locked Down"; - if (($FORM{'uac'} ne 'gadmin') && ($FORM{'uac'} ne 'admin') && ($FORM{'uac'} ne 'madmin')) { - if (&ipfilteredaccess($SYSTEM{'IP_ACCESS_FILTER'},$ENV{'REMOTE_ADDR'})) { - return 1; - } else { - return 0; - } - } else { - return 1; - } - } else { - return 1; - } - } + } + unless ($uacerror) { + @pairs = &get_data($tmpfile); + foreach $pair (@pairs) { + chop ($pair); + ($id, $pw, $pv, $clid) = split(/&/, $pair); + if ($id eq $FORM{'uid'}) { + if ($pw eq $oldpass) { + if ($FORM{'tadm'} ne '' || $FORM{'sadm'} ne '') { + $FORM{'uac'} = $pv; + $FORM{'clid'} = ($clid eq 'sacc') ? "std" : $clid; + if ($newpass ne '') { + if ($newpass eq $confirmpass) { + if (&change_password($id,$newpass,$pv,$clid)) { + $SYSTEM{'message'} = "Your password has been changed." + } else { + $SYSTEM{'message'} = "Your password could not be changed." } + } else { + $SYSTEM{'pwchange'} = "Your password was not changed. The new password and confirming password did not match." + } + } else { + $SYSTEM{'pwchange'} = "" } - } - if ($FORM{'cnd'} ne '') { - $FORM{'tadm'} = "xxx"; - $FORM{'cnd'} = ""; - if (&verifyaccess) { - if ($ipfilter ne '') { - if ($FORM{'uac'} ne 'gadmin') { - if (&ipfilteredaccess($ipfilter,$ENV{'REMOTE_ADDR'})) { - return 1; - } else { - if (($SYSTEM{'IP_ACCESS_FILTER'} ne '') && ($FORM{'uac'} ne 'gadmin')) { - if (&ipfilteredaccess($SYSTEM{'IP_ACCESS_FILTER'},$ENV{'REMOTE_ADDR'})) { - return 1; - } else { - return 0; - } - } else { - return 1; - } - } - } else { - return 1; - } + } else { + @flds = split(/&/, $pair); + #if ($FORM{'sas'} ne '') + if ($flds[17] eq 'Y') { + $FORM{'uac'} = "sas"; + $FORM{'sas'} = "xxx"; + } else { + $FORM{'uac'} = "cnd"; + } + $FORM{'clid'} = $FORM{'clid'}; + } + if ($ipfilter ne '') { + if ($FORM{'uac'} ne 'gadmin') { + if (&ipfilteredaccess($ipfilter,$ENV{'REMOTE_ADDR'})) { + return 1; + } else { + return 0; + } + } else { + return 1; + } + } else { + $SESSION{'clid'} = $FORM{'clid'}; + &get_client_configuration(); + if ($SYSTEM{'IP_ACCESS_FILTER'} ne '') { + $SYSTEM{'message'} = "System is Locked Down"; + if (($FORM{'uac'} ne 'gadmin') && ($FORM{'uac'} ne 'admin') && ($FORM{'uac'} ne 'madmin')) { + if (&ipfilteredaccess($SYSTEM{'IP_ACCESS_FILTER'},$ENV{'REMOTE_ADDR'})) { + return 1; } else { - return 1; + return 0; } + } else { + return 1; + } } else { - return 0; + return 1; } + } + } + } + } + if ($FORM{'cnd'} ne '') { + $FORM{'tadm'} = "xxx"; + $FORM{'cnd'} = ""; + if (&verifyaccess) { + if ($ipfilter ne '') { + if ($FORM{'uac'} ne 'gadmin') { + if (&ipfilteredaccess($ipfilter,$ENV{'REMOTE_ADDR'})) { + return 1; + } else { + if (($SYSTEM{'IP_ACCESS_FILTER'} ne '') && ($FORM{'uac'} ne 'gadmin')) { + if (&ipfilteredaccess($SYSTEM{'IP_ACCESS_FILTER'},$ENV{'REMOTE_ADDR'})) { + return 1; + } else { + return 0; + } + } else { + return 1; + } + } + } else { + return 1; + } + } else { + return 1; } + } else { + return 0; + } } - return 0; + } + return 0; } sub change_password { - @rs = &get_data("admin.dat"); - $rskp = shift @rs; - foreach $rs (@rs) { - chop ($rs); - ($xxid, $xxpw, $xxpv, $xxclid) = split(/&/, $rs); - if ($xxid eq $_[0]) { - $rs = join('&', $_[0], $_[1], $_[2], $_[3]); - } - push @newrs, $rs; - } - @rs = sort @newrs; - @newrs = (); - $tmpfile = join($pathsep, $dataroot, "admin.dat"); - open (TMPFILE, ">$tmpfile") or return 0; - print TMPFILE "$rskp"; - foreach $rs (@rs) { - print TMPFILE "$rs\n"; - } - close TMPFILE; - return 1; + @rs = &get_data("admin.dat"); + $rskp = shift @rs; + foreach $rs (@rs) { + chop ($rs); + ($xxid, $xxpw, $xxpv, $xxclid) = split(/&/, $rs); + if ($xxid eq $_[0]) { + $rs = join('&', $_[0], $_[1], $_[2], $_[3]); + } + push @newrs, $rs; + } + @rs = sort @newrs; + @newrs = (); + $tmpfile = join($pathsep, $dataroot, "admin.dat"); + open (TMPFILE, ">$tmpfile") or return 0; + print TMPFILE "$rskp"; + foreach $rs (@rs) { + print TMPFILE "$rs\n"; + } + close TMPFILE; + return 1; } sub eval_logical_html { - my ($exaction, $value, $exval) = @_; - $exludeflag = 0; - @exvals = split(/\,/, $exval); - foreach $exval (@exvals) { - if ($exval eq 'NULL') { - $exval = ""; - } - if ($exaction eq 'INCLUDE') { - $exludeflag = ($value eq $exval) ? 0 : 1; - } else { - $exludeflag = ($value eq $exval) ? 1 : 0; - } - last if($value eq $exval); + my ($exaction, $value, $exval) = @_; + $exludeflag = 0; + @exvals = split(/\,/, $exval); + foreach $exval (@exvals) { + if ($exval eq 'NULL') { + $exval = ""; + } + if ($exaction eq 'INCLUDE') { + $exludeflag = ($value eq $exval) ? 0 : 1; + } else { + $exludeflag = ($value eq $exval) ? 1 : 0; } - return $exludeflag; + last if($value eq $exval); + } + return $exludeflag; } sub xlatline { - my ($xltline, $fh, $escapem, $parse_nop) = @_; # print translation to filehandle $fh - $fh = (defined($fh) ? $fh : *STDOUT); - if ($#sifnests == -1) { - $sifnests[0] = 0; - $sifncnt = 0; - $sifnestlevel = 0; - } - - if ($xltline =~ /(<%=)NOP_(\S+.*?%>)/i && $parse_nop) { - $xltline =~ s/(<%=)NOP_(\S+.*?%>)/$1$2/g; - } - my $nopopuptag ; - - if ($xltline =~ /<%=SYSTEM\.STARTIF.(.*?)%>/i ) { - ($trash, $exstatement) = split(/\?/, $xltline); - ($exvar, $exval, $exaction, $trash) = split(/ /, $exstatement); - ($exarray, $exkey) = split(/\./, $exvar); - if ($exarray eq 'FORM') { - $excludeon = &eval_logical_html($exaction,$FORM{$exkey}, $exval); - } elsif ($exarray eq 'CLIENT') { - $excludeon = &eval_logical_html($exaction,$CLIENT{$exkey}, $exval); - } elsif ($exarray eq 'GROUP') { - $excludeon = &eval_logical_html($exaction,$GROUP{$exkey}, $exval); - } elsif ($exarray eq 'TEST') { - $excludeon = &eval_logical_html($exaction,$TEST{$exkey}, $exval); - } elsif ($exarray eq 'SUBTEST') { - $excludeon = &eval_logical_html($exaction,$SUBTEST{$exkey}, $exval); - } elsif ($exarray eq 'QUESTION') { - $excludeon = &eval_logical_html($exaction,$QUESTION{$exkey}, $exval); - } elsif ($exarray eq 'GRADEBOOK') { - $excludeon = &eval_logical_html($exaction,$GRADEBOOK{$exkey}, $exval); - } elsif ($exarray eq 'CANDIDATE') { - $excludeon = &eval_logical_html($exaction,$CANDIDATE{$exkey}, $exval); - } elsif ($exarray eq 'SYSTEM') { - $excludeon = &eval_logical_html($exaction,$SYSTEM{$exkey}, $exval); - } elsif ($exarray eq 'UI') { - $excludeon = &eval_logical_html($exaction,$UI{$exkey}, $exval); - } elsif ($exarray eq 'SUBJAREA') { - $excludeon = &eval_logical_html($exaction,$SUBJAREA{$exkey}, $exval); - } elsif ($exarray eq 'SESSION') { - $excludeon = &eval_logical_html($exaction,$SESSION{$exkey}, $exval); - } - if ($sifnests[$sifcnt]) { - $sifncnt++; - } else { - $sifncnt++; - $sifnests[$sifncnt] = $excludeon; - for (1 .. $sifncnt) { - $sifnestlevel = $_; - $excludeon = $sifnests[$_]; - last if ($excludeon); - } + my ($xltline, $fh, $escapem, $parse_nop) = @_; # print translation to filehandle $fh + $fh = (defined($fh) ? $fh : *STDOUT); + if ($#sifnests == -1) { + $sifnests[0] = 0; + $sifncnt = 0; + $sifnestlevel = 0; + } + + if ($xltline =~ /(<%=)NOP_(\S+.*?%>)/i && $parse_nop) { + $xltline =~ s/(<%=)NOP_(\S+.*?%>)/$1$2/g; + } + my $nopopuptag ; + + if ($xltline =~ /<%=SYSTEM\.STARTIF.(.*?)%>/i ) { + ($trash, $exstatement) = split(/\?/, $xltline); + ($exvar, $exval, $exaction, $trash) = split(/ /, $exstatement); + ($exarray, $exkey) = split(/\./, $exvar); + if ($exarray eq 'FORM') { + $excludeon = &eval_logical_html($exaction,$FORM{$exkey}, $exval); + } elsif ($exarray eq 'CLIENT') { + $excludeon = &eval_logical_html($exaction,$CLIENT{$exkey}, $exval); + } elsif ($exarray eq 'GROUP') { + $excludeon = &eval_logical_html($exaction,$GROUP{$exkey}, $exval); + } elsif ($exarray eq 'TEST') { + $excludeon = &eval_logical_html($exaction,$TEST{$exkey}, $exval); + } elsif ($exarray eq 'SUBTEST') { + $excludeon = &eval_logical_html($exaction,$SUBTEST{$exkey}, $exval); + } elsif ($exarray eq 'QUESTION') { + $excludeon = &eval_logical_html($exaction,$QUESTION{$exkey}, $exval); + } elsif ($exarray eq 'GRADEBOOK') { + $excludeon = &eval_logical_html($exaction,$GRADEBOOK{$exkey}, $exval); + } elsif ($exarray eq 'CANDIDATE') { + $excludeon = &eval_logical_html($exaction,$CANDIDATE{$exkey}, $exval); + } elsif ($exarray eq 'SYSTEM') { + $excludeon = &eval_logical_html($exaction,$SYSTEM{$exkey}, $exval); + } elsif ($exarray eq 'UI') { + $excludeon = &eval_logical_html($exaction,$UI{$exkey}, $exval); + } elsif ($exarray eq 'SUBJAREA') { + $excludeon = &eval_logical_html($exaction,$SUBJAREA{$exkey}, $exval); + } elsif ($exarray eq 'SESSION') { + $excludeon = &eval_logical_html($exaction,$SESSION{$exkey}, $exval); + } + if ($sifnests[$sifcnt]) { + $sifncnt++; + } else { + $sifncnt++; + $sifnests[$sifncnt] = $excludeon; + for (1 .. $sifncnt) { + $sifnestlevel = $_; + $excludeon = $sifnests[$_]; + last if ($excludeon); + } + } + return ""; + } elsif ($xltline =~ /<%=SYSTEM\.ELSE%>/i ) { + if ($sifnestlevel == $sifncnt) { + $excludeon = ($excludeon) ? 0 : 1; + } + return ""; + } elsif ($xltline =~ /<%=SYSTEM\.ENDIF%>/i ) { + $excludeon = 0; + $sifnests[$sifncnt] = 0; + $sifncnt--; + $sifnestlevel = 0; + for (1 .. $sifncnt) { + $sifnestlevel = $_; + $excludeon = $sifnests[$_]; + last if ($excludeon); + } + return ""; + } else { + if ($excludeon) { return "";} + } + if ($xltline =~ /<%=(.*?)%>/ ) { + if ($xltline =~ /<%=PATHS\.(.*?)%>/i ) { + for (keys %PATHS) { + $repl = $PATHS{$_}; + $srch1 = join('', "<%=PATHS.", $_, "%>"); + $xltline =~ s/$srch1/$repl/g; + } + } + if ($xltline =~ /<%=SITE.REPORTS%>/) { + &get_site_reports_list($fh); + } + if ($xltline =~ /<%=SYSTEM\.(.*?)%>/i ) { + if ($xltline =~ /<%=SYSTEM\.INCLUDEJS (.*?)%>/i ) { + @incsegs = split(/ /, $xltline); + $incjsfile = $incsegs[1]; + @incsegs = (); + unless ($incjsfile eq '') { + $incjsfile = join($pathsep, $cfgroot, "js", $incjsfile); + open (TMPJSFILE, "<$incjsfile"); + @tmpjslines = ; + close TMPJSFILE; + foreach $tmpjsline (@tmpjslines) { + $tmpjsline = &xlatline($tmpjsline, $fh); + } + @tmpjslines = (); } return ""; - } elsif ($xltline =~ /<%=SYSTEM\.ELSE%>/i ) { - if ($sifnestlevel == $sifncnt) { - $excludeon = ($excludeon) ? 0 : 1; - } + } elsif ($xltline =~ /<%=SYSTEM\.date%>/i ) { + $repl = `date "+%b %d, %Y"`; + $srch1 = "<%=SYSTEM.date%>"; + $xltline =~ s/$srch1/$repl/g; + } else { + for (keys %SYSTEM) { + $repl = $SYSTEM{$_}; + $srch1 = join('', "<%=SYSTEM.", $_, "%>"); + $xltline =~ s/$srch1/$repl/g; + } + } + } + if ($xltline =~ /<%=SESSION\.(.*?)%>/i ) { + for (keys %SESSION) { + $repl = $SESSION{$_}; + $srch1 = join('', "<%=SESSION.", $_, "%>"); + $xltline =~ s/$srch1/$repl/g; + } + } + if ($xltline =~ /<%=FORM\.servertime%>/i ) { + $repl = POSIX::strftime($UI{DATETIME_FMT}, localtime(time)); + $srch1 = join('', "<%=FORM.servertime%>"); + $xltline =~ s/$srch1/$repl/g; + } elsif ($xltline =~ /<%=FORM\.(.*?)%>/i ) { + for (keys %FORM) { + $repl = $FORM{$_}; + $srch1 = join('', "<%=FORM.", $_, "%>"); + $xltline =~ s/$srch1/$repl/g; + } + } + if ($xltline =~ /<%=TEST_SESSION\.(.*?)%>/i ) { + for (keys %TEST_SESSION) { + $repl = $TEST_SESSION{$_}; + $srch1 = join('', "<%=TEST_SESSION.", $_, "%>"); + $xltline =~ s/$srch1/$repl/g; + } + } + if ($xltline =~ /<%=SUBTEST\.(.*?)%>/i ) { + for (keys %SUBTEST) { + $repl = $SUBTEST{$_}; + $srch1 = join('', "<%=SUBTEST.", $_, "%>"); + $xltline =~ s/$srch1/$repl/g; + } + } + if ($xltline =~ /<%=GROUP\.(.*?)%>/i ) { + for (keys %GROUP) { + $repl = $GROUP{$_}; + $srch1 = join('', "<%=GROUP.", $_, "%>"); + $xltline =~ s/$srch1/$repl/g; + } + } + if ($xltline =~ /<%=SUBJAREA\.(.*?)%>/i ) { + for (keys %SUBJAREA) { + $repl = $SUBJAREA{$_}; + $srch1 = join('', "<%=SUBJAREA.", $_, "%>"); + $xltline =~ s/$srch1/$repl/g; + } + } + if ($xltline =~ /<%=PHRASE\.(.+?)%>/i) { + while ( $xltline =~ m/<%=PHRASE\.(.+?)%>/ix) { + my $id = $1; + $srch1 = join("", "<%=PHRASE.", $id, "%>"); + $repl = GetLanguageElement($SESSION{lang}, $id); + $xltline =~ s/$srch1/$repl/g; + } + } + if ($xltline =~ /<%=GRADEBOOK\.(.*?)%>/i ) { + for (keys %GRADEBOOK) { + $repl = $GRADEBOOK{$_}; + $srch1 = join('', "<%=GRADEBOOK.", $_, "%>"); + $xltline =~ s/$srch1/$repl/g; + } + } + if ($xltline =~ /<%=CLIENTS\.Options%>/i ) { + &print_client_options($fh); + return ""; + } + if ($xltline =~ /<%=CLIENTS\.List%>/) { + $client_list = &print_client_list($fh); + $xltline =~ s/<%=CLIENTS.List%>/$client_list/g; + } + if ($xltline =~ /<%=CLIENT\.(.*?)%>/i ) { + if ( $xltline =~ /<%=CLIENT\.REPORTS%>/i) { + &get_client_reports_list($fh, $SESSION{'clid'}, $SESSION{'uid'}); return ""; - } elsif ($xltline =~ /<%=SYSTEM\.ENDIF%>/i ) { - $excludeon = 0; - $sifnests[$sifncnt] = 0; - $sifncnt--; - $sifnestlevel = 0; - for (1 .. $sifncnt) { - $sifnestlevel = $_; - $excludeon = $sifnests[$_]; - last if ($excludeon); - } + } elsif ( $xltline =~ /<%=CLIENT.TESTS%>/i) { + &print_noncfa_test_options($CLIENT{'clid'}, $fh); return ""; - } else { - if ($excludeon) { return "";} - } - if ($xltline =~ /<%=(.*?)%>/ ) { - if ($xltline =~ /<%=PATHS\.(.*?)%>/i ) { - for (keys %PATHS) { - $repl = $PATHS{$_}; - $srch1 = join('', "<%=PATHS.", $_, "%>"); - $xltline =~ s/$srch1/$repl/g; - } - } - if ($xltline =~ /<%=SITE.REPORTS%>/) { - &get_site_reports_list($fh); - } - if ($xltline =~ /<%=SYSTEM\.(.*?)%>/i ) { - if ($xltline =~ /<%=SYSTEM\.INCLUDEJS (.*?)%>/i ) { - @incsegs = split(/ /, $xltline); - $incjsfile = $incsegs[1]; - @incsegs = (); - unless ($incjsfile eq '') { - $incjsfile = join($pathsep, $cfgroot, "js", $incjsfile); - open (TMPJSFILE, "<$incjsfile"); - @tmpjslines = ; - close TMPJSFILE; - foreach $tmpjsline (@tmpjslines) { - $tmpjsline = &xlatline($tmpjsline, $fh); - } - @tmpjslines = (); - } - return ""; - } elsif ($xltline =~ /<%=SYSTEM\.date%>/i ) { - $repl = `date "+%b %d, %Y"`; - $srch1 = "<%=SYSTEM.date%>"; - $xltline =~ s/$srch1/$repl/g; - } else { - for (keys %SYSTEM) { - $repl = $SYSTEM{$_}; - $srch1 = join('', "<%=SYSTEM.", $_, "%>"); - $xltline =~ s/$srch1/$repl/g; - } - } - } - if ($xltline =~ /<%=SESSION\.(.*?)%>/i ) { - for (keys %SESSION) { - $repl = $SESSION{$_}; - $srch1 = join('', "<%=SESSION.", $_, "%>"); - $xltline =~ s/$srch1/$repl/g; - } - } - if ($xltline =~ /<%=FORM\.servertime%>/i ) { - $repl = POSIX::strftime($UI{DATETIME_FMT}, localtime(time)); - $srch1 = join('', "<%=FORM.servertime%>"); - $xltline =~ s/$srch1/$repl/g; - } elsif ($xltline =~ /<%=FORM\.(.*?)%>/i ) { - for (keys %FORM) { - $repl = $FORM{$_}; - $srch1 = join('', "<%=FORM.", $_, "%>"); - $xltline =~ s/$srch1/$repl/g; - } - } - if ($xltline =~ /<%=TEST_SESSION\.(.*?)%>/i ) { - for (keys %TEST_SESSION) { - $repl = $TEST_SESSION{$_}; - $srch1 = join('', "<%=TEST_SESSION.", $_, "%>"); - $xltline =~ s/$srch1/$repl/g; - } - } - if ($xltline =~ /<%=SUBTEST\.(.*?)%>/i ) { - for (keys %SUBTEST) { - $repl = $SUBTEST{$_}; - $srch1 = join('', "<%=SUBTEST.", $_, "%>"); - $xltline =~ s/$srch1/$repl/g; - } - } - if ($xltline =~ /<%=GROUP\.(.*?)%>/i ) { - for (keys %GROUP) { - $repl = $GROUP{$_}; - $srch1 = join('', "<%=GROUP.", $_, "%>"); - $xltline =~ s/$srch1/$repl/g; - } - } - if ($xltline =~ /<%=SUBJAREA\.(.*?)%>/i ) { - for (keys %SUBJAREA) { - $repl = $SUBJAREA{$_}; - $srch1 = join('', "<%=SUBJAREA.", $_, "%>"); - $xltline =~ s/$srch1/$repl/g; - } - } - if ($xltline =~ /<%=PHRASE\.(.+?)%>/i) { - while ( $xltline =~ m/<%=PHRASE\.(.+?)%>/ix) { - my $id = $1; - $srch1 = join("", "<%=PHRASE.", $id, "%>"); - $repl = GetLanguageElement($SESSION{lang}, $id); - $xltline =~ s/$srch1/$repl/g; + } elsif ( $xltline =~ /<%=CLIENT.userlist%>/i) { + &print_client_cnd_options($CLIENT{'clid'}, $fh); + return ""; + } elsif ( $xltline =~ /<%=CLIENT.adminids%>/i) { + &print_client_adminids($CLIENT{'clid'}, $fh); + return ""; + } elsif ( $xltline =~ /<%=CLIENT.forms%>/i) { + &print_client_test_forms($CLIENT{'clid'}, $fh); + return ""; + } elsif ( $xltline =~ /<%=CLIENT.grpowners%>/i) { + &print_group_owners($CLIENT{'clid'}, $fh); + return ""; + } elsif ( $xltline =~ /<%=CLIENT.grpowners_ownedby%>/i) { + &print_group_owners($CLIENT{'clid'}, $fh, 1); + return ""; + } elsif ( $xltline =~ /<%=CLIENT.registrars_ownedby%>/i) { + &print_registrars($CLIENT{'clid'}, $fh, 1); + return ""; + } elsif ( $xltline =~ /<%=CLIENT.groups%>/i) { + &print_client_groups($CLIENT{'clid'}, $fh); + return ""; + # v sac modification to standardize test sequence inputs + } elsif ( $xltline =~ /<%=CLIENT.cfas%>/i) { + $repl = &print_client_seqtst_list($CLIENT{'clid'},"cfa",$TEST{'dscl'},$fh); + $srch = join('', "<%=CLIENT.", "cfas", "%>"); + $xltline =~ s/$srch/$repl/g; + } elsif ( $xltline =~ /<%=CLIENT.profbs%>/i) { + $repl = &print_client_seqtst_list($CLIENT{'clid'},"profb",$TEST{'profb'},$fh); + $srch = join('', "<%=CLIENT.", "profbs", "%>"); + $xltline =~ s/$srch/$repl/g; + } elsif ( $xltline =~ /<%=CLIENT.profas%>/i) { + $repl = &print_client_seqtst_list($CLIENT{'clid'},"profa",$TEST{'profa'},$fh); + $srch = join('', "<%=CLIENT.", "profas", "%>"); + $xltline =~ s/$srch/$repl/g; + } elsif ( $xltline =~ /<%=CLIENT.srvys%>/i) { + $repl = &print_client_seqtst_list($CLIENT{'clid'},"srvy",$TEST{'srvy'},$fh); + $srch = join('', "<%=CLIENT.", "srvys", "%>"); + $xltline =~ s/$srch/$repl/g; + # ^ sac modification to standardize test sequence inputs + } elsif ( $xltline =~ /<%=CLIENT.userlanguageselect%>/i) { + &print_user_language_select($CLIENT{'clid'}); + return ""; + } elsif ( $xltline =~ /<%=CLIENT.userlanguageselectdrop%>/i) { + &print_user_language_select($CLIENT{'clid'},1); + return ""; + } elsif ( $xltline =~ /<%=CLIENT.forsaletable%>/i) { + &print_client_forsale_table($CLIENT{'clid'}, 0); + return ""; + } elsif ( $xltline =~ /<%=CLIENT.ordertable%>/i) { + &print_client_forsale_table($CLIENT{'clid'}, 1); + return ""; + } elsif ( $xltline =~ /<%=CLIENT.clcnd1input%>/i) { + &print_clcnd_input($CLIENT{'clid'}, 1, 0, 1); + return ""; + } elsif ( $xltline =~ /<%=CLIENT.clcnd2input%>/i) { + &print_clcnd_input($CLIENT{'clid'}, 2, 0, 1); + return ""; + } elsif ( $xltline =~ /<%=CLIENT.clcnd3input%>/i) { + &print_clcnd_input($CLIENT{'clid'}, 3, 0, 1); + return ""; + } elsif ( $xltline =~ /<%=CLIENT.clcnd4input%>/i) { + &print_clcnd_input($CLIENT{'clid'}, 4, 0, 1); + return ""; + } elsif ( $xltline =~ /<%=CLIENT.clcnd1inputf%>/i) { + &print_clcnd_input($CLIENT{'clid'}, 1, "f", 1); + return ""; + } elsif ( $xltline =~ /<%=CLIENT.clcnd2inputf%>/i) { + &print_clcnd_input($CLIENT{'clid'}, 2, "f", 1); + return ""; + } elsif ( $xltline =~ /<%=CLIENT.clcnd3inputf%>/i) { + &print_clcnd_input($CLIENT{'clid'}, 3, "f", 1); + return ""; + } elsif ( $xltline =~ /<%=CLIENT.clcnd4inputf%>/i) { + &print_clcnd_input($CLIENT{'clid'}, 4, "f", 1); + return ""; + } else { + for (keys %CLIENT) { + $repl = $CLIENT{$_}; + $srch = join('', "<%=CLIENT.", $_, "%>"); + $xltline =~ s/$srch/$repl/g; + } + } + } + if ($line =~ /<%=MADMIN.CLIENTS%>/) { + &get_madmin_client_list($SESSION{'mclid'}); + } + if ($xltline =~ /<%=INSTANCE\.desc%>/i ) { + $fh = (defined($fh) ? $fh : *STDOUT); + my $repl = &get_a_key("tests.".$SESSION{'clid'}, $TEST{'instanceof'}, "desc"); + my $srch = "<%=INSTANCE.desc%>"; + $xltline =~ s/$srch/$repl/g; + } + if ($xltline =~ /<%=TESTS\.Options%>/i ) { + &print_std_test_options($SESSION{'clid'}, $fh); + return ""; + } + if ($xltline =~ /<%=TESTS\.inherit%>/i ) { + &print_filtered_test_options("std", $CLIENT{'clid'}, $fh); + return ""; + } + if ($xltline =~ /<%=TEST\.(.*?)%>/i ) { + for (keys %TEST) { + $repl = $TEST{$_}; + $srch = join('', "<%=TEST.", $_, "%>"); + $xltline =~ s/$srch/$repl/g; + } + } + if ($xltline =~ /<%=QUESTION\.(.*?)%>/i ) { + for (keys %QUESTION) { + $repl = $QUESTION{$_}; + $repl = escape_special_chars( $repl ) if ( $escapem == 1 ); + $srch = join('', "<%=QUESTION.", $_, "%>"); + $xltline =~ s/$srch/$repl/g; + } + } + while ($xltline =~ /<%=QUESTIONS_AH\.([0-9]+)\.(.+)%>/ ) { + my $ques_num = $1 ; + my $ques_index = $ques_num - 1 ; + my $ques_key = $2 ; + # warn "Found QUESTIONS_AH num $ques_num index $ques_index key $ques_key \n" ; + $repl = ${$QUESTIONS_AH}[$ques_index]->{$ques_key} ; + if ($OUTPUT_Format eq "RTF") {$repl =~ s/\/\\par /ig ;} + $repl = &escape_special_chars( $repl ) if ( $escapem == 1 ) ; + $srch = "<%=QUESTIONS_AH." . $ques_num . "." . $ques_key . "%>" ; + $xltline =~ s/$srch/$repl/g ; + } + while ($xltline =~ /<%=QUESTIONS_AG\.([0-9]+)\.(.+)%>/ ) { + my $ques_num = $1 ; + my $ques_index = $ques_num - 1 ; + my $ques_key = $2 ; + # warn "Found QUESTIONS_AG num $ques_num index $ques_index key $ques_key \n" ; + $repl = ${$QUESTIONS_AG}[$ques_index]->{$ques_key} ; + if ($OUTPUT_Format eq "RTF") {$repl =~ s/\/\\par /ig ;} + $repl = &escape_special_chars( $repl ) if ( $escapem == 1 ) ; + $srch = "<%=QUESTIONS_AG." . $ques_num . "." . $ques_key . "%>" ; + $xltline =~ s/$srch/$repl/g ; + } + if ($xltline =~ /(<%=)ESCAPED_(\S+\..*?%>)/i ) { + # + # I needed a way to indicate from within a template that a value + # needs to be escaped for use within an HTML tag. Thus, + # you may put "ESCAPED_" in front of any template tag + # and it gets removed here, but turns on the escape flag + # for a recursive call to xlatline() and escape_special_chars(). + # + # Initially this is only being implemented for %QUESTION, + # but is structured to allow calls to escape_special_chars() + # for other template tag types (see example above). -efl, 2/2002 + # + $xltline =~ s/(<%=)ESCAPED_(\S+\..*?%>)/$1$2/g; + return &xlatline($xltline, $fh, 1); + } + + if ($xltline =~ /<%=CANDIDATES\.Options%>/i ) { + &print_client_cnd_options($SESSION{'clid'}, $fh); + return ""; + } + if ($xltline =~ /<%=CANDIDATE\.(.*?)%>/i ) { + # for (keys %CANDIDATE) # This is the original code. It is an un-needed loop. HBI + for (keys %CANDIDATE) { + my $Opt_Pre_Select = "" ; + $srch1 = "<%=CANDIDATE.authtestsoptions%>"; + if ($xltline =~ m/$srch1/ ) { + if ($CANDIDATE{'inproglist'} eq '') { + @authtests = split(/\;/, $CANDIDATE{'authlist'}); + warn "Test ID " . __LINE__ . " testid $FORM{'testid'} tstid $FORM{'tstid'}.\n" if ($Debug_HBI_PreSelect_Test) ; + my $repl = ""; + foreach $authtest (@authtests) { + if ($FORM{'testid'} eq "" || $FORM{'testid'} eq "$authtest") { + &get_test_profile($SESSION{'clid'}, $authtest); + #print $fh "