#!/usr/bin/perl use vars qw(%config %category %form); use strict; #-########################################################################### # # In accordance with the GPL, this copyright notice MUST remain intact: # # EveryAuction Release Version 1.51 (5/13/00) # Copyright (C) 2000 EverySoft # Registered with the United States Copyright Office, TX5-186-526 # http://www.everysoft.com/ # #-########################################################################### # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # #-########################################################################### # # Modification Log (please add new entries to bottom): # # * 02/2000 # Matt Hahnfeld (matth@everysoft.com) - Original Concept and Design # Version available from http://www.everysoft.com/ # # * MM/YYYY # Name (email) - Modification # Availability # #-########################################################################### #-############################################# # Configuration Section # Edit these variables! local %config; # The Base Directory. We need an # absolute path for the base directory. # Include the trailing slash. THIS SHOULD # NOT BE WEB-ACCESSIBLE! $config{'basepath'} = '/home/hahnfld/auctiondata/'; # Closed Auction Directory # This is where closed auction items are stored. # Leave this blank if you don't want to store # closed auctions. It can potentially take # up quite a bit of disk space. $config{'closedir'} = 'closed'; # User Registration Directory # This is where user registrations are stored. # Leave this blank if you don't want to # require registration. It can potentially # take up quite a bit of disk space. $config{'regdir'} = 'reg'; # List each directory and its associated # category name. These directories should # be subdirectories of the base directory. %category = ( computer => 'Computer Hardware and Software', elec => 'Consumer Electronics', other => 'Other Junk', ); # This is the password for deleting auction # items. $config{'adminpass'} = 'auction'; # You need to assign either a mail program or # a mail host so confirmation e-mails can # be sent out. # Leave one commented and one uncommented. # # YOU NEED EITHER A MAIL PROGRAM # $config{'mailprog'} = '/usr/lib/sendmail -t'; # # OR YOU NEED A MAIL HOST (SMTP) $config{'mailhost'} = 'localhost'; # This line should be your e-mail address $config{'admin_address'} = 'nobody@yourhost.com'; # This line should point to the URL of # your server. It will be used for sending # "you have been outbid" e-mail. The script # name and auction will be appended to the # end automatically, so DO NOT use a trailing # slash. If you do not want to send outbid # e-mail, leave this blank. $config{'scripturl'} = 'www.your.host.com'; # This will let you define colors for the # tables that are generated and the # other page colors. The default colors # create a nice "professional" look. Must # be in hex format. $config{'colortablehead'} = '#BBBBBB'; $config{'colortablebody'} = '#EEEEEE'; # Site Name (will appear at the top of each page) $config{'sitename'} = 'Your Site Name Here'; # You can configure your own header which will # be appended to the top of each page. $config{'header'} =<<"EOF"; $config{'sitename'} - Powered By EveryAuction
$config{'sitename'}
Online Auction
keyword username

EOF # You can configure your own footer which will # be appended to the bottom of each page. # Although not required, a link back to # everysoft.com will help to support future # development. $config{'footer'} =<<"EOF";

Powered By EveryAuction 1.51
EOF # Sniper Protection... How many minutes # past last bid to hold auction. If auctions # should close at exactly closing time, set # to zero. $config{'aftermin'} = 5; # File locking enabled? Should be 1 (yes) # for most systems, but set to 0 (no) if you # are getting flock errors or the script # crashes. $config{'flock'} = 1; # User Posting Enabled- 1=yes 0=no $config{'newokay'} = 1; #-############################################# # Main Program # You do not need to edit anything below this # line. #-############################################# # Print The Page Header # print "Content-type: text/html\n\n"; print $config{'header'}; # #-############################################# local %form = &get_form_data; if ($form{'action'} eq 'new') { &new; } elsif ($form{'action'} eq 'repost') { &new; } elsif ($form{'action'} eq 'procnew') { &procnew; } elsif ($form{'action'} eq 'procbid') { &procbid; } elsif ($form{'action'} eq 'reg') { ® } elsif ($form{'action'} eq 'procreg') { &procreg; } elsif ($form{'action'} eq 'creg') { &creg; } elsif ($form{'action'} eq 'proccreg') { &proccreg; } elsif ($form{'action'} eq 'closed') { &viewclosed1; } elsif ($form{'action'} eq 'closed2') { &viewclosed2; } elsif ($form{'action'} eq 'closed3') { &viewclosed3; } elsif ($form{'action'} eq 'admin') { &admin; } elsif ($form{'action'} eq 'procadmin') { &procadmin; } elsif ($form{'action'} eq 'search') { &procsearch; } elsif ($form{'item'} eq int($form{'item'}) and $category{$form{'category'}}) { &dispitem; } elsif ($category{$form{'category'}}) { &displist; } else { &dispcat; } #-############################################# # Print The Page Footer # print "

