米ソニー、オンラインショップ

システムトラブル

http://slashdot.jp/~NurseAngel/journal/530511

大丈夫かいな

#!/usr/bin/perl

umask(02);

use CGI;

# Setting Security for the script
$CGI::POST_MAX=1024 * 100; # max 100K posts
$CGI::DISABLE_UPLOADS = 1; # no uploads

# Setting Global Variables
$| = 1;
$dbPath = "/w1/htmldocs/shared/santa/dbs/";
$templatePath = "/w1/htmldocs/shared/santa/templates/";
$mailprog = "/usr/lib/sendmail";
$wishlistHome ="/santa/";

#print "Content-type: text/html\n\n";

$query = new CGI;

%form = $query->Vars;
$action = $query->url_param('action');
$form{'model'} = $form{'model'} || $query->url_param('model');
$form{'list'} = $form{'list'} || $query->url_param('list');

if($action eq "login") {
if(&login($query, $form{email}, $form{password})) {
&setCookie($query, $form{email});
&selectList($query, $form{'email'}, "", $form{'model'});
} else {
$form{'error'} = 1;
&showPage("${templatePath}login.html", $query, "content", %form);
}
} elsif($action eq "register") {
if($form{'error'} = &validateForm($query, %form)) {
&showPage("${templatePath}register.html", $query, "content", %form);
} else {
if($form{'age'} > 13) {
&createAccount($query, %form);
&recordSweepStake(%form) if $form{'sweepstake'};
&setCookie($query, $form{'email'});
&selectList($query, $form{'email'}, "", $form{'model'});
} else {
dbmopen(%MINOR, "${dbPath}.minor", 0664)
|| &error("minor", "can't create minor database");
$MINOR{$form{'email'}} = $form{'age'};
dbmclose(%MINOR);
&showPage("${templatePath}minor.html", $query, "content", %form);
}
}
} elsif($action eq "showreg") {
&showPage("${templatePath}register.html", $query, "content", %form);
} elsif($action eq "santa") {
&showSanta($query, $form{'u'}, $form{'l'}, $form{'s'});
} elsif($action eq "buy") {
$products = join("~", ($form{'id1'}, $form{'id2'}, $form{'id3'}, $form{'id4'}, $form{'id5'}, $form{'id6'}, $form{'id7'}, $form{'id8'}, $form{'id9'}, $form{'id10'}));
$products =~ s/~+/~/g;
$products =~ s/~$//g;
print "Status: 302\n";
print "Location: http://sh1.yahoo.com/rmi/http://www.sonystyle.com/rmi-product-url/http://www.sonystyle.com/compass.santa.html?prodids=$products\n\n";
} else {
$user = $query->cookie('wishlistID');
if($user) {
my(%_U);
dbmopen(%_U, "${dbPath}.accounts", undef)
|| &error("other", $q, "Can't read golbal accounts database\n");
unless(defined($_U{$user})) {
dbmclose(%_U);
&setCookie($query, "", "now");
&showPage("${templatePath}login.html", $query, "", %form);
exit 0;
}
dbmclose(%_U);
} else {
&showPage("${templatePath}login.html", $query, "content", %form);
exit 0;
}

if($action eq "add") {
if($form{'choose.x'}) {
&add($query, $user, $form{'model'}, $form{'list'}) if $form{'model'};
&showListContent($query, $user, $form{'list'}, "content");
} elsif($form{'delete.x'}) {
&deleteList($query, $user, $form{'list'});
&selectList($query, $user, "", $form{'model'}, "content");
} else {
print "Status: 302\n";
print "LOCATION: $wishlistHome\n\n";
}
} elsif($action eq "create") {
my(%LISTS, $list, $count);
dbmopen(%LISTS, "$dbPath$user.lists", 0664)
|| &error("create list", $query, "Can't write to lists for $user");
$LISTS{$form{'wishlist'}} = $LISTS{$form{'wishlist'}};
$count = 0;
foreach $list (keys(%LISTS)) {
$count ++;
last if $count > 1;
}
dbmclose(%LISTS);
if($form{'model'} and $count == 1) {
&add($query, $user, $form{'model'}, $form{'wishlist'});
&showListContent($query, $user, $form{'wishlist'}, "content");
} else {
&selectList($query, $user, $form{'wishlist'}, $form{'model'}, "content");
}
} elsif($action eq "selectlist") {
my(%LISTS, $list, $count);
dbmopen(%LISTS, "$dbPath$user.lists", 0664)
|| &error("select list", $query, "Can't read lists for $user");
$count = 0;
foreach $key (keys(%LISTS)) {
$count ++;
$list = $key;
last if $count > 1;
}
dbmclose(%LISTS);
if($form{'model'} and $count == 1) {
&add($query, $user, $form{'model'}, $list);
&showListContent($query, $user, $list, "content");
} else {
&selectList($query, $user, "", $form{'model'}, "content");
}
} elsif($action eq "deleteitem") {
&deleteItem($query, $user, $form{'model'}, $form{'list'});
&showListContent($query, $user, $list, "content");
} elsif($action eq "mail") {
&mailSanta($query, $user, %form);
&showPage("${templatePath}thankyou.html", $query, "content");
} else {
&showListContent($query, $user, $form{'list'}, "content");
}
}
#&debug();

