#!/usr/local/bin/perl ############################################## # # EveryAuction # by Matt Hahnfeld, EverySoft # # The premiere freeware auction software from # the makers of EveryChat(tm). # # Version 1.01 (5/10/98) # # You may modify this script for your personal # or company/client use, but you may not # redistribute any modifications without # written permission from the author. There # are no warranties or guarantees of any # kind placed on this script. # # REDISTRIBUTION IN ANY FORM IS STRICTLY # PROHIBITED! # # (c) 1998 EverySoft # # http://www.everysoft.com/auction/ # ############################################## ############################################## # The input query string is in the form # auction.cgi?[category]&[number]&[r|n|u|c|v] # # If nothing is given, the script will # display the categories in the auction. # # If category dir is given, the # script will display the items in the # category. # # If category dir is given and message # number is given, the script will display # the item. # # If category dir is given and message # number is given, and the letter r is given # then the record will be deleted from # the database. # # If category dir is given and message # number is given, and the letter n is given # then a new record can be created. The # message number given is ignored. # # If category dir is given and message # number is given, and the letter u is given # then a new user registration can be # created. Both the message number and # category given are ignored. # # If category dir is given and message # number is given, and the letter c is given # then a user registration can be # changed. Both the message number and # category given are ignored. # # If category dir is given and message # number is given, and the letter v is given # then a user may view his/her closed item # status. Both the message number and # category given are ignored. # ############################################## # Configuration Section # Edit these variables! # The Base Directory. We need an # absolute path for the base directory. # Include the trailing slash. THIS SHOULD # NOT BE WEB-ACCESSIBLE! $basepath = '/digiweb/usr/netlaunch/comicgallery.com/public_html/auction/'; # 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. $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. $regdir = 'reg'; # List each directory and its associated # category name. These directories should # be subdirectories of the base directory. %category = ( sericels => 'Seri Cels', lihtos => 'Lithographs', HandCels => 'Hand Painted Cels', ); # This is the password for deleting auction # items. If it is left blank, anyone may # delete entries. $adminpass = 'callex'; # This must be the valid IP ADDRESS of an # SMTP server. It is used to mail auction # notifications. If the e-mail system is # not working, this is what you should # check first. $mailserver = "206.161.225.88"; # 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. $scripturl = "comicgallery.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. $colorbg = '#041467'; $colortext = '#dfb80a'; $colorlink = '#0bf7de'; $colorvlink = '#fbee23'; $coloralink = '#fbee23'; $colortablehead = '#004040'; $colortablebody = '#770038'; # Site Name (will appear at teh top of each page) $sitename = 'Comic Gallery'; # Sniper Protection... How many minutes # past last bid to hold auction. If auctions # should close at exactly closing time, set # to zero. $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. $flock = 1; # User Posting Enabled- 1=yes 0=no $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 "Comic Gallery\n"; print "
$sitename
Online Auction

keyword username

\n"; # ############################################## &get_form_data; # parse arguments from post @ARGV = split(/\\*\&/, $ENV{'QUERY_STRING'}); $ARGV[0] =~ s/\W//g; $ARGV[1] =~ s/\D//g; if ($form{'action'} eq 'bid') { &procbid; } elsif ($form{'action'} eq 'new') { &procnew; } elsif ($form{'action'} eq 'reg') { &procreg; } elsif ($form{'action'} eq 'creg') { &proccreg; } elsif ($form{'action'} eq 'repost') { &newitem; } elsif ($form{'action'} eq 'closeditems1') { &viewclosed1; } elsif ($form{'action'} eq 'closeditems2') { &viewclosed2; } elsif ($form{'searchstring'}) { &procsearch; } elsif ($ARGV[2] eq 'u') { &newreg; } elsif ($ARGV[2] eq 'c') { &changereg; } elsif ($ARGV[2] eq 'v') { &viewclosed; } elsif ($ARGV[2] eq 'n') { &newitem; } elsif (($regdir ne "") && ($ARGV[0] eq $regdir)) { &dispcat; } # be sure nobody is trying to hack the user dir elsif (!(($ARGV[0]) && (-d "$basepath$ARGV[0]"))) { &dispcat; } elsif ($ARGV[2] eq 'r') { &remitem; } elsif (!(($ARGV[1]) && (-f "$basepath$ARGV[0]/$ARGV[1].dat"))) { &displist; } else { &dispitem; } ############################################## # Print The Page Footer # print "