[Category List]"; print " [Post New Item]" if ($config{'newokay'}); print " [New Registration] [Change Registration]" if ($config{'regdir'}); print " [Closed Auctions]" if ($config{'regdir'}) and ($config{'closedir'}); print "

\n"; print $config{'footer'}; # #-############################################# #-############################################# # Sub: Display List Of Categories # This creates a "nice" list of categories. sub dispcat { print "

Auction Categories

\n"; print ""; my $key; foreach $key (sort keys %category) { umask(000); # UNIX file permission junk mkdir("$config{'basepath'}$key", 0777) unless (-d "$config{'basepath'}$key"); opendir DIR, "$config{'basepath'}$key" or &oops("Category directory $key could not be opened."); my $numfiles = scalar(grep -T, map "$config{'basepath'}$key/$_", readdir DIR); closedir DIR; print ""; } print "
CategoryItems
$category{$key}$numfiles
\n"; } #-############################################# # Sub: Display List Of Items # This creates a "nice" list of items in a # category. sub displist { print "

$category{$form{'category'}}

\n"; print "\n"; print "\n"; opendir THEDIR, "$config{'basepath'}$form{'category'}" or &oops("Category directory $form{'category'} could not be opened."); my @allfiles = grep -T, map "$config{'basepath'}$form{'category'}/$_", sort { int($a) <=> int($b) } (readdir THEDIR); closedir THEDIR; my $file; foreach $file (@allfiles) { $file =~ s/^$config{'basepath'}$form{'category'}\///; $file =~ s/\.dat$//; my ($title, $reserve, $inc, $desc, $image, @bids) = &read_item_file($form{'category'},$file); if ($title ne '') { my ($alias, $email, $bid, $time, $add1, $add2, $add3) = &read_bid($bids[$#bids]); my @closetime = localtime($file); $closetime[4]++; print "\n"; } } print "
ItemClosesNum BidsHigh Bid
$title"; print " [PIC]" if ($image); print "$closetime[4]/$closetime[3]$#bids\$$bid
\n"; } #-############################################# # Sub: Display Item # This displays a particular item, its # description, and its associated bids. sub dispitem { my ($title, $reserve, $inc, $desc, $image, @bids) = &read_item_file($form{'category'},$form{'item'}); &oops("Item $form{'item'} could not be opened. If this item is closed, you can view statistics and bid history using our closed item viewer.") if $title eq ''; my $nowtime = localtime(time); my $closetime = localtime($form{'item'}); print "

$title

Information
\n"; print ""; print "" if ($image); print "
$title
Category: $category{$form{'category'}}
"; my ($alias, $email, $bid, $time, $add1, $add2, $add3) = &read_bid($bids[0]); # read first bid print "Offered By: $alias
Current Time: $nowtime
Closes: $closetime
Or $config{'aftermin'} minutes after last bid...
Number of Bids: $#bids
"; my ($alias, $email, $bid, $time, $add1, $add2, $add3) = &read_bid($bids[$#bids]); # read last bid print "Last Bid: \$$bid "; print "(reserve price not yet met)" if ($bid < $reserve); print "(reserve price met)" if (($bid >= $reserve) and ($reserve > 0)); print "
\n"; print "
Description
$desc"; print "
Bid History
\n"; my $lowest_new_bid; if ($#bids) { for (my $i=1; $i$alias \($bidtime\) - \$$bid
"; } $lowest_new_bid = &parsebid($bid+$inc); } else { print "No bids yet...
"; $lowest_new_bid = (&read_bid($bids[0]))[2]; } # either the item is closed or we will display a bid form my ($alias, $email, $bid, $time, $add1, $add2, $add3) = &read_bid($bids[$#bids]); # read the last bid if ((time > int($form{'item'})) && (time > (60 * $config{'aftermin'} + $time))) { print "BIDDING IS NOW CLOSED
"; &closeit($form{'category'},$form{'item'}); } else { print <<"EOF";
Place A Bid
The High Bid Is: \$$bid
The Lowest You May Bid Is: \$$lowest_new_bid

Please note that by placing a bid you are making a contract between you and the seller. Once you place a bid, you may not retract it. In some states, it is illegal to win an auction and not purchase the item. In other words, if you don't want to pay for it, don't bid! EOF if ($config{'regdir'}) { print <<"EOF";

Registration is required to post or bid!

Your Handle/Alias: (used to track your bid)
Your Password: (must be valid)
Your Bid: \$

EOF } else { print <<"EOF";

Your Handle/Alias: (used to track your bid)
Your E-Mail Address: (must be valid)
Your Bid: \$

Contact Information: (will be given out only to the seller)
Full Name:

Street Address:

City, State, ZIP:

EOF } print <<"EOF"; EOF } } #-############################################# # Sub: Add New Item # This allows a new item to be put up for sale sub new { my $inc = '1.00'; # default increment my ($title, $reserve, $inc, $desc, $image, @bids); if ($form{'REPOST'}) { $form{'REPOST'} =~ s/\W//g; if (-T "$config{'basepath'}$config{'closedir'}/$form{'REPOST'}.dat") { open THEFILE, "$config{'basepath'}$config{'closedir'}/$form{'REPOST'}.dat"; ($title, $reserve, $inc, $desc, $image, @bids) = ; close THEFILE; chomp($title, $reserve, $inc, $desc, $image, @bids); $title =~ s/\"//g; # quotes cause problems for a text input field } } print <<"EOF";