sub debug {
my $user = $query->cookie('wishlistID');
print "

Action is $action and user is $user

\n";
foreach $key (keys(%form)) {
print "form $key has val $form{$key}
\n";
}
print "
\n";
foreach $key (keys(%ENV)) {
print "$key has val $ENV{$key}
\n";
}
}

sub showListContent {
my($q, $u, $l, $head) = @_;
my(%LISTS, %d, $list, $content, @products, %PRODUCTS);
if(-e "$dbPath$u.lists.dir") {
dbmopen(%LISTS, "$dbPath$u.lists", undef)
|| &error("showListContent", $q, "Can't read from lists for $u");
foreach $list (sort keys(%LISTS)) {
$l = $list unless $l;
if($l eq $list) {
$d{'lists'} .= "";
$content = $LISTS{$l};
} else {
$d{'lists'} .= "";
}
}
$d{'list'} = $l;
dbmclose(%LISTS);
&showPage("${templatePath}wishlist.head.html", $q, $head, %d);
dbmopen(%PRODUCTS, "${dbPath}.products", undef)
|| &error("showListContent", $q, "Can't read product lists");
@products = split(/ # /, $content);
foreach $content (@products) {
$d{'img'} = $d{'model'} = $content;
($d{'id'}, $d{'price'}, $d{'name'}, $d{'link'}) = split(/ # /, $PRODUCTS{$content});
$d{'price'} = "\$$d{'price'}";
$d{'img'} =~ s/\///g;
&showPage("${templatePath}wishlist.loop.html", $q, "", %d);
}
dbmclose(%PRODUCTS);
&showPage("${templatePath}wishlist.foot.html", $q, "", %d);
} else {
&selectList($q, $u, $l, "", $head);
}
}

sub deleteList {
my($q, $user, $mylist) = @_;
my(%_LISTS);

dbmopen(%_LISTS, "${dbPath}$user.lists", 0664)
|| &error("add", $q, "Can't add $i to list $w for $u");
delete($_LISTS{$mylist});
dbmclose(%_LISTS);
}

sub selectList {
my($q, $user, $mylist, $item, $content) = @_;
my(%d);

$d{'model'} = $item;
if(-e "$dbPath$user.lists.dir") {
my(%LISTS, $list);
dbmopen(%LISTS, "$dbPath$user.lists", undef)
|| &error("selectlist", $q, "Can't read from lists for $user");
foreach $list (sort keys(%LISTS)) {
if($mylist eq $list) {
$d{'lists'} .= "";
} else {
$d{'lists'} .= "";
}

}
dbmclose(%LISTS);
&showPage("${templatePath}selectlist.head.html", $q, $content, %d);
if($d{'lists'}) {
&showPage("${templatePath}selectlist.havelist.html", $q, "", %d);
} else {
&showPage("${templatePath}selectlist.blank.html", $q, "", %d);
}
} else {
&showPage("${templatePath}selectlist.head.html", $q, $content, %d);
&showPage("${templatePath}selectlist.blank.html", $q, "", %d);
}
&showPage("${templatePath}selectlist.foot.html", $q);
}

sub add {
my($q, $u, $i, $wishlist) = @_;
my(%_LISTS);

dbmopen(%_LISTS, "${dbPath}$u.lists", 0664)
|| &error("add", $q, "Can't add $i to list $wishlist for $u");
if($_LISTS{$wishlist} !~ /$i/) {
$_LISTS{$wishlist} = join(" # ", (split(/ # /, $_LISTS{$wishlist}), $i));
}
dbmclose(%_LISTS);
}

sub deleteItem {
my($q, $u, $i, $w) = @_;
my(%_LISTS);

dbmopen(%_LISTS, "${dbPath}$u.lists", 0664)
|| &error("add", $q, "Can't add $i to list $w for $u");
if($_LISTS{$w} =~ /$i/) {
$_LISTS{$w} =~ s/$i//g;
$_LISTS{$w} =~ s/( # )+/$1/g;
$_LISTS{$w} =~ s/^ # //g;
$_LISTS{$w} = "" if $_LISTS{$w} eq " # ";
}
dbmclose(%_LISTS);
}

sub setCookie {
my($q, $_id) = @_;
my $cookie = $q->cookie(-name=>'wishlistID',
-value=>$_id,
-secure=>0);
print $q->header(-cookie=>$cookie);
}

sub login {
my($q, $_id, $_pw) = @_;
my(%_U);
if(-e "${dbPath}.accounts") {
dbmopen(%_U, "${dbPath}.accounts", undef)
|| &error("login", $q, "Can't read golbal accounts database\n");
} else {
dbmopen(%_U, "${dbPath}.accounts", 0664)
|| &error("login", $q, "Can't read golbal accounts database\n");
}

if(defined($_U{"\L$_id"}) and ($_U{"\L$_id"} eq $_pw)) {
dbmclose(%_U);
return 1;
} else {
dbmclose(%_U);
return 0;
}
}

sub validateForm {
my($q, %_data) = @_;
my($error) = "";
my($_ACCTS);

# Check for error
$error = "";

if(-e "${dbPath}.minor") {
dbmopen(%_ACCTS, "${dbPath}.minor", undef)
|| &error("validateForm", $q, "Can't read minor database");
} else {
dbmopen(%_ACCTS, "${dbPath}.minor", 0664)
|| &error("validateForm", $q, "Can't create minor database");
}

if(defined($_ACCTS{$_data{'email'}})) {
&showPage("${templatePath}minor.html", $query, "content", %form);
exit 0;
}
dbmclose(%_ACCTS);

if(-e "${dbPath}.accounts") {
dbmopen(%_ACCTS, "${dbPath}.accounts", undef)
|| &error("validateForm", $q, "Can't read accounts database");
} else {
dbmopen(%_ACCTS, "${dbPath}.accounts", 0664)
|| &error("validateForm", $q, "Can't create accounts database");
}

if(defined($_ACCTS{$_data{'email'}})) {
$error .= "

  • Account with email address $_data{'email'} already exits
    • ";
    }
    dbmclose(%_ACCTS);

    if(&pit($_data{'email'})) {
    $error .= "

  • Invalid Email Address
    • "
    if $_data{'email'} !~ m/\@.+\./;
    } else {
    $error .= "
  • Missing email address
    • ";
    }

    $error .= "

  • Missing Password
    • " unless &pit($_data{'password'});
    $error .= "
  • Missing Confirmation Password
    • " unless &pit($_data{'confirmpassword'});

    if($_data{'password'} ne $_data{'confirmpassword'}) {
    $error .= "

  • Two passwords are different
    • ";
    }

    $error .= "

  • Missing First Name
    • " unless &pit($_data{'firstname'});
    $error .= "
  • Missing Last Name
    • " unless &pit($_data{'lastname'});
    $error .= "
  • Missing Address
    • " unless &pit($_data{'address'});
    $error .= "
  • Missing City
    • " unless &pit($_data{'city'});
    $error .= "
  • Missing State
    • " unless &pit($_data{'state'});
    if(&pit($_data{'state'})) {
    $error .= "
  • Invalid State
    • " if $_data{'state'} !~ m/^[a-zA-Z]{2}/;
    }

    if(&pit($_data{'zip'})) {
    $error .= "

  • Invalid Zip
    • " if $_data{'zip'} !~ m/^\d{5,}/;
    } else {
    $error .= "
  • Missing Zip
    • ";
    }

    return $error;

    }

    sub createAccount {
    my($q, %_info) = @_;
    my(%_ACCTS);
    dbmopen(%_ACCTS, "${dbPath}.accounts", 0664)
    || &error("createAccount", $q, "Can't modify accounts database");
    $_ACCTS{"\L$_info{'email'}"} = $_info{'password'};
    dbmclose(%_ACCTS);
    dbmopen(%_ACCTS, "${dbPath}$_info{'email'}", 0664)
    || &error("createAccount", $q, "Can't create account database for $_infp{'email'}");
    $_ACCTS{'firstname'} = $_info{'firstname'};
    $_ACCTS{'lastname'} = $_info{'lastname'};
    $_ACCTS{'address'} = $_info{'address'};
    $_ACCTS{'address2'} = $_info{'address2'};
    $_ACCTS{'city'} = $_info{'city'};
    $_ACCTS{'state'} = $_info{'state'};
    $_ACCTS{'zip'} = $_info{'zip'};
    $_ACCTS{'sweepstake'} = $_info{'sweepstake'};
    $_ACCTS{'info'} = $_info{'info'};
    $_ACCTS{'age'} = $_info{'age'};
    dbmclose(%_ACCTS);
    }

    sub recordSweepStake {
    my(%_info) = @_;

    my($dataFile) = "${dbPath}sweepstake.xls";
    if(-e $dataFile) {
    open(OUTPUT, ">>$dataFile") || die "can't append to file $dataFile\n";
    } else {
    open(OUTPUT, ">$dataFile") || die "can't append to file $dataFile\n";
    print OUTPUT "First Name\tLast Name\tAddress\tAddress 2\tCity\tState\tZip\tE-mail\tGet Info\n";
    }
    print OUTPUT "$_info{firstname}\t$_info{lastname}\t$_info{address1}\t$_info{address2}\t$_info{city}\t$_info{state}\t$_info{zip}\t$_info{info}\n";
    close(OUTPUT);
    return;
    }

    sub mailSanta {
    my($q, $u, %d) = @_;
    my(%U, %PRODUCTS, @products, %LISTS, $p, $fname);

    dbmopen(%U, "$dbPath$u", undef)
    || &error("mailSanta", $q, "Can't read user info for $u");
    $fname = $U{'firstname'};
    dbmclose(%U);
    open(MAIL, "|$mailprog -t -f$u") || die "cannot send email\n";
    print MAIL "To: $d{'email'}\n";
    print MAIL "Subject: YOU'RE SOMEBODY'S SPECIAL SANTA\n\n";
    print MAIL "YOU'RE SOMEBODY'S SPECIAL SANTA\n\n";
    print MAIL "Hey $d{'santa'}, $fname has chosen YOU as a special Santa this year.\n\n";
    print MAIL "\"That's great\", you might be saying, \"but I don't know what to get!\" Well, $fname has made it easy by creating a Sony Wishlist for you to choose from. It's filled with cool Sony stuff $fname would love to find under the tree.\n\n";

    $d{'list'} =~ s/ /%20/g;
    $d{'santa'} =~ s/ /%20/g;
    print MAIL "Ready to see the list $fname created? Just click below:\n\n";
    print MAIL "http://63.224.30.26$ENV{'SCRIPT_NAME'}?action=santa&u=$u&l=$d{'list'}&s=$d{'santa'}\n\n";

    print MAIL "GET A FREE GIFT FROM SONYSTYLE.COM\n";
    print MAIL "We at Sonystyle.com are doing our part to make your holiday shopping easy, too! When you spend \$300 on items found on the Wishlist, you'll get a free thank you gift from Sony.\n\n";

    print MAIL "To get your free gift, click below to download a special coupon:\n";
    print MAIL "http://promo.iq.com/common/e.jsp?vgid=22927&p=DI&e=1&ref=IQREPLACETEXT\n\n";

    print MAIL "So make $fname happy, and you'll receive a free thank you gift from Sony for being such a good Santa.\n\n";

    print MAIL "Happy Holidays from $fname, Sony, and Sonystyle.com!\n\n";
    close(MAIL);

    open(MSG, ">$dbPath$u.$d{'list'}$d{'santa'}.txt")
    || &error("mailSanta", $q, "Can't save message to $d{'santa'} from $u with list $d{'list'}");
    $d{'message'} =~ s/\n/
    /g;
    print MSG "$d{'message'}\n";
    close(MSG);
    #print MAIL "------------------------------------------------------------\n";
    #dbmopen(%LISTS, "$dbPath$u.lists", undef)
    #|| &error("mailSanta", $q, "Can't read from lists for $u");
    #@products = split(/ # /, $LISTS{$d{'list'}});
    #dbmclose(%LISTS);
    #dbmopen(%PRODUCTS, "${dbPath}.products", undef)
    #|| &error("mailSanta", $q, "Can't read product lists");
    #foreach $p (@products) {
    #my($price, $name) = split(/ # /, $PRODUCTS{$p});
    #print MAIL "$p\t\t\$$price\t\t$name\n";
    #}
    #dbmclose(%PRODUCTS);
    #print MAIL "------------------------------------------------------------\n";
    }

    sub error {
    my($q, $_where, $_msg) = @_;

    my(%d);
    $d{'where'} = $_where;
    $d{'msg'} = $_msg;

    &showPage("${templatePath}error.html", $q, "", "content", %d);
    exit 0;
    }

    sub showSanta {
    my($q, $u, $l, $s) = @_;
    my(%detail, %L, %U, @products);

    $detail{'message'} = "Dear $s:

    ";
    $l =~ s/ /%20/g;
    $s =~ s/ /%20/g;
    open(MSG, "$dbPath$u.$l$s.txt")
    || &error("showSanta", $q, "Can't read message to $s from $u with list $l");
    while() {
    $detail{'message'} .= $_
    }
    close(MSG);
    dbmopen(%U, "$dbPath$u", undef) || &error("showSanta", $q, "can't read user information for $u");
    $detail{'message'} .= "

    From $U{'firstname'} $U{'lastname'}";
    dbmclose(%U);
    &showPage("${templatePath}santa.head.html", $q, "content", %detail);

    $l =~ s/%20/ /g;
    dbmopen(%L, "$dbPath$u.lists", undef) || &error("showSanta", $q, "can't read list content for $u");
    @products = split(/ # /, $L{$l});
    dbmclose(%L);

    dbmopen(%L, "${dbPath}.products", undef) || &error("showSanta", $q, "can't read products");

    $detail{i} = 1;
    foreach $content (@products) {
    $detail{'img'} = $detail{'model'} = $content;
    ($detail{'id'}, $detail{'price'}, $detail{'name'}, $detail{'link'}) = split(/ # /, $L{$content});
    $detail{'price'} = "\$$detail{'price'}";
    if($detail{'link'} =~ /\/(\w+)\.html/) {
    $detail{'link'} = "$`/productinfo/${1}2.html";
    }
    $detail{'img'} =~ s/\///g;
    &showPage("${templatePath}santa.loop.html", $q, "", %detail);
    $detail{i}++;
    }
    dbmclose(%L);


    &showPage("${templatePath}santa.foot.html", $q, "", %detail);
    }

    sub showPage {
    my($template, $q, $content, %Form) = @_;
    my(@input, $i);
    local(*_MYINPUT);

    if($content) {
    print "Content-type: text/html\n\n";
    }

    open(_MYINPUT, $template) || die "can't read from $template\n";
    while(<_MYINPUT>) {
    $input[$i] = $_;
    $i++;
    }
    close(_MYINPUT);

    for($i=0; $i<@input; $i++) {
    &processLine($input[$i], %Form);
    }
    }

    sub processLine {
    my($inputline, %Form) = @_;
    my($condition, $then, $else, $line);
    my($begin, $end, $pitline);

    $inputline =~ s/REPLACEME/$wishlistHome/g;

    if ($inputline =~ m//) {

    $begin = $`;
    $end = $';
    $pitline = $1;
    if ($pitline =~ /\? (.*)::/) {
    $condition = $`;
    $then = $1;
    $else = $';
    } elsif ($pitline =~ /\? /) {
    $condition = $`;
    $then = $';
    }

    if ($condition) {
    $condition = &pit($condition);
    $then = &pit($then);
    $else = &pit($else) if $else;
    if (&evalCond($condition, %Form)) {
    $line = $then;
    } elsif ($else) {
    $line = $else;
    }

    $line =~ s/\$((\w|\d|-)+)/$Form{$1}/g;
    print "$begin$line$end";
    } else {
    $pitline = &pit($pitline);
    $pitline =~ s/\$((\w|\d|-)+)/$Form{$1}/g;
    print "$begin$pitline$end";
    }
    } else {
    print $inputline;
    }
    }

    sub evalCond {
    my($condition, %Form) = @_;
    my(@temp, $index);

    @temp = split(/ /, $condition);
    for($index=0; $temp[$index]; $index++) {
    $temp[$index] =~ s/\$((\w|\d|-)+)/\$Form{'$1'}/g;
    }
    $condition = join(" ", @temp);

    return eval $condition;
    }

    sub pit {
    local($pit) = @_;
    $pit =~ s/^\s*(.*?)\s*$/$1/;
    return $pit;
    }

    http://products.sel.sony.com/cgi-bin/wishlist

    http://sankei.jp.msn.com/economy/news/110428/biz11042821200074-n1.htm
    http://www.itmedia.co.jp/news/articles/1105/06/news052.html
    http://slashdot.jp/article.pl?sid=11/04/23/0836255
    http://slashdot.jp/article.pl?sid=11/04/28/203216
    http://slashdot.jp/article.pl?sid=11/05/02/0832239