#!/usr/planet/bin/perl5 require ("include/bbn.pm") ; use Msql; $| = 1; #Unbuffered output # do standard HTTP stuff &cgi_receive; &cgi_decode; &cgi_header; # Make sure the database is alive $dbh = Connect Msql; if (!$dbh) { &do_msql_error; } SelectDB $dbh $DB; # mash logon and pwd to lower case $FORM{'logon'} = "\L$FORM{'logon'}" ; #$FORM{'password'} = "\L$FORM{'password'}" ; # validate the login form data &check_fields; &check_logon; # generate a new session id open(MAKESID, "$SCRIPT_PATH$GEN_SID|" ) || die "Couldn't create session ID\n"; $sid = ; close MAKESID; chop($sid); if ($sid == 0) { &do_no_sid; } &setup_session; # spit out initial CatoSource screen open(MAIN, "$SESSION_PATH$sid/$FIRST_DOC") || die "Can't seem to open the initial document."; print
; ###################################################################### # SUBROUTINES ###################################################################### sub setup_session { $thyme = time(); $query = "insert into $TBL_SESSION $SESSION_FIELDS values ( '$sid', '$FORM{'logon'}', '$ENV{'REMOTE_ADDR'}', '$ENV{'REMOTE_HOST'}', '$ENV{'REMOTE_USER'}', $thyme, $thyme)"; $sth = Query $dbh $query; umask(00); mkdir($SESSION_PATH . $sid , 0777) || die "Can't make sessions directory"; # do string replacements on template files opendir(TMPL, $TEMPLATE_PATH); while ($file = readdir(TMPL)) { $source = $TEMPLATE_PATH . $file; if (-d $source) { next; } #Skip any subdir including "." and ".." open(FROM, "<$source"); open(TO, ">$SESSION_PATH$sid/$file"); while () { s/$REPLACE_STRING_SID/$sid/og; print TO; } close FROM; close TO; } closedir(TMPL); if ($FORM{'tables'} eq "yes") { open (TBLF, ">$SESSION_PATH$sid/hastables"); close(TBLF); `mv $SESSION_PATH$sid/productssearch.tab.html $SESSION_PATH$sid/productssearch.html` ; `mv $SESSION_PATH$sid/servicessearch.tab.html $SESSION_PATH$sid/servicessearch.html` ; `rm $SESSION_PATH$sid/productssearch.notab.html`; `rm $SESSION_PATH$sid/servicessearch.notab.html`; } else { `mv $SESSION_PATH$sid/productssearch.notab.html $SESSION_PATH$sid/productssearch.html` ; `mv $SESSION_PATH$sid/servicessearch.notab.html $SESSION_PATH$sid/servicessearch.html` ; `rm $SESSION_PATH$sid/productssearch.tab.html`; `rm $SESSION_PATH$sid/servicessearch.tab.html`; } } sub do_no_sid { print "Couldn't get an ID for the session.
\n"; &cgi_footer; exit; } sub check_fields { # Check all the required fields for a form and fail if any are blank # ouputs an apropos error message first. &error_blank_field('your user name') unless ($FORM{'logon'}); #&error_blank_field('your password') unless ($FORM{'password'}); } sub error_blank_field { # Display an error message to indicate a field has been left blank. my($variable) = @_; print "

Incomplete Logon Information

\n"; print "You did not fill in $variable.\n"; print "Please provide all the requested information.\n"; print "Use your browser's Back to return to the form ... "; print "

\n"; print qq|or return to the Welcome page. \n|; &cgi_footer; exit; } sub check_logon { #See if the entry is in the database $query = "select pwd from $TBL_REG where logon = '$FORM{'logon'}'"; $sth = Query $dbh $query; @row = FetchRow $sth; if (!$row[0]) { &do_bad_logon; } #if ("$row[0]" ne "$FORM{'password'}") { &do_bad_password; } } sub do_bad_logon { print "

Unable to find that name

\n"; print "The user name $FORM{'logon'} was not found.\n"; # dih 4jan96 print "Please use your browser's Back "; print "and try again.\n"; print "

\n"; print qq|Or perhaps you have not yet registered|; print " with CatoSource.\n"; &cgi_footer; exit; } sub do_bad_password { #### this is inactive for now 1/26/96 pds print "

Invalid Password

\n"; print "Please use your browser's Back and try again.\n"; print "

\n"; print qq|Or perhaps you have not registered|; print " with CatoSource.\n"; &cgi_footer; exit; } sub do_msql_error { print "

Unable to connect to database

\n"; print "The database is currently down for maintainence.\n"; print "Please try connecting again in a few minutes.\n"; print "

\n"; &cgi_footer; exit; }