Post A New Item

Title/Item Name:
No HTML
Category:
Select One
Image URL:
Optional, should be no larger than 200x200
Days Until Close:
1-14
Description:
May include HTML - This should include the condition of the item, payment and shipping information, and any other information the buyer should know.
Please note that by placing an item up for bid you are making a contract between you and the buyer. Once you place an item, you may not retract it and you must sell it for the highest bid. In other words, if you don't want to sell it, don't place it up for bid! EOF if ($config{'regdir'}) { print <<"EOF";

Registration is required to post or bid!

Your Handle/Alias:
Used to track your post
Your Password:
Must be valid
Your Starting Bid:\$
Your Reserve Price:
You are not obligated to sell below this price. Leave blank if none.		\$
Bid Increment:\$
EOF } else { print <<"EOF"; Your Handle/Alias:
Used to track your post Your E-Mail Address:
Must be valid Your Starting Bid:\$ Your Reserve Price:
You are not obligated to sell below this price. Leave blank if none.\$ Bid Increment:\$ Contact Information:
Will be given out only to the buyer Full Name:

Street Address:

City, State, ZIP:
EOF } print <<"EOF";
EOF } #-############################################# # Sub: Process New Item # This processes new item to be put up for # sale from a posted form sub procnew { my ($password, @userbids); if ($config{'regdir'} ne "") { &oops('Your alias could not be found!') unless ($password, $form{'EMAIL'}, $form{'ADDRESS1'}, $form{'ADDRESS2'}, $form{'ADDRESS3'}, @userbids) = &read_reg_file($form{'ALIAS'}); $form{'ALIAS'} = ucfirst(lc($form{'ALIAS'})); &oops('Your password is incorrect.') unless ((lc $password) eq (lc $form{'PASSWORD'})); } &oops('You must have an item title that is up to 50 characters.') unless ($form{'TITLE'} && (length($form{'TITLE'}) < 51)); $form{'TITLE'} =~ s/\/\>\;/g; &oops('You must select a valid category.') unless (-d "$config{'basepath'}$form{'CATEGORY'}" and $category{$form{'CATEGORY'}}); $form{'IMAGE'} = "" if ($form{'IMAGE'} eq "http://"); &oops('You must enter the number of days your auction should run, from 1 to 14.') unless (($form{'DAYS'} > 0) and ($form{'DAYS'} < 15)); &oops('You must enter an item description.') unless ($form{'DESC'}); &oops('You must enter an alias to track your item.') unless ($form{'ALIAS'}); &oops('You must enter a valid e-mail address.') unless ($form{'EMAIL'} =~ /^.+\@.+\..+$/); &oops('You must enter a valid starting bid.') unless ($form{'BID'} =~ /^(\d+\.?\d*|\.\d+)$/); &oops('You must enter a valid bid increment.') unless (($form{'INC'} =~ /^(\d+\.?\d*|\.\d+)$/) and ($form{'INC'} >= .01)); $form{'INC'} = &parsebid($form{'INC'}); $form{'RESERVE'} = &parsebid($form{'RESERVE'}); &oops('You must enter your full name.') unless ($form{'ADDRESS1'}); &oops('You must enter your street address.') unless ($form{'ADDRESS2'}); &oops('You must enter your city, state, and zip code.') unless ($form{'ADDRESS3'}); my $item_number = ($form{'DAYS'} * 86400 + time); $item_number = ($form{'DAYS'} * 86400 + time) until (!(-f "$config{'basepath'}$form{'CATEGORY'}/$item_number.dat")); if ($form{'FROMPREVIEW'}) { my $key; foreach $key (keys %form) { $form{$key} =~ s/\[greaterthansign\]/\>/gs; $form{$key} =~ s/\[lessthansign\]/\$config{'basepath'}$form{'CATEGORY'}/$item_number.dat")); print NEW "$form{'TITLE'}\n$form{'RESERVE'}\n$form{'INC'}\n$form{'DESC'}\n$form{'IMAGE'}\n$form{'ALIAS'}\[\]$form{'EMAIL'}\[\]".&parsebid($form{'BID'})."\[\]".time."\[\]$form{'ADDRESS1'}\[\]$form{'ADDRESS2'}\[\]$form{'ADDRESS3'}"; close NEW; if ($config{'regdir'} ne "") { &oops('We could not open the registration file. This could be a server write issue.') unless (open(REGFILE, ">>$config{'basepath'}$config{'regdir'}/$form{'ALIAS'}.dat")); print REGFILE "\n$form{'CATEGORY'}$item_number"; close REGFILE; } print "$form{'TITLE'} was posted under $category{$form{'CATEGORY'}}....
You may want to go to the item to confirm placement.\n\n"; } else { my $nowtime = localtime(time); my $closetime = localtime($item_number); print "

