Thank-you!
Input is
Snippet of the logfile:
10.30.147.23 2009-06-15 09:04:47 1245053087 Help for Hospi
+ces no-email no-comment
192.9.200.49 2009-06-15 09:04:50 1245053090 Alzheimer's So
+ciety/Alzheimer Scotland no-email no-comment
10.30.117.36 2009-06-15 09:04:50 1245053090 Help for Hospi
+ces no-email no-comment
10.30.135.9 2009-06-15 09:04:50 1245053090 NSPCC Childline
+ no-email no-comment
10.30.198.18 2009-06-15 09:04:59 1245053099 Help for Hospi
+ces no-email no-comment
Current evironment vars? Give me a clue please...... :blush:
Tell you what - this is the entire script - this subrouteine is wrapped in a time-lock cookie just to complicate matters!
#!/usr/bin/perl
# Additional security patch added 12-30-2000 in decode
# subroutine.
#
# Added option to block multiple vote attempts using IP
# address. Additional security mods. (02-10-2002)
# Modified IP based multi-vote blocking to allow time based
# blocking as well. (02-16-2002)
# IMPORTANT: This changed the format of the log file. There
# is now a integer number representing the vote time located
# between the human readable date and the first vote response
# field.
#
#------------SCRIPT CONFIGURATION SECTION--------------------
# The script can be called in this manner to provide view without
# voting:
# http://domain.com/cgi-bin/survey/survey.cgi?survey_name=number1
# $DATA_PATH is the FULL system path to the directory where
# your survey data files are stored. Your web server must have
# permission to write to and create files in this directory
$DATA_PATH= "e:/inetpub/wwwybs/ybsone/cgi-bin/survey/";
# The $DOMAIN must be your site's domain name.
$DOMAIN="wwwybs.ybs.com/ybsone";
# $GRAPHICSDIR is the directory under your main html directory
# containing the colored gif files.
$GRAPHICSDIR="survey";
# To prevent people from voting too often, set $USE_COOKIES=1
# HOURS is the NUMBER OF HOURS before the voter can vote
# again. 1 Day=24, 1 Week=168, 1 Month=720 give or take....
# To disable cookies, let $USE_COOKIES=0
#
# WARNING: DO NOT ENABLE COOKIES UNTIL YOU ARE SURE EVERYTHING
# IS WORKING PERFECTLY, OR YOUR DEBUGGING CAN BE SERIOUSLY
# SLOWED DOWN WHILE YOU WAIT FOR THE COOKIE TO EXPIRE. ;-)
$USE_COOKIES=1;
$HOURS=0; # one hour delay between votes
# Set $USE_LOGGING to 1 to turn on log file capture.
# Log format is an ASCII tab delimited file consisting of:
# Visitor's IP address, date, time, responses, e-mail, comments
# Can be easily imported into spreadsheets and databases
$USE_LOGGING=1;
# If you USE_LOGGING, you can also block multiple votes from
# the same IP address. Just set $BLOCK_IP=1
# If $HOURS (from above) is set to zero, a voter from an IP
# address can only vote once. You can set a minimum time
# between votes by setting $HOURS=1 (as an example) to allow
# a voter from an IP address to vote every hour.
$BLOCK_IP=1;
# IF $SHOW_RESULTS=0 (do not display after voting), be sure
# to set $JUMP_URL to the page the voter should be sent to.
# By default, it sends the voter back to the page they came from.
# When used with SHOW_RESULTS=1, this is the link they can click
# on after viewing the voting.
$SHOW_RESULTS=1;
$JUMP_URL="http://wwwybs.ybs.com/ybsone/index.htm";
# These are the cosmetic settings in case you do not like my
# terrible taste in colors! The actual result page layout can
# be found near the bottom of the script.
$TABLECOLOR="#FFFFFF";
$HEADINGCOLOR="#FFFFFF";
$HEADINGFONT="arial,helvetica";
$BORDERCOLOR="#000080";
$FONT="arial,helvetica";
$FONTCOLOR="#000000";
# the script starts for real here....
&decode_vars;
&check_files;
if ($ENV{'REQUEST_METHOD'} eq "POST" && -e $DATA_FILE && -w $DATA_FI
+LE){
if ($BLOCK_IP == 1 && $USE_LOGGING == 1 && &is_blocked == 1 ){
&already_voted;
exit;
}
if ($USE_COOKIES == 1){
$COOKIEVAL=&get_cookie($SURVEY_NAME);
if ( $COOKIEVAL > time){
&already_voted;
exit;
}
else{
$cookie=&set_cookie($SURVEY_NAME,(time + ($HOURS * 3600)),$HOURS
+);
print "$cookie\n";
}
}
$MODE="VOTE";
&set_colors;
&process_file;
&do_stats;
if ($SHOW_RESULTS == 1){
print "Content-type: text/html\n\n";
$PAGEHEADER=&set_page_header;
$PAGEFOOTER=&set_page_footer;
print "$PAGEHEADER\n";
&display_stats;
print "$PAGEFOOTER\n";
}
else{
print "Location: $JUMP_URL\n\n";
}
exit;
}
if ($ENV{'REQUEST_METHOD'} eq "GET" && -e $DATA_FILE){
$MODE="VIEW";
&set_colors;
&process_file;
&do_stats;
$PAGEHEADER=&set_page_header;
$PAGEFOOTER=&set_page_footer;
print "Content-type: text/html\n\n";
print "$PAGEHEADER\n";
&display_stats;
print "$PAGEFOOTER\n";
exit;
}
sub do_stats{
$oldtag="NONE";
@groups=();
foreach $toshow (@list){
@tags=split(/\|/,$toshow);
if ($tags[0] ne $oldtag){
$group=$tags[0];
push(@groups,$group);
$total{$group}=0;
$oldtag = $tags[0];
}
$total{$group} = $total{$group} + $questions{$toshow};
}
}
sub display_stats{
$oldgroup="NONE";
$itemcount=0;
foreach $toshow (@list){
@tags=split(/\|/,$toshow);
if ($tags[0] ne $oldgroup){
if ($oldgroup ne "NONE"){
$GROUPFOOTER=&set_footer($total{$group});
print "$GROUPFOOTER\n";
}
$group=$tags[0];
$GROUPHEAD=&set_group_header($title{$group});
print "$GROUPHEAD\n";
$oldgroup=$group;
$itemcount=0;
}
if ($total{$group} > 0){
$pct=int((($questions{$toshow} / $total{$group} * 100)+.5)) ;
}
else{
$pct=0;
}
@qi=split(/\|/,$toshow);
$giffile=@colors[$itemcount];
$RESPONSELINE=&set_question($qi[1],$questions{$toshow},$pct, $giffi
+le);
print "$RESPONSELINE\n";
$itemcount = $itemcount + 1;
}
$GROUPFOOTER=&set_footer($total{$group});
print "$GROUPFOOTER\n";
}
sub process_file {
&get_the_lock;
if ($USE_LOGGING == 1 && $MODE eq "VOTE"){
$SYSTIME=&sys_date;
$SYSINT=time;
$LOG_LINE="$ENV{'REMOTE_ADDR'}\t$SYSTIME\t$SYSINT\t";
open(LO,">>$LOG_FILE");
}
open(IX,"<$DATA_FILE");
while ($line=<IX>){
@loga=();
chop $line;
@parts=split(/:/,$line);
$q=$parts[0];
$n=$parts[1];
$t=$parts[2];
@tags=split(/\|/,$line);
$ti=$tags[0];
$title{$ti} = $t;
$titles{$q} = $t;
if ($fields{$ti} eq $q){
$questions{$q} = $n + 1;
@loga=split(/\|/,$q);
if ($USE_LOGGING == 1 && $MODE eq "VOTE"){$LOG_LINE .= "$loga[1]\
+t";}
}
else{ $questions{$q} = $n; }
push(@list,$q);
}
close(IX);
if ($MODE eq "VOTE"){
open(IY,">$DATA_FILE");
foreach $toshow (@list){
print IY "$toshow:$questions{$toshow}:$titles{$toshow}:\n";
}
close(IY);
}
if ($USE_LOGGING == 1 && $MODE eq "VOTE"){
if ($fields{'email'} eq ""){$fields{'email'}="no-email";}
if ($fields{'comments'} eq ""){$fields{'comments'}="no-comment";}
$LOG_LINE .= "$fields{'email'}\t$fields{'comments'}";
print LO "$LOG_LINE\n";
close(LO);
}
&drop_the_lock;
}
sub set_colors{
#this allows for up to 22 responses per question. if you have more, ju
+st
#continue duplicating the middle two lines of the array below...
@colors=("blue.gif","red.gif","green.gif","yellow.gif","cherry.gif",
"navy.gif","pink.gif","black.gif","teal.gif","purple.gif","
+sky.gif",
"blue.gif","red.gif","green.gif","yellow.gif","cherry.gif",
"navy.gif","pink.gif","black.gif","teal.gif","purple.gif","
+sky.gif");
}
sub decode_vars
{
$i=0;
if ( $ENV{'REQUEST_METHOD'} eq "GET")
{
$temp=$ENV{'QUERY_STRING'};
}
else
{
read(STDIN,$temp,$ENV{'CONTENT_LENGTH'});
}
@pairs=split(/&/,$temp);
foreach $item(@pairs)
{
($key,$content)=split(/=/,$item,2);
$content=~tr/+/ /;
$content=~s/%(..)/pack("c",hex($1))/ge;
$content=~s/\0//g;
$key=~s/\0//g;
$content=~s/\012//gs;
$content=~s/\015/ /gs;
$fields{$key}=$content;
}
if ($fields{'survey_name'}=~/^([-\@\w.]+)$/){
$SURVEY_NAME=$fields{'survey_name'};
}
else {exit;}
$fields{'comments'}=~s/\t/ /g;
$fields{'email'}=&valid_address($fields{'email'});
}
sub valid_address
{
my ($testmail) = @_;
if ($testmail =~/ /)
{ return ""; }
if ($testmail =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)/ ||
$testmail !~ /^.+\@(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,4}|[0-9]{1,3})
+(\]?)$/)
{ return ""; }
else { return $testmail; }
}
sub get_the_lock
{
if ($MODE ne "VOTE"){return;}
my $lockfile="$DATA_PATH/$SURVEY_NAME\.lkk";
local ($endtime);
$endtime = 40;
$endtime = time + $endtime;
while (-e $lockfile && time < $endtime)
{
# Do Nothing
}
open(LOCK_FILE, ">$lockfile");
}
sub drop_the_lock
{
if ($MODE ne "VOTE"){return;}
$lockfile="$DATA_PATH/$SURVEY_NAME\.lkk";
close(LOCK_FILE);
unlink($lockfile);
}
sub already_voted{
print "Content-type: text/html\n\n";
print<<__END_ALREADY_VOTED__;
<h2 align=center><FONT FACE="$FONT" COLOR="$FONTCOLOR" size="3">You'v
+e Already Voted for your 2009 Xmas Charity Choice</h2>
<BR><A HREF="$JUMP_URL"><B>Back to Intranet Home Page</B>
__END_ALREADY_VOTED__
}
#
# This routine takes (name,value,hours,path,domain) as arguments
# to set a cookie.
#
# 0 hours means a current browser session cookie life
#
sub set_cookie() {
my ($name,$value,$expires) = @_;
$name=&cookie_scrub($name);
$value=&cookie_scrub($value);
$expires=$expires * 3600;
$expires=int($expires);
my $expire_at=&cookie_date($expires);
my $namevalue="$name=$value";
my $COOKIE="";
if ($expires != 0) {
$COOKIE= "Set-Cookie: $namevalue; path=$path; expires=$expire_at;
+ ";
}
else {
$COOKIE= "Set-Cookie: $namevalue; "; #current session cookie if
+ 0
}
return $COOKIE;
}
#
# This routine removes cookie of (name) by setting the expiration
# to a date/time GMT of (now - 24hours)
#
sub remove_cookie() {
my ($name) = @_;
$name=&cookie_scrub($name);
my $value="";
my $cookie="";
my $expires=&cookie_date(-86400);
my $namevalue="$name=$value";
my $COOKIE= "Set-Cookie: $namevalue; expires=$expires; ";
return $COOKIE;
}
#
# given a cookie name, this routine returns the value component
# of the name=value pair
# a returned value of 0 means no cookie
#
sub get_cookie() {
my ($name) = @_;
$name=&cookie_scrub($name);
my $temp=$ENV{'HTTP_COOKIE'};
@pairs=split(/\; /,$temp);
foreach my $sets (@pairs) {
my ($key,$value)=split(/=/,$sets);
$clist{$key} = $value;
}
if ($clist{$name} eq "") {$clist{$name}="0";}
my $retval=$clist{$name};
return $retval;
}
#
# this routine accepts the number of seconds to add to the server
# time to calculate the expiration string for the cookie. Cookie
# time is ALWAYS GMT!
#
sub cookie_date() {
my ($seconds) = @_;
my %mn = ('Jan','01', 'Feb','02', 'Mar','03', 'Apr','04',
'May','05', 'Jun','06', 'Jul','07', 'Aug','08',
'Sep','09', 'Oct','10', 'Nov','11', 'Dec','12' );
my $sydate=gmtime(time+$seconds);
my ($day, $month, $num, $time, $year) = split(/\s+/,$sydate);
my $zl=length($num);
if ($zl == 1) {
$num = "0$num";
}
my $retdate="$day $num-$month-$year $time GMT";
return $retdate;
}
#
# don't allow = or ; as valid elements of name or data
#
sub cookie_scrub() {
my($retval) = @_;
$retval=~s/\;//g;
$retval=~s/\=//g;
return $retval;
}
#
# check to see if the IP of this client has been logged.
# if so, return 1 to indicate client should be blocked.
# only called if $USE_LOGGING and $BLOCK_IP are set to 1.
# added 02/10/2002
#
# Modified on 02/16/2002 so that if $HOURS are not equal
# to 0, you can control the time between votes based on
# IP address the same way as with cookies.
#
sub is_blocked{
my $current_time=time;
my @solog=();
open(OLOGS,"<$LOG_FILE");
my @logs=<OLOGS>;
close(OLOGS);
my $lcounter=@logs;
for ($lcounter; $lcounter >= 0; $lcounter--){
if (-1 > index $logs[$lcounter], $ENV{'REMOTE_ADDR'} ){
# if ( $logs[$lcounter]=~/^$ENV{'REMOTE_ADDR'}/){
if ($HOURS == 0){
return 1;
}
@solog=split(/\t/,@logs[$lcounter]);
if ( ($solog[3] + ($HOURS * 3600)) > $current_time ){
return 1;
}
}
}
return 0;
}
sub sys_date{
my %mn = ('Jan','01', 'Feb','02', 'Mar','03', 'Apr','04',
'May','05', 'Jun','06', 'Jul','07', 'Aug','08',
'Sep','09', 'Oct','10', 'Nov','11', 'Dec','12' );
my $sydate=localtime(time);
my ($day, $month, $num, $time, $year) = split(/\s+/,$sydate);
my $zl=length($num);
if ($zl == 1) { $num = "0$num";}
my $retval="$year\-$mn{$month}\-$num\t$time";
return $retval;
}
sub check_files{
$DATA_FILE="$DATA_PATH/$SURVEY_NAME\.srv";
$LOG_FILE="$DATA_PATH/$SURVEY_NAME\.log";
if ( !-e $DATA_FILE){
print "Content-type: text/html\n\n Data File is Missing!\n";
exit;
}
if ( !-w $DATA_FILE){
print "Content-type: text/html\n\n Data File Cannot be Written to!\
+n";
exit;
}
if ( !-e "$LOG_FILE" && $USE_LOGGING == 1){
open(OP,">>$LOG_FILE");
close(OP);
}
if ( !-w "$DATA_PATH/$SURVEY_NAME\.log" && $USE_LOGGING == 1){
print "Content-type: text/html\n\n Log File Cannot be Written to!\n
+";
exit;
}
}
######################## COSMETIC SECTION ##########################
#
# The following subroutines contain the HTML text (and some logic
# so be careful editing!) that is presented when viewing the survey
# results.
#
sub set_page_header{
my $PAGEHEAD=<<__END_PAGE_HEAD__;
<BODY BGCOLOR="#FFFFFF">
<CENTER>
<TABLE BORDER=0 BGCOLOR="$BORDERCOLOR" WIDTH="100%">
<TR>
<TD ALIGN=CENTER>
<TABLE BORDER=0 BGCOLOR="$TABLECOLOR" WIDTH="100%">
<TR>
<TD COLSPAN=4>
<CENTER>
<FONT FACE="$HEADINGFONT" COLOR="#000080">
<FONT SIZE=5>2009 Xmas Charity Poll</FONT>
</FONT>
<CENTER>
</TR>
__END_PAGE_HEAD__
return $PAGEHEAD;
}
#below can be added back in to line 509 if ever desired
# <CENTER>
# <FONT FACE="$HEADINGFONT" COLOR="$HEADINGCOLOR">
# <FONT SIZE=5>BigNoseBird Survey Script</FONT>
# <BR>
# <FONT FACE="$FONT" COLOR="$FONTCOLOR">
# <B>Click</B>
# <A HREF="http://bignosebird.com/carchive/survey.shtml"><B>HERE</B><
+/A>
# <B>to Download!</B>
# </FONT>
# <CENTER>
# <P>
sub set_group_header{
my ($GROUP_HEADING)=@_;
my $GROUP_HEADER=<<__END_GROUP_HEADER__;
<TR>
<TD COLSPAN=4 ALIGN=LEFT bgcolor="#000080">
<FONT FACE="$HEADINGFONT" COLOR="$HEADINGCOLOR"><B>$GROUP_HEADING</B
+></FONT>
</TD>
</TR>
<TR>
<TD WIDTH="60%"><FONT FACE="$FONT" COLOR="$FONTCOLOR" size="2"><b>Re
+sponse</b></TD>
<TD WIDTH="10%" ALIGN=RIGHT><FONT FACE="$FONT" COLOR="$FONTCOLOR" si
+ze="2"><b>Number</b></TD>
<TD WIDTH="10%" ALIGN=RIGHT><FONT FACE="$FONT" COLOR="$FONTCOLOR" si
+ze="2"><b>Percent</b></TD>
<TD WIDTH="20%"><FONT FACE="$FONT" COLOR="$FONTCOLOR" size="2"><b>Gr
+aph</b></TD>
</TR>
__END_GROUP_HEADER__
return $GROUP_HEADER;
}
sub set_question{
my ($respitem,$count,$pct,$giffile) = @_;
my $factor = $pct * 2.50;
my $SCALE=int($factor);
my $RESPONSE=<<__END_RESPONSE_LINE__;
<TR>
<TD VALIGN=TOP><FONT FACE="$FONT" COLOR="$FONTCOLOR"><small>$respite
+m</small></FONT></TD>
<TD VALIGN=TOP ALIGN=RIGHT><FONT FACE="$FONT" COLOR="$FONTCOLOR"><sm
+all>$count</small></FONT></TD>
<TD VALIGN=TOP ALIGN=RIGHT><FONT FACE="$FONT" COLOR="$FONTCOLOR"><sm
+all>$pct\%</small></FONT></TD>
<TD><IMG SRC="http://$DOMAIN/$GRAPHICSDIR/$giffile" HEIGHT=5 WIDTH=$
+SCALE BORDER=0></TD>
</TR>
__END_RESPONSE_LINE__
return $RESPONSE;
}
sub set_footer{
my ($tot) = @_;
my $FOOTGROUP=<<__END_GROUP_FOOTER__;
<TR>
<TD COLSPAN=4 ALIGN=RIGHT><FONT FACE="$FONT" COLOR="$FONTCOLOR"><smal
+l>Total Number of Responses: $tot</small><br></FONT></TD>
</TR>
__END_GROUP_FOOTER__
return $FOOTGROUP;
}
sub set_page_footer{
my $PAGEFOOT=<<__END_PAGE_FOOT__;
</TD>
</TR>
<TR>
<TD COLSPAN=4 ALIGN=CENTER>
<FONT FACE="$FONT" COLOR="#000080" size="2">The top 3 chosen will be
+ asked to present to the Trustees and the decision will be announced
+as soon as possible<br>
<A HREF="$JUMP_URL"><B>Back to Intranet Home Page</B>
</FONT>
</TD>
</TR>
</TABLE>
</TD>
</TR>
</TABLE>
</CENTER>
__END_PAGE_FOOT__
return $PAGEFOOT;
}
Never knowingly obfuscated
|