#!/usr/bin/perl
require 5.003; #require perl version 5.003 or later -- may not
#be necessary -- but untested on earlier versions
#----------------------------------------------------------------------------
#
# ---------------------------------------------------------------------------
# CIWWEB.PL
#
# Ver: 6_4_2
# ---------------------------------------------------------------------------
# SSI Web - Web Surveying System
# Copyright Sawtooth Software, Inc. 1998-2008. All rights reserved
# Sequim, WA USA (360) 681-2300
# 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;ciwweb6_4_2::_bn();package ciwweb6_4_2;sub _bn{my $_a = 0;my $_b = 0;my $_c = "";my $_d = "";my $_e = "";my $_f = 0;my $_g = 0;my $_h = 0;my $_i = 0;my $_j = "";my $_k = "";my $_l = "";my $_m = 1;my $_n = "";my $_o = 1;if ((exists($ENV{'SCRIPT_FILENAME'}) || (defined ($ENV{'SCRIPT_FILENAME'})))){$_l = $ENV{'SCRIPT_FILENAME'};}if ($_l eq "") {$_l = $ENV{'PATH_TRANSLATED'};$_l =~ s/\\/\//g;}$_l =~ s/\/ciwweb.(pl|exe)//;unshift @INC, $_l;_bq("authlib6_4_2.pl", $_l); authlib6_4_2::_atl(0);$authlib6_4_2::_br = $_l; _bq("ciwlib6_4_2.pl", $_l);ciwlib6_4_2::_sq();authlib6_4_2::_axo();authlib6_4_2::_atz();if (keys(%authlib6_4_2::in) == 1) {if (exists $authlib6_4_2::in{"s"}) {my $_p = $authlib6_4_2::in{"s"};if ($_p ne "") {if ($_p !~ m/^\d{0,500}$/) {authlib6_4_2::_avu(0, "Malformed input");}else{$authlib6_4_2::in{"hid_javascript"} = substr($_p, 0, 1);$authlib6_4_2::in{"hid_studyname"} = authlib6_4_2::_axj(substr($_p, 1, 8));$authlib6_4_2::in{"hid_respnum"} = authlib6_4_2::_axj(substr($_p, 9, 8));$authlib6_4_2::in{"hid_checksum"} = authlib6_4_2::_axj(substr($_p, 17, 16));my $_q = substr($_p, 33, 1); if ($_q) {$authlib6_4_2::in{"hid_test_mode"} = 1;}$_n = authlib6_4_2::_axj(substr($_p, 34));$_o = 0;$_m = 0;$_f = -1;$_e = $authlib6_4_2::in{"hid_respnum"};}}}}$_k = _bp();if ((exists $authlib6_4_2::in{"hid_bypass"}) && (defined $authlib6_4_2::in{"hid_bypass"})){authlib6_4_2::_avv("The \"hid_bypass\" method of logging into a survey has been removed. Please see the documentation for details on the current method.", "", 0);}if ((exists $authlib6_4_2::in{"hid_pagenum"}) && (defined $authlib6_4_2::in{"hid_pagenum"})){$_f = $authlib6_4_2::in{"hid_pagenum"};}if ($_f == 1 || $_f == 0) {my $_r = "";foreach $_r (keys %authlib6_4_2::in) {$authlib6_4_2::_bs{uc($_r)} = $authlib6_4_2::in{$_r};}}if ((exists $authlib6_4_2::in{"hid_studyname"}) && (defined $authlib6_4_2::in{"hid_studyname"})){$_j = $authlib6_4_2::in{"hid_studyname"};}elsif (exists $authlib6_4_2::_bs{"STUDYNAME"}) {$authlib6_4_2::in{"hid_studyname"} = $authlib6_4_2::_bs{"STUDYNAME"};$_j = $authlib6_4_2::in{"hid_studyname"};}else{if ($_j eq "") {$_j = authlib6_4_2::_axk("hid_studyname");if ($_j eq "") {authlib6_4_2::_avu(20, "Cannot find the study name.");}}}if (!exists $authlib6_4_2::in{"hid_pagenum"}) { if ($_f == 0) {$_f = authlib6_4_2::_axk("hid_pagenum");if ($_f eq "") {ciwlib6_4_2::_sr();}}}$authlib6_4_2::_bt = $_j;authlib6_4_2::_avq($_l);if ($_k ne "") {authlib6_4_2::_awz(0, $_k);}if (exists $authlib6_4_2::in{"hid_test_mode_settings"}) {if ($authlib6_4_2::in{"hid_test_mode_settings"} eq "") {ciwlib6_4_2::_us();}if ($authlib6_4_2::in{"hid_test_mode_settings"} ne "") {ciwlib6_4_2::_uu();}}if (exists $authlib6_4_2::in{"hid_loadtest_mode"}) {$authlib6_4_2::_bv = 1;}authlib6_4_2::_aua(0);if (exists $authlib6_4_2::_bw->{'_cf'}) {if ((exists $authlib6_4_2::in{"hid_javascript"}) && (defined $authlib6_4_2::in{"hid_javascript"})){$_h = $authlib6_4_2::in{"hid_javascript"};}else{$_h = authlib6_4_2::_axk("hid_javascript");if ($_h eq "") {$_h = 0;}}}else{$_h = 0;}$authlib6_4_2::in{"hid_javascript"} = $_h;if ($_f > 1) {$_e = ciwlib6_4_2::_sv();}elsif ($_f == 1){my $_s = "";authlib6_4_2::_att("enterlib6_4_2.pl");if (-e $authlib6_4_2::_bu[0] . $authlib6_4_2::_bt . "_close_survey_on.cgi") {if (!exists $authlib6_4_2::in{"hid_test_mode"}) {enterlib6_4_2::_bec($authlib6_4_2::_bu[0] . $authlib6_4_2::_bt . "_close_survey_on.cgi", $_h);}}authlib6_4_2::_aub(1);if ($authlib6_4_2::_bx) {if (exists $authlib6_4_2::_bx->{'_cg'}) {my $_t = 0;($_b, $_e, $_a, $_t, $_n, $_s) = enterlib6_4_2::_bdp();if ($_b <= 0) {ciwlib6_4_2::_ta('invalid_pass');}elsif ($_t) {if ($_e) {authlib6_4_2::_ayh($_e, 0);$authlib6_4_2::in{"hid_respnum"} = $_e; }ciwlib6_4_2::_ta('password_closed');}}if (($_e eq "") && (exists $authlib6_4_2::_bx->{'_ch'}) && $_a != 1) {if (!exists $authlib6_4_2::in{"hid_test_mode"}) {($_e, $_n) = enterlib6_4_2::_bdt($_l);}}}if (exists $authlib6_4_2::in{"hid_test_mode"}) {if (!exists $authlib6_4_2::in{"hid_test_mode_settings"}) {ciwlib6_4_2::_ut();authlib6_4_2::_axp();}}if (exists($authlib6_4_2::_bw->{'_ci'}) && !exists($authlib6_4_2::in{"hid_skip_transition"}) && $_h) {ciwlib6_4_2::_uy($authlib6_4_2::_bw->{'_ci'});authlib6_4_2::_axp(); }my $_u = 1;if ($_e ne "") {$_g = 1;$_u = 0;}elsif (exists $authlib6_4_2::in{"hid_respnum"}) {$_e = ciwlib6_4_2::_sv();$_u = 0;}else{$_u = 1;}if ($_g) {$_n = ciwlib6_4_2::_ue($_e, $_n);}elsif($_u){my $_v = 0;if ($authlib6_4_2::_by){}else{my $_w = authlib6_4_2::_avi("newrec_lck.cgi", 1); if (exists $authlib6_4_2::_bw->{'_cj'}) {$_e = enterlib6_4_2::_bdx(0);}else{$_e = enterlib6_4_2::_bdw();}if (exists $ciwlib6_4_2::_bz{'_ck'}) {$_e = $ciwlib6_4_2::_bz{'_ck'};}($_e, $_v) = enterlib6_4_2::_bdz($_s, $_e, $_h, $_a);authlib6_4_2::_avj($_w);}if ($authlib6_4_2::_bx) {if (exists $authlib6_4_2::_bx->{'_ch'} && $_a != 1) {if (!exists $authlib6_4_2::in{"hid_test_mode"}) {enterlib6_4_2::_bdu($_e, $_v, $_l); }}}}$authlib6_4_2::in{"hid_respnum"} = $_e;}elsif ($_f == 0) {ciwlib6_4_2::_tc(1, "", "a",0, $authlib6_4_2::_bt, 0);authlib6_4_2::_axp();}if (!$authlib6_4_2::_by){my $_x = $authlib6_4_2::_bu[2] . $authlib6_4_2::_bt . $_e . '.cgi';if (!(-e $_x)) {authlib6_4_2::_ayh($_e, 0);ciwlib6_4_2::_ta('finished');}}if ($_f == 1) {my $_y = "";$_y = authlib6_4_2::_ayh($_e, 0);if ($_g) {$authlib6_4_2::in{"hid_checksum"} = $_y;}}if ($_h == 0 && $authlib6_4_2::_bv == 0) {authlib6_4_2::_ayh($_e, 0);if (exists $authlib6_4_2::_ca{"sys_UserJavaScript"}) {if ($authlib6_4_2::_ca{"sys_UserJavaScript"} == 1) {$_h = 1;$authlib6_4_2::in{"hid_javascript"} = $_h;}}authlib6_4_2::_att("pverlib6_4_2.pl");if ($_f > 0) {pverlib6_4_2::_bkv($_f,$_e);}}my $_z = [];my $_aa = [];if ($ciwlib6_4_2::_cb){ if ($_g) {$_n = ""; }if ($authlib6_4_2::in{"hid_destination"}) {$_n = $authlib6_4_2::in{"hid_destination"};}}else{if ($_g) {if ($authlib6_4_2::_cc) {my $_ab = 0;my $_ac = "";($_ab, $_ac) = authlib6_4_2::_aut();if ($_ab) {$_n = $_ac;delete $authlib6_4_2::in{"hid_page_rand"};}}$_i = _bo(\%authlib6_4_2::_ca, \%authlib6_4_2::in);if ($_i){ $_n = "";delete $authlib6_4_2::in{"hid_page_rand"};$_g = 0;}else{$_m = 0;}}if ($_m) {($_z, $_aa) = ciwlib6_4_2::_sw($_f);}}authlib6_4_2::_ayh($_e, 1);if ($ciwlib6_4_2::_cb eq "" && $_o){($_n, $_f) = ciwlib6_4_2::_ss($_z, $_aa, $_e, $_n, $_f, $_g);}if(exists($ciwlib6_4_2::_bz{'_cl'})){if ($ciwlib6_4_2::_cb eq "") {$_n = $ciwlib6_4_2::_bz{'_cl'};$authlib6_4_2::in{"hid_test_mode_settings"} =~ s/(.*?),/,/;}}while ($_f > 0 || $_n ne "") {if(exists $authlib6_4_2::in{"hid_page_rand"} && $ciwlib6_4_2::_cb eq ""){if ($authlib6_4_2::in{"hid_page_rand"} =~ m/^(\d+),(.*?)$/) {$_f = $1;$authlib6_4_2::in{"hid_page_rand"} = $2;}elsif ($authlib6_4_2::in{"hid_page_rand"} =~ m/^(\d+)$/) {$_f = $1;delete $authlib6_4_2::in{"hid_page_rand"};}}($_f, $_n) = ciwlib6_4_2::_tc($_f, $_n, $_e, $_h, $authlib6_4_2::_bt);}authlib6_4_2::_axp();}sub _bo{my ($_ad, $_ae) = @_;my $_af = 0;my $_ag = "";my $_ah = "";my $_ai = "";my $_aj = "";my %_ak = ();my $_al = $authlib6_4_2::_cd->[0];my $_am = $_al->{'_cm'}; my $_an = @{$_am}; my $_ao = 0;my $_ap = 0;for($_ao = 0; $_ao < $_an; $_ao++){$_ap = $_am->[$_ao];if ($_ap->{'_cn'} != 21) {$_ak{$_ap->{'_co'}} = 1;}}if ($authlib6_4_2::_bx) {if (exists $authlib6_4_2::_bx->{'_cp'}) {my $_aq = $authlib6_4_2::_bx->{'_cp'};my $_ar = 0;my $_as = "";foreach $_ar (@{$_aq}) {$_as = $_ar->{'_co'};$_ak{$_as} = 1;}}if (exists $authlib6_4_2::_bx->{'_cg'}) {my $_at = $authlib6_4_2::_bx->{'_cg'};if (exists $_at->{'_cq'}) {my @_au = @{$_at->{'_cq'}};my $_av = 0;my $_aw = "";foreach $_av (@_au) {$_aw = $_av->{'_co'};$_ak{$_aw} = 1;}}}}foreach $_ag (keys %{$_ae}) {if ($_ag =~ m/^(.*?)_(.*?)$/) {$_ah = $1;}else{$_ah = $_ag;}if (exists $_ak{$_ah}) {$_ai = "";$_aj = "";if (exists($_ad->{$_ag})) {$_aj = $_ad->{$_ag};}if (exists($_ae->{$_ag})) {$_ai = $_ae->{$_ag};}if (authlib6_4_2::_avs(uc($_ai)) ne authlib6_4_2::_avs(uc($_aj))) { $_af = 1;last;}}}return $_af;}sub _bp{my $_ax = "";my $_ay = "";my $_az = 0;my $_ba = "";my $_bb = 10000;foreach $_ax (keys(%authlib6_4_2::in)) {$_ay = $authlib6_4_2::in{$_ax};$_ay =~ s/\n/ /g;$_ay =~ s/\r/ /g;$_ay =~ s/<(\s*)script/<$1 s c r i p t/ig;$_ay =~ s/\[%/\[ %/ig;if (length($_ay) > $_bb){my $_bc = 1;if (exists $authlib6_4_2::in{"hid_SavedListNames"}) {my @_bd = split(",", $authlib6_4_2::in{"hid_SavedListNames"});my $_be = @_bd;my $_bf = "";my $_ao = 0;for ($_ao = 0; $_ao < $_be; $_ao++) {if ($_ax eq $_bd[$_ao]) {$_bc = 0;last;}}}if ($_bc) {$_ay = substr($_ay,0,$_bb);$_ba .= "Input greater than " . $_bb . " characters removed.";}}$authlib6_4_2::in{$_ax} = $_ay;if (ref($_ay) eq "ARRAY") {$_az = $_ay;$_ay = $_az->[0];$authlib6_4_2::in{$_ax} = $_ay;my $_bg = @{$_az};my $_ao = 0;my $_bh = $_az->[0];my $_bi = 0;for ($_ao = 1; $_ao < $_bg; $_ao++) {if ($_bh ne $_az->[$_ao]) {$_bi = 1;last;}}if ($_bi) {$_ba .= "Found Null character in the %in hash. Key: " . $_ax . " Value: " . join(" | ", @{$_az});}}elsif ($_ay =~ m/\0/) {my @_bj = split("\0", $_ay);my $_bk = $_ay;$_ay = $_bj[0];$authlib6_4_2::in{$_ax} = $_ay;$_ba .= "Found Null character in the %in hash (null in string). Key: " . $_ax . " Value: " . $_bk;}if ($_ax eq "hid_respnum") {if ($_ay !~ m/^\w{0,100},?\w{0,100}$/) {authlib6_4_2::_avu(0, "Malformed input");}}elsif ($_ax eq "hid_studyname") {if ($_ay !~ m/^\w{0,50}$/) {authlib6_4_2::_avu(0, "Malformed input");}}elsif ($_ax eq "hid_pagenum") {if ($_ay !~ m/^\d{0,10}$/) {authlib6_4_2::_avu(0, "Malformed input");}}elsif ($_ax eq "hid_javascript") {if ($_ay !~ m/^\d{0,1}$/) {authlib6_4_2::_avu(0, "Malformed input");}}elsif ($_ax eq "hid_backup") {if ($_ay !~ m/^[\w,]{0,100}$/) {authlib6_4_2::_avu(0, "Malformed input");}}}return $_ba;}sub _bq{my ($_bl, $_l) = @_;my $_bm = "";if (!(-e $_l . "/" . $_bl)) {$_bm = "Cannot find library in " . $_l;}eval{require $_bl;};if ($@) {$_bm = $@;} if ($_bm ne "") {print "Content-type: text/html\r\n\r\n";print "
Error: ";print "Cannot load library: " . $_bl . "
" . $_bm;print "";exit();}}END{if ($authlib6_4_2::_by) {authlib6_4_2::_ayw();}close $authlib6_4_2::_ce;}return 1;