$form{'TITLE'} PREVIEW

Information
\n"; print ""; print "" if ($form{'IMAGE'}); print "
$form{'TITLE'}
Category: $category{$form{'CATEGORY'}}
Offered By: $form{'ALIAS'}
Current Time: $nowtime
Closes: $closetime
Or $config{'aftermin'} minutes after last bid...
Number of Bids: 0
Last Bid: \$$form{'BID'}
\n"; print "
Description
$form{'DESC'}"; print "
If this looks good, hit , else hit the back button on your browser to edit the item.\n"; my $key; foreach $key (keys %form) { $form{$key} =~ s/\>/\[greaterthansign\]/gs; $form{$key} =~ s/\\n"; } print "
\n"; } } #-############################################# # Sub: Process Bid # This processes new bids from a posted form sub procbid { my ($password, @userbids); if ($config{'regdir'} ne "") { &oops('Your alias could not be found!') unless ($password, $form{'EMAIL'}, $form{'ADDRESS1'}, $form{'ADDRESS2'}, $form{'ADDRESS3'}, @userbids) = &read_reg_file($form{'ALIAS'}); $form{'ALIAS'} = ucfirst(lc($form{'ALIAS'})); &oops('Your password is incorrect.') unless ((lc $password) eq (lc $form{'PASSWORD'})); } &oops('You must enter an alias to track your item.') unless ($form{'ALIAS'}); &oops('You must enter a valid e-mail address.') unless ($form{'EMAIL'} =~ /^.+\@.+\..+$/); &oops('You must enter a valid bid amount.') unless ($form{'BID'} =~ /^(\d+\.?\d*|\.\d+)$/); $form{'BID'} = &parsebid($form{'BID'}); &oops('You must enter your full name.') unless ($form{'ADDRESS1'}); &oops('You must enter your street address.') unless ($form{'ADDRESS2'}); &oops('You must enter you city, state, and zip.') unless ($form{'ADDRESS3'}); my ($title, $reserve, $inc, $desc, $image, @bids) = &read_item_file($form{'CATEGORY'},$form{'ITEM'}); &oops('The item number you entered cannot be found. Maybe it has closed or it was moved since you last loaded the page.') if $title eq ''; my ($alias, $email, $bid, $time, $add1, $add2, $add3) = &read_bid($bids[$#bids]); if ((time <= $form{'ITEM'}) or (time <= (60 * $config{'aftermin'} + $time))) { &oops('Your bid is too low. Sorry.') if ($form{'BID'} < ($bid+$inc) and ($#bids)) or ($form{'BID'} < $bid); &oops('We are unable to append your bid to the auction item. It appears to be a file write problem.') unless (open NEW, ">>$config{'basepath'}$form{'CATEGORY'}/$form{'ITEM'}.dat"); if ($config{'flock'}) { flock(NEW, 2); seek(NEW, 0, 2); } print NEW "\n$form{'ALIAS'}\[\]$form{'EMAIL'}\[\]$form{'BID'}\[\]".time."\[\]$form{'ADDRESS1'}\[\]$form{'ADDRESS2'}\[\]$form{'ADDRESS3'}"; close NEW; print "$form{'ALIAS'}, your bid has been placed on item number $form{'ITEM'} for \$$form{'BID'} on ".scalar(localtime(time)).".
You may want to print this notice as confirmation of your bid.

Go back to the item\n"; my $flag=0; my $userbid; foreach $userbid (@userbids) { $flag=1 if ("$form{'CATEGORY'}$form{'ITEM'}" eq $userbid); } if ($flag==0 && $config{'regdir'} ne "") { &oops('We could not open the registration file. This could be a server write issue.') unless (open(REGFILE, ">>$config{'basepath'}$config{'regdir'}/$form{'ALIAS'}.dat")); print REGFILE "\n$form{'CATEGORY'}$form{'ITEM'}"; close REGFILE; } &sendemail($email, $config{'admin_address'}, 'You\'ve been outbid!', "You have been outbid on $title\! If you want to place a higher bid, please visit\:\r\n\r\n\thttp://$config{'scripturl'}$ENV{'SCRIPT_NAME'}\?category=$form{'CATEGORY'}\&item=$form{'ITEM'}\r\n\r\nThe current high bid is \$$form{'BID'}.") if ($config{'scripturl'} and $#bids); } else { print "Item number $form{'ITEM'} in category $form{'CATEGORY'} is now closed!
Sorry...\n"; } } #-############################################# # Sub: Process Search # This displays search results sub procsearch { print "

