# ---------------------------------------------------------------------------
#     ENTERLIB.PL
#
#      Ver: 8_4_8
# ---------------------------------------------------------------------------
# SSI Web - Web Surveying System
# Copyright Sawtooth Software, Inc. 1998-2015. All rights reserved.
# Orem, UT  USA  (801) 477-4700
#
# Any modification of this script will be considered violation of
# copyright (with the exception of the first line which can be
# modified to reflect the correct path to the Perl interpreter)
#
# Any use of this script or its code for purposes outside of
# the systems created by Sawtooth Software is prohibited.
# ---------------------------------------------------------------------------
 use strict; package enterlib8_4_8; sub _cdi { my($__dsf) = @_; my $__dqx = 0; my $__dqy = 0; my $__dqz = 0; my $__dra = ""; my $__drb = ""; my $__drc = ""; my $__drd = 0; my $__dre = ""; my @__drf = (); my @__drg = (); my $__drh = 0; my %__dri = (); my %__drj = (); my $__drk = ""; if (exists $__dsf->{'_bfy'}) { my $__drl = $__dsf->{'_bfy'}; my $__drm = 0; foreach $__drm (@{$__drl}) { $__drb = $__drm->{'_bgt'}; $__drc = ""; if (exists $authlib8_4_8::_bws{uc($__drb)}) { $__drc = authlib8_4_8::_bpy($authlib8_4_8::_bws{uc($__drb)}); $__dra .= $__drc; $__drj{$__drb} = $__drc; } push @__drf, "`" . $__drb . "` = " . $authlib8_4_8::_byw->quote($__drc); push @__drg, [$__drb, $__drc]; if (exists $__drm->{'_bgi'}) { $__dri{$__drb} = $__drc; } } } if (@__drf) { $__dre = " WHERE " . join(" AND ", @__drf); } eval { $__drk = "SELECT * FROM `" . $authlib8_4_8::_bzb . "_passwords`" . $__dre; $__drd = $authlib8_4_8::_byw->selectrow_hashref(authlib8_4_8::_bms(authlib8_4_8::_bmy($__drk, 0))); }; if ($@) { if(!exists $__dsf->{'_bgo'}) { authlib8_4_8::_bqa(226, "Database error.", "Database error reading password table.", $@); } } if ($__drd) { $__dqy = 1; if (keys %__dri) { my $__drn = ""; foreach $__drn (sort keys %__dri) { if (authlib8_4_8::_bmt($__drd->{$__drn}) ne $__dri{$__drn}) { $__dqy = 0; last; } } } $__drh = $__drd->{"max_respondents"}; if ($__dqy) { if (exists $__dsf->{'_bgj'}) { my $__dro = 0; my $__drp = ""; my $__drq = ""; foreach $__dro (@{$__dsf->{'_bgj'}}) { $__drp = $__dro->{'_bgt'}; $authlib8_4_8::_bws{uc($__drp)} = authlib8_4_8::_bmt($__drd->{$__drp}); } } } } if (!$__dqy && exists $__dsf->{'_bgo'}) { my $__drb = ""; my $__drr = 0; my $__drs = $__dsf->{'_bgo'}->{'_bgp'}; my $__drt = 250; my $__dru = 0; foreach $__drb (sort keys %__drj) { $__drr = length($__drj{$__drb}); if (($__drr >= $__drs) && ($__drr <= $__drt)) { $__dru = 1; last; } } if ($__dru) { $__dqy = 1; $__drh = 1; } } if ($__dqy && $__drh > 0) { my $__drv = 0; if (@__drg) { my $__drw = 0; my $__drx = 0; my @__dry = (); my %__drz = (); my $__dsa = ""; $__drz{1} = 1; @__drf = (); $__dre = ""; foreach $__drw (@__drg) { $__drb = $__drw->[0]; $__drc = $__drw->[1]; ($__drx, $__dsa) = authlib8_4_8::_bnv($__drb, 0, 0); push @__drf, "`" . $authlib8_4_8::_bzb . "_data" . $__drx . "`.`" . $__drb . "` = " . $authlib8_4_8::_byw->quote($__drc); if ($__drx != 1) { $__drz{$__drx} = 1; push @__drf, "`" . $authlib8_4_8::_bzb . "_data1`.`sys_RespNum` = `" . $authlib8_4_8::_bzb . "_data" . $__drx . "`.`sys_RespNum`"; } } $__dre = " WHERE " . join(" AND ", @__drf); foreach $__drx (sort {$a <=> $b} keys %__drz) { push @__dry, "`" . $authlib8_4_8::_bzb . "_data" . $__drx . "`"; } eval { $__drk = "SELECT `" . $authlib8_4_8::_bzb . "_data1`.`sys_RespNum`, `" . $authlib8_4_8::_bzb . "_data1`.`sys_RespStatus`"; $__drk .= " FROM " . join(",", @__dry); $__drk .= $__dre; $__drv = $authlib8_4_8::_byw->selectall_arrayref(authlib8_4_8::_bms(authlib8_4_8::_bmy($__drk, 0))); }; if ($@) { authlib8_4_8::_bqa(225, "Database error.", "Database error selecting data rows with certain passwords.", $@); } if ($__drv) { my $__dsb = @{$__drv}; my $__dsc = 0; my $__dsd = 0; my $__dse = 0; foreach $__dsc (@{$__drv}) { $__dse = $__dsc->[0]; if ($__dsc->[1] == &authlib8_4_8::_CCX || $__dsc->[1] == &authlib8_4_8::_CCW) { $__dsd++; } } if ($__dsd < $__drh) { $__dqz = 1; } if ($__drh == 1) { $__dqx = $__dse; } } } } if ($__dra) { $__dra = authlib8_4_8::_boy($__dra, 25); } return ($__dqy, $__dqz, $__dqx, $__dra); } sub _cdj { my($__dsr) = @_; my $__dsg = 0; my $__dsh = 0; my $__dsi = 0; my $__dsj = 1; if(exists $ENV{"HTTP_COOKIE"}) { my $__dsk = $ENV{"HTTP_COOKIE"}; my $__dsl = _cdl($__dsr); if ($__dsk =~ m/$__dsl=(.*?)$/) { my $__dsm = $1; if ($__dsm =~ m/respnum:(\d+)/) { $__dsh = $1; } if ($__dsm =~ m/starttime:(\d+)/) { $__dsi = $1; } } } if ($__dsh && authlib8_4_8::_bng($__dsh)) { $authlib8_4_8::_bzi{"hid_respnum"} = $__dsh; if (exists $authlib8_4_8::_bzo->{'_bfx'}) { my $__dsn = $authlib8_4_8::_bzo->{'_bfx'}; my $__dso = 0; my $__dsp = ""; my $__dsq = ""; foreach $__dso (@{$__dsn->{'_bfy'}}) { $__dsp = $__dso->{'_bgt'}; if(uc(authlib8_4_8::_bnc($__dsp)) ne uc($authlib8_4_8::_bzi{$__dsp})) { $__dsj = 0; last; } } } if (authlib8_4_8::_bnc("sys_StartTime") eq $__dsi && $__dsj) { $__dsg = $__dsh; } else { delete $authlib8_4_8::_bzi{"hid_respnum"}; } } return $__dsg; } sub _cdk { my($__dst, $__dsu, $__dsv) = @_; my $__dss = gmtime($__dsu); if ($__dss =~ m/(\d+)$/) { $__dss = $1; } print "Set-Cookie: " . _cdl($__dsv) . "=respnum:" . $__dst . "|starttime:" . $__dsu . "; expires=Sat, 01-Jan-" . ($__dss + 50) . " 00:00:00 GMT; path=/; HttpOnly\n"; } sub _cdl { my($__dsx) = @_; my $__dsw = authlib8_4_8::_boy($__dsx, 50); return $authlib8_4_8::_byz . "_ssi_info_" . $__dsw; } sub _cdm { my $__dsy = 0; my $__dsz = 0; do { if ($__dsy == 100) { authlib8_4_8::_bqa(183, "", "Cannot find an available random respondent number.", ""); } _cdo($__dsy); $__dsy++; $__dsz = int(rand(1000000000)); } while (!_cdn($__dsz)); return $__dsz; } sub _cdn { my($__dtd) = @_; my $__dta = 1; my $__dtb = 0; my $__dtc = ""; eval { $__dtc = "SELECT `sys_RespNum` FROM `" . $authlib8_4_8::_bzb . "_data1` WHERE `sys_RespNum` = " . $__dtd; $__dtb = $authlib8_4_8::_byw->selectrow_hashref(authlib8_4_8::_bmy($__dtc, 0)); }; if ($@) { authlib8_4_8::_bqa(209, "Database error.", "Database error. Cannot read database to find an available respondent number.", $@); } if ($__dtb) { $__dta = 0; } return $__dta; } sub _cdo { my($__dtf) = @_; my $__dte = time() ^ ($$ + ($$ << 15)); $__dte += $__dtf * 71; srand($__dte); rand(); } sub _cdp { my ($__dtt, $__dtu, $__dtv) = @_; my $__dtg = ""; my @__dth = (); my $__dti = ""; my $__dtj = 0; if (exists $authlib8_4_8::_bzk->{'_bc'}) { my $__dtk = authlib8_4_8::_bqk(); if ($__dtk) { $__dtg .= $__dtk; push @__dth, ["sys_UserAgent", $__dtk]; } my $__dtl = authlib8_4_8::_bqi(); if ($__dtl) { $__dtg .= $__dtl; push @__dth, ["sys_Browser", $__dtl]; } my $__dtm = authlib8_4_8::_bqj(); if ($__dtm) { $__dtg .= $__dtm; push @__dth, ["sys_OperatingSystem", $__dtm]; } } if (exists $authlib8_4_8::_bzk->{'_bd'}) { my $__dtn = authlib8_4_8::_bql(); if ($__dtn) { $__dtg .= $__dtn; push @__dth, ["sys_IPAddress", $__dtn]; } } my $__dto = _cdq($__dtu, $__dtg); my $__dtp = time(); push @__dth, ["sys_UserJavaScript", $__dtv]; push @__dth, ["sys_StartTime", $__dtp]; push @__dth, ["sys_RespStatus", 2]; push @__dth, ["sys_CheckSum", $__dto]; my $__dtq = 0; if ($authlib8_4_8::_byb) { $__dtq = &authlib8_4_8::_CDD; } elsif (exists $authlib8_4_8::_bzi{"hid_test_mode"}) { $__dtq = &authlib8_4_8::_CDC; } elsif (exists $authlib8_4_8::_bzk->{'_bhb'}) { $__dtq = &authlib8_4_8::_CCZ; } elsif ($authlib8_4_8::_bwy eq ".exe") { $__dtq = &authlib8_4_8::_CDB; } else { $__dtq = &authlib8_4_8::_CCY; } push @__dth, ["sys_DataSource", $__dtq]; my $__dtr = $authlib8_4_8::_bze->{"num_data_tables"}; my $__dts = 0; if (exists $ciwlib8_4_8::_bkl{'_cts'} && $__dtt) { for ($__dts = 1; $__dts <= $__dtr; $__dts++) { eval { $__dti = "DELETE FROM `" . $authlib8_4_8::_bzb . "_data" . $__dts . "` WHERE `sys_RespNum` = " . $__dtt; $__dtj = $authlib8_4_8::_byw->prepare(authlib8_4_8::_bmy($__dti, 0)); $__dtj->execute(); }; if ($@) { authlib8_4_8::_bqa(233, "Database error.", "Database error. Cannot delete data row from test database.", $@); } } eval { $__dti = "DELETE FROM `" . $authlib8_4_8::_bzb . "_history` WHERE `sys_RespNum` = " . $__dtt; $__dtj = $authlib8_4_8::_byw->prepare(authlib8_4_8::_bmy($__dti, 0)); $__dtj->execute(); }; if ($@) { authlib8_4_8::_bqa(242, "Database error.", "Database error. Cannot delete history data from test database.", $@); } eval { $__dti = "DELETE FROM `" . $authlib8_4_8::_bzb . "_clists` WHERE `sys_RespNum` = " . $__dtt; $__dtj = $authlib8_4_8::_byw->prepare(authlib8_4_8::_bmy($__dti, 0)); $__dtj->execute(); }; if ($@) { authlib8_4_8::_bqa(281, "Database error.", "Database error. Cannot delete clist data from test database.", $@); } } eval { $__dti = ""; if ($__dtt) { if ($authlib8_4_8::_bwn->{'_bgu'} eq "odbc") { $__dti .= "SET IDENTITY_INSERT `" . $authlib8_4_8::_bzb . "_data1` ON \n"; } $__dti .= "INSERT INTO `" . $authlib8_4_8::_bzb . "_data1` (`sys_RespNum`) VALUES (" . $__dtt . ")"; } else { $__dti .= "INSERT INTO `" . $authlib8_4_8::_bzb . "_data1` (`sys_RespStatus`) VALUES (2)"; } $__dtj = $authlib8_4_8::_byw->prepare(authlib8_4_8::_bmy($__dti, 0)); $__dtj->execute(); if (!$__dtt) { $__dtt = authlib8_4_8::_bnb($authlib8_4_8::_bzb . "_data1", "sys_RespNum"); } }; if ($@) { authlib8_4_8::_bqa(200, "Database error.", "Database error. Cannot create data row.", $@); } if ($__dtr > 1) { for ($__dts = 2; $__dts <= $__dtr; $__dts++) { eval { $__dti = "INSERT INTO `" . $authlib8_4_8::_bzb . "_data" . $__dts . "` (`sys_RespNum`) VALUES (" . $__dtt . ")"; $__dtj = $authlib8_4_8::_byw->prepare(authlib8_4_8::_bmy($__dti, 0)); $__dtj->execute(); }; if ($@) { authlib8_4_8::_bqa(205, "Database error.", "Database error. Cannot insert data row into data table #" . $__dts . ".", $@); } } } $authlib8_4_8::_byw->commit(); authlib8_4_8::_bnu(\@__dth, $__dtt, 0); return ($__dtt, $__dtp); } sub _cdq { my($__dty, $__dtz) = @_; my $__dtw = 0; my $__dtx = time(); $__dty =~ s/([a-z]|[A-Z]|_)//g; $__dtw = $__dty; $__dtw .= $__dtx; $__dtw += length($__dtz); $__dtx =~ s/\d+?(\d)$/$1/; if ($__dtx > 1) { $__dtw *= $__dtx; } if (length($__dtw) > 9) { $__dtw = $__dtw % 999999999; } $authlib8_4_8::_bzi{"hid_checksum"} = $__dtw; return $__dtw; } sub _cdr { my($__dua) = @_; print ciwlib8_4_8::_biq(0, 0, $__dua, 0, "", "", 0); if ($authlib8_4_8::_bze->{"close_survey_msg"}) { print $authlib8_4_8::_bze->{"close_survey_msg"}; } print ciwlib8_4_8::_biv(0, 0); authlib8_4_8::_bso(); } return 1;