[Category List]"; print " [Post New Item]" if ($newokay); print " [New Registration] [Change Registration]" if ($regdir); print " [Closed Auctions]" if ($regdir) && ($closedir); # Please do not delete or change the following line!!! print ""; print "
Powered By Netlaunch

\n"; # ############################################## ############################################## # Sub: Display List Of Categories # This creates a "nice" list of categories. sub dispcat { print "

Auction Categories

\n"; print ""; foreach $key (sort keys %category) { opendir THEDIR, "$basepath$key" || die "Unable to open directory: $!"; @allfiles = grep -T, map "$basepath$key/$_", readdir THEDIR; closedir THEDIR; $numfiles = @allfiles; umask(000); # UNIX file permission junk mkdir("$basepath$key", 0777) unless (-d "$basepath$key"); 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{$ARGV[0]}

\n"; print "\n"; print "\n"; opendir THEDIR, "$basepath$ARGV[0]" || die "Unable to open directory: $!"; @allfiles = readdir THEDIR; closedir THEDIR; foreach $file (sort { int($a) <=> int($b) } @allfiles) { if (-T "$basepath$ARGV[0]/$file") { open THEFILE, "$basepath$ARGV[0]/$file"; ($title, $reserve, $inc, $desc, $image, @bids) = ; close THEFILE; chomp($title, $reserve, $inc, $desc, $image, @bids); @lastbid = split(/\[\]/,$bids[$#bids]); $file =~ s/\.dat//; @closetime = localtime($file); $closetime[4]++; $camera=""; $camera = " [PIC]" if ($image); print "\n"; } } print "
ItemClosesNum BidsHigh Bid
$title$camera$closetime[4]/$closetime[3]$#bids\$$lastbid[2]
\n"; } ############################################## # Sub: Display Item # This displays a particular item, its # description, and its associated bids. sub dispitem { open THEFILE, "$basepath$ARGV[0]/$ARGV[1].dat"; ($title, $reserve, $inc, $desc, $image, @bids) = ; close THEFILE; chomp($title, $reserve, $inc, $desc, $image, @bids); @firstbid = split(/\[\]/,$bids[0]); @lastbid = split(/\[\]/,$bids[$#bids]); $nowtime = localtime(time); $closetime = localtime($ARGV[1]); $image = "" if ($image); print "

$title