Search Results - $form{'searchstring'}

\n"; print "\n"; print "\n"; my $key; foreach $key (sort keys %category) { opendir THEDIR, "$config{'basepath'}$key" or &oops("Category directory $key could not be opened."); my @allfiles = grep -T, map "$config{'basepath'}$key/$_", sort { int($a) <=> int($b) } (readdir THEDIR); closedir THEDIR; my $file; foreach $file (@allfiles) { $file =~ s/^$config{'basepath'}$key\///; $file =~ s/\.dat$//; my ($title, $reserve, $inc, $desc, $image, @bids) = &read_item_file($key,$file); if ($title ne '') { my ($alias, $email, $bid, $time, $add1, $add2, $add3) = &read_bid($bids[$#bids]); my @closetime = localtime($file); $closetime[4]++; if($form{'searchtype'} eq 'keyword' and ($title =~ /$form{'searchstring'}/i) || ($desc =~ /$form{'searchstring'}/i)) { print "\n"; } elsif($form{'searchtype'} eq 'username' and join(' ',@bids) =~ /$form{'searchstring'}/i) { print "\n"; } } } } print "
ItemClosesNum BidsHigh Bid
$title"; print " [PIC]" if ($image); print "$closetime[4]/$closetime[3]$#bids\$$bid
$title"; print " [PIC]" if ($image); print "$closetime[4]/$closetime[3]$#bids\$$bid
\n"; } #-############################################# # Sub: Change Registration # This allows a user to change information sub creg { print <<"EOF";

Change Street Address and/or Password

This form will allow you to change your street address and/or password.
Your Handle/Alias:
Required for verification
Your Current Password:
Required for verification
Your New Password:
Leave blank if unchanged
Your New Password Again:
Leave blank if unchanged
Contact Information:
Leave blank if unchanged		 Full Name:

Street Address:

City, State, ZIP:
EOF } #-############################################# # Sub: Process Changed Registration # This modifies an account sub proccreg { if ($config{'regdir'}) { &oops('You must enter your alias so we can validate your account.') unless ($form{'ALIAS'}); &oops('You must enter your old password so we can validate your account.') unless ($form{'OLDPASS'}); if ($form{'ADDRESS1'}) { &oops('You must enter all of your contact information. Please enter your street address.') unless ($form{'ADDRESS2'}); &oops('You must enter all of your contact information. Please enter your city, state, and zip.') unless ($form{'ADDRESS3'}); } if ($form{'NEWPASS1'}) { &oops('Your new passwords do not match.') unless ($form{'NEWPASS2'} eq $form{'NEWPASS1'}); } if (my ($password,$email,$add1,$add2,$add3,@past_bids) = &read_reg_file($form{'ALIAS'})) { $form{'ALIAS'} = ucfirst(lc($form{'ALIAS'})); &oops('Your old password does not match up.') unless ((lc $password) eq (lc $form{'OLDPASS'})); $form{'NEWPASS1'} = $password if !($form{'NEWPASS1'}); $form{'ADDRESS1'} = $add1 if !($form{'ADDRESS1'}); $form{'ADDRESS2'} = $add2 if !($form{'ADDRESS2'}); $form{'ADDRESS3'} = $add3 if !($form{'ADDRESS3'}); &oops('We cannot open your account. This could be a server data write issue.') unless (open NEWREG, ">$config{'basepath'}$config{'regdir'}/$form{'ALIAS'}.dat"); print NEWREG "$form{'NEWPASS1'}\n$email\n$form{'ADDRESS1'}\n$form{'ADDRESS2'}\n$form{'ADDRESS3'}"; my $bid; foreach $bid (@past_bids) { print NEWREG "\n$bid"; } close NEWREG; print "$form{'ALIAS'}, your information has been successfully changed.\n"; } else { print "Sorry... That Username is not valid. If you do not have an alias (or cannot remember it) you should create a new account.\n"; } } else { print "User Registration is Not Implemented on This Server! The System Administrator Did Not Specify a Registration Directory...\n"; } } #-############################################# # Sub: New Registration # This creates a form for registration sub reg { print <<"EOF";

New User Registration

This form will allow you to register to buy or sell auction items. You must enter accurate data, and your new password will be e-mailed to you. Please be patient after hitting the submit button. Registration may take a few seconds.
Your Handle/Alias:
Used to track your post
Your E-Mail Address:
Must be valid
Contact Information:
Will be given out only to the buyer or seller		 Full Name:

Street Address:

City, State, ZIP:
EOF } #-############################################# # Sub: Process Registration # This adds new accounts to the database sub procreg { if ($config{'regdir'}) { umask(000); # UNIX file permission junk mkdir("$config{'basepath'}$config{'regdir'}", 0777) unless (-d "$config{'basepath'}$config{'regdir'}"); &oops('You must enter an alias that consists of alphanumeric characters.') if $form{'ALIAS'} =~ /\W/ or !($form{'ALIAS'}); &oops('You must enter a valid e-mail address.') unless ($form{'EMAIL'} =~ /^.+\@.+\..+$/); &oops('You must enter your full name so buyers or sellers may contact you.') unless ($form{'ADDRESS1'}); &oops('You must enter a valid street address so buyers or sellers can contact you.') unless ($form{'ADDRESS2'}); &oops('You must enter a valid city, state, and zip code so buyers or sellers can contact you.') unless ($form{'ADDRESS3'}); $form{'ALIAS'} = ucfirst(lc($form{'ALIAS'})); if (!(-f "$config{'basepath'}$config{'regdir'}/$form{'ALIAS'}.dat")) { &oops('We were unable to write to the user directory.') unless (open NEWREG, ">$config{'basepath'}$config{'regdir'}/$form{'ALIAS'}.dat"); my $newpass = &randompass; print NEWREG "$newpass\n$form{'EMAIL'}\n$form{'ADDRESS1'}\n$form{'ADDRESS2'}\n$form{'ADDRESS3'}"; close NEWREG; print "$form{'ALIAS'}, you should receive an e-mail to $form{'EMAIL'} in a few minutes. It will contain your password needed to post or bid. You may change your password once you receive it. If you do not get an e-mail, please re-register.\n"; &sendemail($form{'EMAIL'}, $config{'admin_address'}, 'Auction Password', "PLEASE DO NOT REPLY TO THIS E-MAIL.\r\n\r\nThank you for registering to use the online auctions at $config{'sitename'}!\r\n\r\nYour new password is: $newpass\r\nYour alias (as you entered it) is: $form{'ALIAS'}\r\n\r\nThank you for visiting!"); } else { print "Sorry... that alias is taken. Hit back to try again!\n"; } } else { print "User Registration is Not Implemented on This Server! The System Administrator Did Not Specify a Registration Directory...\n"; } } #-############################################# # Sub: Closed items 1 # This displays closed items sub viewclosed1 { print <<"EOF";

View Closed Items

This form will allow you to view the status and contact information for closed auction items you bid on or listed for auction.
Your Username:
Required for verification
Your Password:
Required for verification
EOF } #-############################################# # Sub: Closed items 2 # This displays closed items sub viewclosed2 { &oops('Your alias could not be found!') unless my ($password,$email,$add1,$add2,$add3,@past_bids) = &read_reg_file($form{'ALIAS'}); &oops('Your password is incorrect.') unless ((lc $password) eq (lc $form{'PASSWORD'})); &oops('PASSWORD') unless ((lc $password) eq (lc $form{'PASSWORD'})); print "\n"; print "
\n"; } #-############################################# # Sub: Closed items 3 # This displays closed items sub viewclosed3 { $form{'BIDTOVIEW'} =~ s/\W//g; open (THEFILE, "$config{'basepath'}$config{'closedir'}/$form{'BIDTOVIEW'}.dat") or &oops('We cannot open the item you are looking for. This could be a server read issue.'); my ($title, $reserve, $inc, $desc, $image, @bids) = ; close THEFILE; chomp($title, $reserve, $inc, $desc, $image, @bids); print "

$title

\n"; print "
Description
$desc"; print "
Bid History
\n"; if ($#bids) { for (my $i=1; $i$alias \($bidtime\) - \$$bid
"; } } else { print "No bids were placed...
"; } print "

Reserve was: \$$reserve
\n"; print "

Contact Information
\n"; if (ucfirst(lc($form{'ALIAS'})) eq (&read_bid($bids[0]))[0]) { print "You were the seller...

\n"; if ($#bids) { my ($alias, $email, $bid, $time, $add1, $add2, $add3) = &read_bid($bids[$#bids]); print "Buyer Information:
Alias: $alias
E-Mail: $email
Address: $add1
$add2
$add3

High Bid: \$$bid\n"; print "

Bidder Contact Info:
\n"; for (my $i=1; $i$alias - $email
\n"; } } print "

You may repost this item if you want to:
\n"; } elsif (ucfirst(lc($form{'ALIAS'})) eq (&read_bid($bids[$#bids]))[0]) { print "You were a high bidder...