Information
\n"; $reservemet = ""; $reservemet = "(reserve price not yet met)" if ($lastbid[2] < $reserve); $reservemet = "(reserve price met)" if (($lastbid[2] >= $reserve) && ($reserve > 0)); print "$image
$title
Category: $category{$ARGV[0]}
Offered By: $firstbid[0]
Current Time: $nowtime
Closes: $closetime
Or $aftermin minutes after last bid...
Number of Bids: $#bids
Last Bid: \$$lastbid[2] $reservemet
\n"; print "
Description
$desc"; print "
Bid History
\n"; print "START: "; foreach $bid (@bids) { @thebid = split(/\[\]/,$bid); $bidtime = localtime($thebid[3]); print "$thebid[0] \($bidtime\) - \$$thebid[2]
"; } if ((time > $ARGV[1]) && (time > (60 * $aftermin + $thebid[3]))) { print "BIDDING IS NOW CLOSED
"; &closeit; } else { &placebid; } } ############################################## # Sub: Place Bid on Item # This allows a user to place a new bid on # something. sub placebid { $lowbid = &parsebid($lastbid[2] + $inc); print <<"EOF";
Place A Bid
The High Bid Is: \$$lastbid[2]
The Lowest You May Bid Is: \$$lowbid

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 ($regdir eq "") { 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 } else { 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 } print <<"EOF"; EOF } ############################################## # Sub: Process Bid # This processes new bids from a posted form sub procbid { if (($regdir ne "") && !($newbidflag)) { $form{'ALIAS'} =~ s/\W//g; $form{'ALIAS'} = lc($form{'ALIAS'}); $form{'ALIAS'} = ucfirst($form{'ALIAS'}); &oops('ALIAS') unless (open(REGFILE, "$basepath$regdir/$form{'ALIAS'}.dat")); ($password, $form{'EMAIL'}, $form{'ADDRESS1'}, $form{'ADDRESS2'}, $form{'ADDRESS3'}, @userbids) = ; close REGFILE; chomp($password, $form{'EMAIL'}, $form{'ADDRESS1'}, $form{'ADDRESS2'}, $form{'ADDRESS3'}, @userbids); &oops('PASSWORD') unless ((lc $password) eq (lc $form{'PASSWORD'})); } &oops('ALIAS') unless ($form{'ALIAS'}); &oops('EMAIL') unless ($form{'EMAIL'} =~ /.+\@.+/); &oops('BID') unless ($form{'BID'} =~ /^(\d+\.?\d*|\.\d+)$/); $form{'BID'} = &parsebid($form{'BID'}); &oops('ADDRESS1') unless ($form{'ADDRESS1'}); &oops('ADDRESS2') unless ($form{'ADDRESS2'}); &oops('ADDRESS3') unless ($form{'ADDRESS3'}); $timenum = time; $thetime = localtime(time); &oops('ITEM') unless (open ITEM, "$basepath$form{'CATEGORY'}/$form{'ITEM'}.dat"); ($title, $reserve, $inc, $desc, $image, @bids) = ; close ITEM; chomp($title, $reserve, $inc, $desc, $image, @bids); @lastbid = split(/\[\]/,$bids[$#bids]); if ((((time <= $form{'ITEM'}) || (time <= (60 * $aftermin + $lastbid[3]))) && ($form{'BID'} >= $lastbid[2] + $inc)) || ($newbidflag == 1)) { &oops('ITEM') unless (open NEWITEM, ">>$basepath$form{'CATEGORY'}/$form{'ITEM'}.dat"); &filelock if ($flock); print NEWITEM "\n$form{'ALIAS'}\[\]$form{'EMAIL'}\[\]$form{'BID'}\[\]$timenum\[\]$form{'ADDRESS1'}\[\]$form{'ADDRESS2'}\[\]$form{'ADDRESS3'}"; close NEWITEM; print "$form{'ALIAS'}, your bid has been placed on item number $form{'ITEM'} for \$$form{'BID'} on $thetime.
You may want to print this notice as confirmation of your bid.