\n"; my ($alias, $email, $bid, $time, $add1, $add2, $add3) = &read_bid($bids[0]); print "Seller Information:
Alias: $alias
E-Mail: $email
Address: $add1
$add2
$add3

"; my ($alias, $email, $bid, $time, $add1, $add2, $add3) = &read_bid($bids[$#bids]); print "Your High Bid: \$$bid

\n"; print "Remember, the seller is not required to sell unless your bid price was above the reserve price..."; } else { print "You were not a winner... No further contact information is available.\n"; } } #-############################################# # Sub: Admin # Allows the administrator to delete items. sub admin { print <<"EOF";

Delete Items

This form will allow you to delete an item. You will need the administrator password that should be configured in the script.
Category:
Select One
Item Number:
Administrator Password:
Required for verification
EOF } #-############################################# # Sub: Process Admin # Allows the administrator to delete items. sub procadmin { if (lc($form{'PASSWORD'}) eq lc($config{'adminpass'})) { &oops('Bad Item Category or Number!') unless &read_item_file($form{'CATEGORY'},$form{'ITEM'}); if (unlink("$config{'basepath'}$form{'CATEGORY'}/$form{'ITEM'}.dat")) { print "File Successfully Removed!\n"; } else { print "File Could Not Be Removed!\n"; } } else { print "Sorry... Incorrect administrator password for delete!\n"; } } #-############################################# # Sub: Close Auction # This sets an item's status to closed. sub closeit { my ($cat,$item) = @_; if ($cat ne $config{'closedir'}) { my ($title, $reserve, $inc, $desc, $image, @bids) = &read_item_file($cat,$item); my @lastbid = &read_bid($bids[$#bids]); my @firstbid = &read_bid($bids[0]); if ($#bids) { if ($lastbid[2] >= $reserve) { &sendemail($lastbid[1], $firstbid[1], "Auction Close: $title", "Congratulations! You are the winner of auction number $item.\r\nYour winning bid was \$$lastbid[2].\r\n\r\nPlease contact the seller to make arrangements for payment and shipping:\r\n\r\n$firstbid[4]\r\n$firstbid[5]\r\n$firstbid[6]\r\n$firstbid[1]\r\n\r\nThanks for using $config{'sitename'}!"); } else { &sendemail($lastbid[1], $firstbid[1], "Auction Close: $title", "Congratulations! You were the high bidder on auction number $item.\r\nYour bid was \$$lastbid[2].\r\n\r\nUnfortunately, your bid did not meet the seller\'s reserve price...\r\n\r\nYou may still wish to contact the seller to negotiate a fair price:\r\n\r\n$firstbid[4]\r\n$firstbid[5]\r\n$firstbid[6]\r\n$firstbid[1]\r\n\r\nThanks for using $config{'sitename'}!"); } &sendemail($firstbid[1], $lastbid[1], "Auction Close: $title", "Auction number $item is now closed.\r\nThe high bid was \$$lastbid[2] (your reserve was: \$$reserve).\r\n\r\nPlease contact the high bidder to make any necessary arrangements:\r\n\r\n$lastbid[4]\r\n$lastbid[5]\r\n$lastbid[6]\r\n$lastbid[1]\r\n\r\nThanks for using $config{'sitename'}!"); } else { &sendemail($firstbid[1], $config{'admin_address'}, "Auction Close: $title", "Auction number $item is now closed.\r\nThere were no bids on your item. You may repost your item by using the closed auction manager at http://$config{'scripturl'}$ENV{'SCRIPT_NAME'}. Thanks for using $config{'sitename'}!"); } if ($config{'closedir'}) { umask(000); # UNIX file permission junk mkdir("$config{'basepath'}$config{'closedir'}", 0777) unless (-d "$config{'basepath'}$config{'closedir'}"); print "Please notify the site admin that this item cannot be copied to the closed directory even though it is closed.\n" unless &movefile("$config{'basepath'}$cat/$item.dat", "$config{'basepath'}$config{'closedir'}/$cat$item.dat"); } else { print "Please notify the site admin that this item cannot be removed even though it is closed.\n" unless unlink("$config{'basepath'}$cat/$item.dat"); } } } #-############################################# # SUB: Send E-mail # This is a real quick-and-dirty mailer that # should work on any platform. It is my first # attempt to work with sockets, so if anyone # has any suggestions, let me know! # # Takes: # (To, Subject, From, Message) sub sendemail { my ($to,$from,$subject,$message) = @_; my $trash; if ($config{'mailhost'}) { eval('use IO::Socket; 1;') or &oops("IO::Socket could not be loaded by the script. Please see the script documentation for details. It looks like this server is using perl version $]. IO::Socket may not be included with versions of perl prior to 5.00404."); # don't cause errors on machines where IO::Socket is not available my $remote; $remote = IO::Socket::INET->new("$config{'mailhost'}:smtp(25)"); $remote->autoflush(); print $remote "HELO\r\n"; $trash = <$remote>; print $remote "MAIL From:<$config{'admin_address'}>\r\n"; $trash = <$remote>; print $remote "RCPT To:<$to>\r\n"; $trash = <$remote>; print $remote "DATA\r\n"; $trash = <$remote>; print $remote "From: <$from>\r\nSubject: $subject\r\n\r\n"; print $remote $message; print $remote "\r\n.\r\n"; $trash = <$remote>; print $remote "QUIT\r\n"; } else { open MAIL, "|$config{'mailprog'}"; print MAIL "To: $to\r\nFrom: $from\r\nSubject: $subject\r\n\r\n$message\r\n\r\n"; close MAIL; } } #-############################################# # Sub: Get Form Data # This gets data from a post. sub get_form_data { my $temp; my $buffer; my @data; read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); foreach $temp (split(/&|=/,$buffer)) { $temp =~ tr/+/ /; $temp =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge; $temp =~ s/[\r\n]/ /g; push @data, $temp; } foreach $temp (split(/&|=/,$ENV{'QUERY_STRING'})) { $temp =~ tr/+/ /; $temp =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge; $temp =~ s/[\r\n]/ /g; push @data, $temp; } return @data; } #-############################################# # Sub: Random Password # This generates psudo-random 8-letter # passwords sub randompass { srand(time ^ $$); my @passset = ('a'..'k', 'm'..'n', 'p'..'z', '2'..'9'); my $randpass = ""; for (my $i=0; $i<8; $i++) { $randpass .= $passset[int(rand($#passset + 1))]; } return $randpass; } #-############################################# # Sub: parse bid # This formats a bid amount to look good... # ie. $###.## sub parsebid { $_[0] =~ s/\,//g; my @bidamt = split(/\./, $_[0]); $bidamt[0] = "0" if (!($bidamt[0])); $bidamt[0] = int($bidamt[0]); $bidamt[1] = substr($bidamt[1], 0, 2); $bidamt[1] = "00" if (length($bidamt[1]) == 0); $bidamt[1] = "$bidamt[1]0" if (length($bidamt[1]) == 1); return "$bidamt[0].$bidamt[1]"; } #-############################################# # Sub: Oops! # This generates an error message and dies. sub oops { print "

Error:
$_[0]

Please hit the back browser on your browser to try again or contact the auction administrator if you belive this to be a server problem.

\n"; print $config{'footer'}; die "Error: $_[0]\n"; } #-############################################# # Sub: Movefile(file1, file2) # This moves a file. Quick and dirty! sub movefile { my ($firstfile, $secondfile) = @_; return 0 unless open(FIRSTFILE,$firstfile); my @lines=; close FIRSTFILE; return 0 unless open(SECONDFILE,">$secondfile"); my $line; foreach $line (@lines) { print SECONDFILE $line; } close SECONDFILE; return 0 unless unlink($firstfile); return 1; } #-############################################# # Sub: Read Reg File (alias) # Reads a registration file sub read_reg_file { my $alias = shift; return '' unless $alias; # verify the user exists &oops('Your alias may not contain any non-word characters.') if $alias =~ /\W/; $alias = ucfirst(lc($alias)); return '' unless -r "$config{'basepath'}$config{'regdir'}/$alias.dat" and -T "$config{'basepath'}$config{'regdir'}/$alias.dat"; open FILE, "$config{'basepath'}$config{'regdir'}/$alias.dat"; my ($password,$email,$add1,$add2,$add3,@past_bids) = ; close FILE; chomp ($password,$email,$add1,$add2,$add3,@past_bids); return ($password,$email,$add1,$add2,$add3,@past_bids); } #-############################################# # Sub: Read Item File (cat, item) # Reads an item file sub read_item_file { my ($cat, $item) = @_; # verify the category exists return '' unless ($cat) and ($item); &oops('The category may not contain any non-word characters.') if $cat =~ /\W/; return '' unless $category{$cat}; # verify the item exists &oops('The item number may not contain any non-numeric characters.') if $item =~ /\D/; return '' unless (-T "$config{'basepath'}$cat/$item.dat") and (-R "$config{'basepath'}$cat/$item.dat"); open FILE, "$config{'basepath'}$cat/$item.dat"; my ($title, $reserve, $inc, $desc, $image, @bids) = ; close FILE; chomp ($title, $reserve, $inc, $desc, $image, @bids); return ($title, $reserve, $inc, $desc, $image, @bids); } #-############################################# # Sub: Read Bid Information (bid_string) # Reads an item file sub read_bid { my $bid_string = shift; my ($alias, $email, $bid, $time, $add1, $add2, $add3) = split(/\[\]/,$bid_string); return ($alias, $email, $bid, $time, $add1, $add2, $add3); }