Go back to the item\n"; $flag=0; foreach $userbid(@userbids) { $flag=1 if ("$form{'CATEGORY'}$form{'ITEM'}" eq $userbid); } if ($flag==0 && $regdir ne "") { &oops('ALIAS') unless (open(REGFILE, ">>$basepath$regdir/$form{'ALIAS'}.dat")); print REGFILE "\n$form{'CATEGORY'}$form{'ITEM'}"; close REGFILE; } &sendemail($lastbid[1], 'You\'ve been outbid!', 'nobody', $mailserver, "You have been outbid on $title\! If you want to place a higher bid, please visit\:\n\n\thttp://$scripturl$ENV{'SCRIPT_NAME'}\?$form{'CATEGORY'}\&$form{'ITEM'}\n\nThe current high bid is \$$form{'BID'}.") if (($newbidflag != 1) && $scripturl); } else { print "Either the auction is closed or your bid is too low.
Hit the back button and reload to get the latest auction stats, then try again!\n"; } } ############################################## # Sub: Close Auction # This sets an item's status to closed. sub closeit { if ($ARGV[0] ne $closedir) { # We'll use the @firstbid and @lastbid info defined in &dispitem if ($closedir) { umask(000); # UNIX file permission junk mkdir("$basepath$closedir", 0777) unless (-d "$basepath$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("$basepath$ARGV[0]/$ARGV[1].dat", "$basepath$closedir/$ARGV[0]$ARGV[1].dat"); } else { print "Please notify the site admin that this item cannot be removed even though it is closed.\n" unless unlink("$basepath$ARGV[0]/$ARGV[1].dat"); } if ($lastbid[2] >= $reserve) { &sendemail($lastbid[1], "Auction Close: $title", $firstbid[1], $mailserver, "Congratulations! You are the winner of auction number $ARGV[1].\nYour winning bid was \$$lastbid[2].\n\nPlease contact the seller to make arrangements for payment and shipping:\n\n$firstbid[4]\n$firstbid[5]\n$firstbid[6]\n$firstbid[1]\n\nThanks for using EveryAuction!"); } else { &sendemail($lastbid[1], "Auction Close: $title", $firstbid[1], $mailserver, "Congratulations! You were the high bidder on auction number $ARGV[1].\nYour bid was \$$lastbid[2].\n\nUnfortunately, your bid did not meet the seller\'s reserve price...\n\nYou may still wish to contact the seller to negotiate a fair price:\n\n$firstbid[4]\n$firstbid[5]\n$firstbid[6]\n$firstbid[1]\n\nThanks for using EveryAuction!"); } &sendemail($firstbid[1], "Auction Close: $title", $lastbid[1], $mailserver, "Auction Number $ARGV[1] Is Now Closed.\nThe high bid was \$$lastbid[2] (Your reserve was: \$$reserve).\n\nPlease contact the high bidder to make any necessary arrangements:\n\n$lastbid[4]\n$lastbid[5]\n$lastbid[6]\n$lastbid[1]\n\nThanks for using EveryAuction!"); } } ############################################## # Sub: Remove Item # This removes an item from the auction # database. sub remitem { if ($ARGV[3] eq $adminpass) { if (unlink("$basepath$ARGV[0]/$ARGV[1].dat")) { print "File Successfully Removed!\n"; } else { print "File Could Not Be Removed!\n"; } } else { print "Sorry... Incorrect administrator password for delete!\n"; } } ############################################## # Sub: Add New Item # This allows a new item to be put up for sale sub newitem { $inc = "1.00"; if ($form{'REPOST'}) { if (open (THEFILE, "$basepath$closedir/$form{'REPOST'}.dat")) { ($title, $reserve, $inc, $desc, $image, @bids) = ; $title =~ s/\"//g; # quotes cause problems for a text input field close THEFILE; } } 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 ($regdir eq "") { 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 } else { 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 } print <<"EOF";

EOF } ############################################## # Sub: Preview # This displays items before they are posted. sub preview { $nowtime = localtime(time); $closetime = localtime($form{'ITEM'}); $image = "" if ($form{'IMAGE'}); print "

$form{'TITLE'} PREVIEW

Information
\n"; print "$image
$form{'TITLE'}
Category: $category{$form{'CATEGORY'}}
Offered By: $form{'ALIAS'}
Current Time: $nowtime
Closes: $closetime
Or $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"; foreach $key (keys %form) { $form{$key} =~ s/\>/\[greaterthansign\]/gs; $form{$key} =~ s/\\n"; } print "
\n"; } ############################################## # Sub: Process New Item # This processes new item to be put up for # sale from a posted form sub procnew { if ($regdir ne "") { $form{'ALIAS'} =~ s/\W//g; $form{'ALIAS'} = lc($form{'ALIAS'}); $form{'ALIAS'} = ucfirst($form{'ALIAS'}); &oops('ALIAS') unless (open(REGFILE, "$basepath$regdir/$form{'ALIAS'}.dat")); ($password, $form{'EMAIL'}, $form{'ADDRESS1'}, $form{'ADDRESS2'}, $form{'ADDRESS3'}, @userbids) = ; close REGFILE; chomp($password, $form{'EMAIL'}, $form{'ADDRESS1'}, $form{'ADDRESS2'}, $form{'ADDRESS3'}, @userbids); &oops('PASSWORD') unless ((lc $password) eq (lc $form{'PASSWORD'})); } &oops('TITLE') unless ($form{'TITLE'} && (length($form{'TITLE'}) < 51)); $form{'TITLE'} =~ s/\/\>\;/g; &oops('CATEGORY') unless (-d "$basepath$form{'CATEGORY'}"); $form{'IMAGE'} = "" if ($form{'IMAGE'} eq "http://"); &oops('DAYS') unless (($form{'DAYS'} > 0) && ($form{'DAYS'} < 15)); &oops('DESC') unless ($form{'DESC'}); &oops('ALIAS') unless ($form{'ALIAS'}); &oops('EMAIL') unless ($form{'EMAIL'} =~ /.+\@.+/); &oops('BID') unless ($form{'BID'} =~ /^(\d+\.?\d*|\.\d+)$/); &oops('INC') unless (($form{'INC'} =~ /^(\d+\.?\d*|\.\d+)$/) && ($form{'INC'} >= .01)); $form{'INC'} = &parsebid($form{'INC'}); $form{'RESERVE'} = &parsebid($form{'RESERVE'}); &oops('ADDRESS1') unless ($form{'ADDRESS1'}); &oops('ADDRESS2') unless ($form{'ADDRESS2'}); &oops('ADDRESS3') unless ($form{'ADDRESS3'}); $form{'ITEM'} = ($form{'DAYS'} * 86400 + time); $form{'ITEM'} = ($form{'DAYS'} * 86400 + time) until (!(-f "$basepath$form{'CATEGORY'}/$form{'ITEM'}.dat")); if ($form{'FROMPREVIEW'}) { foreach $key (keys %form) { $form{$key} =~ s/\[greaterthansign\]/\>/gs; $form{$key} =~ s/\[lessthansign\]/\$basepath$form{'CATEGORY'}/$form{'ITEM'}.dat")); print NEWAUCTION "$form{'TITLE'}\n$form{'RESERVE'}\n$form{'INC'}\n$form{'DESC'}\n$form{'IMAGE'}"; close NEWAUCTION; print "

$form{'TITLE'} was posted under $category{$form{'CATEGORY'}}...

\n"; $newbidflag=1; &procbid; } else { &preview; } } ############################################## # Sub: Process Search # This displays search results sub procsearch { print "

Search Results - $form{'searchstring'}

"; print "\n"; print "\n"; foreach $key (sort keys %category) { opendir THEDIR, "$basepath$key" || die "Unable to open directory: $!"; @allfiles = readdir THEDIR; closedir THEDIR; foreach $file (sort { int($a) <=> int($b) } @allfiles) { if (-T "$basepath$key/$file") { open THEFILE, "$basepath$key/$file"; ($title, $reserve, $inc, $desc, $image, @bids) = ; close THEFILE; chomp($title, $reserve, $inc, $desc, $image, @bids); @lastbid = split(/\[\]/,$bids[$#bids]); $file =~ s/\.dat//; @closetime = localtime($file); $closetime[4]++; if($form{'searchtype'} eq 'keyword') { print "\n" if (($title =~ /$form{'searchstring'}/i) || ($desc =~ /$form{'searchstring'}/i)); } elsif($form{'searchtype'} eq 'username') { $flag=0; foreach $bid(@bids) { if (($bid =~ /$form{'searchstring'}/i) && ($flag==0)) { print "\n"; $flag=1; } } } } } } print "
ItemClosesNum BidsHigh Bid
$key\: $title$closetime[4]/$closetime[3]$#bids\$$lastbid[2]
$key\: $title$closetime[4]/$closetime[3]$#bids\$$lastbid[2]
\n"; } ############################################## # Sub: Change Registration # This allows a user to change information sub changereg { 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 ($regdir) { &oops('ALIAS') unless ($form{'ALIAS'}); &oops('OLD PASSWORD') unless ($form{'OLDPASS'}); if ($form{'ADDRESS1'}) { &oops('ADDRESS2') unless ($form{'ADDRESS2'}); &oops('ADDRESS3') unless ($form{'ADDRESS3'}); } if ($form{'NEWPASS1'}) { &oops('NEW PASSWORD VERIFICATION') unless ($form{'NEWPASS2'} eq $form{'NEWPASS1'}); } $form{'ALIAS'} =~ s/\W//g; $form{'ALIAS'} = lc($form{'ALIAS'}); $form{'ALIAS'} = ucfirst($form{'ALIAS'}); if (-f "$basepath$regdir/$form{'ALIAS'}.dat") { &oops('ALIAS') unless (open(REGFILE, "$basepath$regdir/$form{'ALIAS'}.dat")); ($password,$email,$add1,$add2,$add3,@junk) = ; chomp($password,$email,$add1,$add2,$add3,@junk); close REGFILE; &oops('OLD PASSWORD') 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('ALIAS') unless (open NEWREG, ">$basepath$regdir/$form{'ALIAS'}.dat"); print NEWREG "$form{'NEWPASS1'}\n$email\n$form{'ADDRESS1'}\n$form{'ADDRESS2'}\n$form{'ADDRESS3'}"; foreach $bid (@junk) { 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 newreg { 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 ($regdir) { umask(000); # UNIX file permission junk mkdir("$basepath$regdir", 0777) unless (-d "$basepath$regdir"); &oops('ALIAS') unless ($form{'ALIAS'}); &oops('EMAIL') unless ($form{'EMAIL'} =~ /.+\@.+/); &oops('ADDRESS1') unless ($form{'ADDRESS1'}); &oops('ADDRESS2') unless ($form{'ADDRESS2'}); &oops('ADDRESS3') unless ($form{'ADDRESS3'}); $form{'ALIAS'} =~ s/\W//g; $form{'ALIAS'} = lc($form{'ALIAS'}); $form{'ALIAS'} = ucfirst($form{'ALIAS'}); if (!(-f "$basepath$regdir/$form{'ALIAS'}.dat")) { &oops('NEWREG') unless (open NEWREG, ">$basepath$regdir/$form{'ALIAS'}.dat"); $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'}, 'Auction Password', 'nobody', $mailserver, "PLEASE DO NOT REPLY TO THIS E-MAIL.\n\nThank you for registering to use our auction!\n\nYour new password is: $newpass\nYour alias (as you entered it) is: $form{'ALIAS'}\n\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: Random Password # This generates psudo-random 8-letter # passwords sub randompass { srand(time ^ $$); @passset = ('a'..'k', 'm'..'n', 'p'..'z', '2'..'9'); $randpass = ""; for ($i = 0; $i < 8; $i++) { $randum_num = int(rand($#passset + 1)); $randpass .= $passset[$randum_num]; } return $randpass; } ############################################## # Sub: parse bid # This formats a bid amount to look good... # ie. $###.## sub parsebid { $_[0] =~ s/\,//g; @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 "Something is wrong with the $_[0] field. Hit back to try again!\n"; die "Something is wrong with the $_[0] field. Hit back to try again!\n"; } ############################################## # Sub: Movefile(file1, file2) # This moves a file. Quick and dirty! sub movefile { ($firstfile, $secondfile) = @_; return 0 unless open(FIRSTFILE,$firstfile); @lines=; close FIRSTFILE; return 0 unless open(SECONDFILE,">$secondfile"); foreach $line (@lines) { print SECONDFILE $line; } close SECONDFILE; return 0 unless unlink($firstfile); return 1; } ############################################## # 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, Reply-To, IP ADDRESS of SMTP host, Message) sub sendemail { use Socket; $TO=$_[0]; @TO=split('\0',$TO); $SUBJECT=$_[1]; $REPLYTO=$_[2]; $REMOTE = $_[3]; $THEMESSAGE = $_[4]; if ($REMOTE =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) { $addr = pack('C4', $1, $2, $3, $4); } else { die("Bad IP address: $!"); } $port = 25 unless $port; $port = getservbyname($port,'tcp') if $port =~ /\D/; $proto = getprotobyname('tcp'); socket(S, PF_INET, SOCK_STREAM, $proto) or die("Socket failed: $!"); $sockaddr = 'S n a4 x8'; # shouldn't this be in Socket.pm? connect(S, pack($sockaddr, AF_INET, $port, $addr)) or die("Unable to connect: $!"); select(S); $| = 1; select(STDOUT); $a=; print S "HELO ${SERVERNAME}\n"; $a=; print S "MAIL FROM:\n"; $a=; print S "RCPT TO:<$TO[0]>\n"; $a=; if ($#TO > 0) { foreach (1..$#TO) { print S "RCPT TO: $TO[$_]\n";$a=; } } print S "DATA \n"; $a=; print S "To: $TO[0]\n"; if ($#TO > 0) { foreach (1..$#TO) { print S "Cc: $TO[$_]\n"; } } print S "Subject: $SUBJECT\n"; print S "Reply-To: $REPLYTO\n"; # Print the body print S "$THEMESSAGE\n"; print S ".\n"; $a=; print S "QUIT"; close (S); } ############################################## # Sub: Get Form Data # This gets data from a post. sub get_form_data { $buffer = ""; read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); @pairs=split(/&/,$buffer); foreach $pair (@pairs) { @a = split(/=/,$pair); $name=$a[0]; $value=$a[1]; $value =~ s/\+/ /g; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $value =~ s/~!/ ~!/g; $value =~ s/[\n\r]/ /sg; #remove \n $value =~ s/\[\]//g; #remove [] push (@data,$name); push (@data, $value); } %form=@data; %form; } ############################################## # Sub: Closed items # This displays closed items sub viewclosed { 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 1 # This displays closed items sub viewclosed1 { $form{'ALIAS'} =~ s/\W//g; $form{'ALIAS'} = lc($form{'ALIAS'}); $form{'ALIAS'} = ucfirst($form{'ALIAS'}); &oops('ALIAS') unless (open(REGFILE, "$basepath$regdir/$form{'ALIAS'}.dat")); ($password,$email,$add1,$add2,$add3,@junk) = ; chomp($password,$email,$add1,$add2,$add3,@junk); close REGFILE; &oops('PASSWORD') unless ((lc $password) eq (lc $form{'PASSWORD'})); print "\n"; print "
\n"; } ############################################## # Sub: Closed items 2 # This displays closed items sub viewclosed2 { $form{'bidtoview'} =~ s/\W//g; open (THEFILE, "$basepath$closedir/$form{'bidtoview'}.dat") or &oops('ITEM'); ($title, $reserve, $inc, $desc, $image, @bids) = ; close THEFILE; chomp($title, $reserve, $inc, $desc, $image, @bids); @firstbid = split(/\[\]/,$bids[0]); @lastbid = split(/\[\]/,$bids[$#bids]); print "

$title

\n"; print "
Description
$desc"; print "
Bid History
\n"; print "START: "; foreach $bid (@bids) { @thebid = split(/\[\]/,$bid); $bidtime = localtime($thebid[3]); print "$thebid[0] \($bidtime\) - \$$thebid[2]
\n"; } print "

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

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

\n"; print "Buyer Information:
Alias: $lastbid[0]
E-Mail: $lastbid[1]
Address: $lastbid[4]
$lastbid[5]
$lastbid[6]

High Bid: \$$lastbid[2]\n"; print "

Unsuccessful Bid Contacts:
\n"; foreach $bid (@bids) { @thebid = split(/\[\]/,$bid); print "$thebid[0] - $thebid[1]
\n"; } print "

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

\n"; print "Seller Information:
Alias: $firstbid[0]
E-Mail: $firstbid[1]
Address: $firstbid[4]
$firstbid[5]
$firstbid[6]

Your High Bid: \$$lastbid[2]

\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: File Lock # This locks files when bidding takes place sub filelock { flock (NEWITEM, 2); seek(NEWITEM, 0, 2); }