DAN ZEN EXPO - CODE EXHIBIT -
DENS
#!/usr/bin/perl
#roots are sensitive and have been removed for this exhibit
$game = "dens";
$headertype = "b";
$footertype = "bf";
$scriptdir = '/cgi-bin/';
unshift(@INC, $scriptdir); require "template";
&ReadParse;
$command = $in{'command'};
$den = $in{'den'};
$denfile = $den; $denfile =~ s/ /\+/g; $denfile =~ tr/A-Z/a-z/;
$password = $in{'password'};
$entry = $in{'entry'};
$color = $in{'color'};
###archive
$archive = $in{'archive'};
###end of archive
if ($command eq "secret") {
&header3 ("Dens");
&secret;
} elsif ($command eq "open") {
@dens = ();
open (OPEN, $logroot."opendens.txt");
while (<OPEN>) {
@line = split ("\t",$_);
push (@dens, $line[0]);}
close (OPEN);
&header2 ("Dens");
foreach $a (sort(@dens)) {
$b = $a;
$b =~ s/ /\+/g;
print "<a href=densc?den=".$b.">$a</a><p>\n";
}
print "<br><br>";
&footer;
} elsif ($command eq "surprise") {
&header2 ("Dens");
print "<table width=400><tr><td><br><font color=eeeeee>There is a <b>Den</b> available for you through mysterious circumstances. Perhaps the <a href=dencreate?type=secret><font color=ff00ff>Secret Den</font></a> carved into a stalagmite of a deep hidden cavern beneath the Great Wall would be suitable. Invite your friends to tell stories of intrigue or romance. You will have to tell them the <b>Den</b> name and the password.
<p>
Unfortunately, all of the Open Dens are full. The last one was just past the silk curtains of the Ming room. Plato once philosophized with Valentino in this <b>Den</b>.
</td></tr></table><br><br>";
&footer;
} elsif ($command eq "bats") {
&trainbats;
exit;
} elsif ($command eq "colorcube") {
&setcookie;
}
if ($color eq "") {&getcookie;}
if ($password eq "" && $den ne "") {
$denroot = $logroot."open/";
&trainbats2;
$a = $den;
$a =~ s/ /\+/g;
$aa = $a;
$a =~ tr/A-Z/a-z/;
$file= $logroot."open/".$a.".txt";
###archive
if ($archive ne "") {
$file = $logroot."open/archives/".$archive."_-_".$a.".txt";
&header1 ("$den | Archive $archive");
} else {
###end of archive
# if ($entry ne "") {
# $entry =~ s/\s\n\s?\n/\^\^\^/g;
# $entry =~ s/\s\n/\^\^/g;
# while (open(DEN, ">> $file") < 1) {
# sleep(3);
# $counter++;
# if ($counter > 180) {# 9 minutes
# &header2 ("Lost");
# print "<br><br><h4>either the Den or you is lost</h4><p>Please try again now";
# exit;
# }
# }
# print DEN $entry."\n";
# close (DEN);
# &bats;
# }
&header1 ("$den");
}
$a = $den;
$a =~ s/ /\+/g;
$a =~ tr/A-Z/a-z/;
@memory = ();
open (DEN, $file);
$nocount = 0;
while (<DEN>) {
push (@memory, $_);
if (/Archive/i) {$nocount++;}
}
close (DEN);
###archive
&archive($logroot."open/archives/",$logroot."open/",$a.".txt",$cgiroot."dens");
###end of archive
foreach $a (reverse(@memory)) {
$a =~ s/\^\^\^/<p>/g;
$a =~ s/\^\^/<br>/g;
if ($a =~ /\~([^:]*):([^~< ]*)\~/i) {
$qd = $1;
$qt = $1;
$qp = $2;
$qd =~ s/ /\+/g;
$qp =~ s/ /\+/g;
$qr = "<a href=densc?den=$qd"."\&password=$qp><font color=dddddd>$qt</font></a>";
$a =~ s/\~([^:]*):([^~< ]*)\~/$qr/gi;
}
print "$a <hr>\n";
}
open (FILE, $logroot."opendens.txt");
@dens = <FILE>;
close (FILE);
foreach $a (@dens) {
@line = split ("\t",$a);
$realden = $line[0];
$line[0] =~ tr/A-Z/a-z/;
$line[0] =~ s/ /\+/gi;
if ($line[0] eq $denfile) {
$check = 1;
$d = $line[1];
$d =~ s/\n//g;
$d =~ s/\^\^\^/<p>/g;
$d =~ s/\^\^/<br>/g;
print "<hr><b>$d</b><hr>\n";
last;
}
}
print "
</font></td></tr></table>
</center>
</html>";
exit;
} elsif ($password ne "" && $den ne "") {
$type = "secret";
$a = $den;
$a =~ s/ /\+/g;
$aa = $a;
$a =~ tr/A-Z/a-z/;
$denroot = bleep ;
&trainbats2;
$file = $denroot.$a.".txt";
###archive
if ($archive ne "") {
$file = $denroot."archives/".$archive."_-_".$a.".txt";
&header1 ("$den | Archive $archive");
} else {
###end of archive
if ($entry ne "") {
$entry =~ s/\s\n\s?\n/\^\^\^/g;
$entry =~ s/\s\n/\^\^/g;
while (open(DEN, ">> $file") < 1) {
sleep(3);
$counter++;
if ($counter > 180) {# 9 minutes
&header2 ("Lost");
print "<br><br><h4>either the Den or you is lost</h4><p>Please try again now";
exit;
}
}
print DEN $entry."\n";
close (DEN);
&bats;
}
$d = $den;
$d =~ tr/A-Z/a-z/;
$check == 0;
open (SECRET, $denroot."secretdens.txt");
while (<SECRET>) {
@line = split ("\t",$_);
$realden = $line[0];
$line[0] =~ tr/A-Z/a-z/;
if ($line[0] eq $d) {
$check = 1;
$line[1] =~ s/\n//g;
if ($password ne $line[1]) {
close (SECRET);
&header3 ("Dens");
&secret;
}
last;
}
}
close (SECRET);
if ($check == 0) {
&header3 ("Dens");
&secret;
}
&header1 ("$realden");
}
@memory = ();
open (DEN, $file);
$nocount = 0;
while (<DEN>) {
push (@memory, $_);
if (/Archive/i) {$nocount++;}
}
close (DEN);
###archive
&archive($denroot."archives/",$denroot,$a.".txt",$securecgiroot."dens");
###end of archive
foreach $a (reverse(@memory)) {
$a =~ s/\^\^\^/<p>/g;
$a =~ s/\^\^/<br>/g;
if ($a =~ /\~([^:]*):([^~< ]*)\~/i) {
$qd = $1;
$qd =~ s/ /\+/g;
$qp = $2;
$qp =~ s/ /\+/g;
$qr = "<a href=densc?den=$qd"."\&password=$qp>$1</a>";
$a =~ s/\~([^:]*):([^~< ]*)\~/$qr/gi;
}
print "$a <hr>\n";
}
open (FILE, $denroot."secretdens.txt");
@dens = <FILE>;
close (FILE);
foreach $a (@dens) {
@line = split ("\t",$a);
$realden = $line[0];
$line[0] =~ tr/A-Z/a-z/;
$line[0] =~ s/ /\+/gi;
if ($line[0] eq $denfile) {
$check = 1;
$d = $line[2];
$d =~ s/\n//g;
$d =~ s/\^\^\^/<p>/g;
$d =~ s/\^\^/<br>/g;
print "<hr><b>$d</b><hr>\n";
last;
}
}
print "
</font></td></tr></table>
</center>
</html>";
exit;
}
print "location: http://www.danzen.com/dens/choices.html\n\n";
exit;
sub secret {
print "
<form action=http://www.danzen.com/cgi-bin/densc method=post>
<input type=text name=den><p>
<input type=password name=password><p>
<input type=image NAME=button SRC=/graphics/lips.gif border=0>
</form><br><br>";
&footer;
}
sub header1 {
%bgcolors = ("green","99ff55","white","ffffff","yellow","ffff66","purple","cc99ff","black","000000","orange","ff9933","blue","33ffcc");
if ($color eq "" || $bgcolors{"$color"} eq "") {$color = "black";}
%cubes = ("green","green","white","white","yellow","yellow","purple","purple","black","black","orange","orange","blue","blue");
%cubesgraphic = %cubes;
$cubes{"$color"} = "blue";
$cubesgraphic{"$color"} = "blue/$color";
$green = $cubes{'green'};
local($title) = @_;
print "content-type: text/html\n\n";
if ($den =~ /^gibs/i) {$added5 = "_g";}
print "
<html>
<head><title>\ Dan Zen | Dens | $title\ </title>";
if ($password ne "") {print "<META HTTP-EQUIV=\"Refresh\" CONTENT=\"600;URL=http://www.danzen.com\">";}
print "<style>td,p,body,a {font-family:verdana;}</style></head>
<body bgcolor=".$bgcolors{"$color"}." link=cc0000 alink=cc0000 vlink=cc0000>
<center>
<br><img src=/cgi-bin/traffic_plus?company=danzen&page=dens_read".$added5."><br><center>
<table><tr><td>
<table cellpadding=0 cellspacing=0 border=0><form action=densc method=post>
<form action=densc method=post>
<input type=hidden name=den value=\"$den\">
<input type=hidden name=command value=colorcube>
<input type=hidden name=archive value=$archive>
<input type=hidden name=color value=".$cubes{'green'}.">
<input type=hidden name=password value=\"$password\">
<tr><td><input type=image src=/graphics/dens/cubes/".$cubesgraphic{'green'}.".gif border=0></td></form><form action=densc method=post>
<input type=hidden name=den value=\"$den\">
<input type=hidden name=command value=colorcube>
<input type=hidden name=archive value=$archive>
<input type=hidden name=color value=".$cubes{'white'}.">
<input type=hidden name=password value=\"$password\"><td><input type=image src=/graphics/dens/cubes/".$cubesgraphic{'white'}.".gif border=0></td></form><form action=densc method=post>
<input type=hidden name=den value=\"$den\">
<input type=hidden name=command value=colorcube>
<input type=hidden name=archive value=$archive>
<input type=hidden name=color value=".$cubes{'yellow'}.">
<input type=hidden name=password value=\"$password\"><td><input type=image src=/graphics/dens/cubes/".$cubesgraphic{'yellow'}.".gif border=0></td></tr><tr></form><form action=densc method=post>
<input type=hidden name=den value=\"$den\">
<input type=hidden name=command value=colorcube>
<input type=hidden name=archive value=$archive>
<input type=hidden name=color value=".$cubes{'purple'}.">
<input type=hidden name=password value=\"$password\"><td><input type=image src=/graphics/dens/cubes/".$cubesgraphic{'purple'}.".gif border=0></td></form><form action=densc method=post>
<input type=hidden name=den value=\"$den\">
<input type=hidden name=command value=colorcube>
<input type=hidden name=archive value=$archive>
<input type=hidden name=color value=".$cubes{'black'}.">
<input type=hidden name=password value=\"$password\"><td><input type=image src=/graphics/dens/cubes/".$cubesgraphic{'black'}.".gif border=0></td></form><form action=densc method=post>
<input type=hidden name=den value=\"$den\">
<input type=hidden name=command value=colorcube>
<input type=hidden name=archive value=$archive>
<input type=hidden name=color value=".$cubes{'orange'}.">
<input type=hidden name=password value=\"$password\"><td><input type=image src=/graphics/dens/cubes/".$cubesgraphic{'orange'}.".gif border=0></td></tr></form></table>
</td><td>\ \ \ \ </td><td><a href=http://www.danzen.com/dens/choices.html><img src=/graphics/dens/circles/$color".".gif border=0></a>
</td><td>\ \ </td><form action=densc method=post><td>
<input type=hidden name=command value=bats>
<input type=hidden name=den value=\"$den\">
<input type=hidden name=archive value=$archive>
<input type=hidden name=color value=\"$color\">
<input type=hidden name=password value=\"$password\">
<input type=image name=button SRC=/graphics/dens/bats/$color".".gif border=0>
</td></tr></form></table>
<p>
<form action=densc method=post>
<input type=hidden name=den value=\"$den\">
<input type=hidden name=color value=\"$color\">
<input type=hidden name=password value=\"$password\">
<textarea name=entry rows=4 cols=50 wrap></textarea>
<p>
<input type=image name=button SRC=/graphics/dens/lips/$color".".gif border=0>
<br><!--<font color='white'>Sorry Den Submission Closed</font>-->
</form>
<p>";
if ($color eq "black") {
print "</td></tr></table>\n";
print "<table width=400 border=0><tr><td><font color=dddddd><hr>\n";
} else {
print "</td></tr></table>\n";
print "<table width=400 border=0><tr><td><font color=666666><hr>\n";
}
}
sub header2 {
local($title) = @_;
$title = " | Dens | $title";
#print "content-type: text/html\n\n";
#print "<html><head><title>\ Dan Zen | Dens | $title\ </title></head><body bgcolor=000000 link=99cc33 alink=99cc33 vlink=99cc33>";
&header;
print "<br><br><br><a href=http://www.danzen.com/dens/choices.html><img src=/graphics/circleb.gif border=0></a><p>";
}
sub header3 {
&header;
print "<br><br><a href=http://www.danzen.com/dens/choices.html><img src=/graphics/circleb.gif border=0></a><p>";
}
###archive
sub archive {
#checks to see if chat room list @memory has over $maxlines lines in it
#if it does it puts $desiredlines lines in blimp and rest in archive
local($archiveroot) = @_[0]; #directory where you want to put the archives
local($currentroot) = @_[1]; #current chat directory
local($currentfilename) = @_[2]; #current chat file name
local($script) = @_[3]; #http to script to view chat room
local($maxlines) = 50;
local($desiredlines) = 5;
local($lines) = $#memory+1;
if ($archive > 0 ) {return;}
$flagfile = $currentroot."flag.txt";
if (-e $flagfile) {return;}
if ($lines - $nocount > $maxlines) {
open (FLAG, "> $flagfile");
$currentfile = $currentroot.$currentfilename;
#get number of archives
if (opendir(DIR, $archiveroot)) {
while ($a = readdir(DIR)) {push (@archivenames, $a);}
closedir(DIR);
shift (@archivenames); shift (@archivenames); #get rid of . and .. xxx
local($archivenumber) = 0;
foreach $a (@archivenames) {
local(@line) = split (/_-_/,$a);
if ($line[1] eq $currentfilename) {
if ($line[0] > $archivenumber) {$archivenumber = $line[0];}
}
}
$archive = $archivenumber + 1;
} else {
$archive = 1;
}
local($linesleft) = $lines - $desiredlines;
local(@archive) = ();
local(@newmemory) = ();
for ($i=0; $i < $linesleft; $i++) {
if ($i < ($archive-1)) {
push (@newmemory, $memory[$i]);
} else {
push (@archive, $memory[$i]);
}
}
#special to den because of Den ID and Password
local($currenturl) = "<center><form action=$script method=post><input type=hidden name=den value=\"$aa\"><input type=hidden name=password value=\"$password\"><input type=submit name=submit value=\"Current Den\"></form></center>\n";
push (@archive, $currenturl);
local($archiveurl) = "<center><form action=$script method=post><input type=hidden name=den value=\"$aa\"><input type=hidden name=password value=\"$password\"><input type=hidden name=archive value=$archive><input type=submit name=submit value=\"Archive $archive\"></form></center>\n";
push (@newmemory, $archiveurl);
#end of special
#old
#local($currenturl) = "<center><a href=$script><br><font size=+1>Back to Current Entries</font></b></a></center>\n";
#push (@archive, $currenturl);
#local($archiveurl) = "<center><a href=$script"."\&archive=".$archive."><br><font size=+1>Archive $archive</font></b></a></center>\n";
#push (@newmemory, $archiveurl);
#end of old
for ($i = $linesleft; $i < $lines; $i++) {push (@newmemory, $memory[$i]);}
@memory = @newmemory;
#write new archive file and new current file close flag file
local($archivefile) = $archiveroot.$archive."_-_".$currentfilename;
unless (open (ARCHIVE, "> $archivefile")) {
print "<br><br><br><br><b>Cannot open Archives<p>Please try again or contact <a href=mailto:darkness\@danzen.com>Dan Zen</a></b>";
print "</td></tr></table>";
exit;
}
foreach $a (@archive) {print ARCHIVE $a;}
close (ARCHIVE);
unless (open (CURRENT, "> $currentfile")) {
print "<br><br><br><br><b>Cannot open Current file<p>Please try again or contact <a href=mailto:darkness\@danzen.com>Dan Zen</a></b>";
print "</td></tr></table>";
exit;
}
foreach $a (@memory) {print CURRENT $a;}
close (CURRENT);
close (FLAG);
unlink ($flagfile);
} else {
return;
}
}
###end of archive
sub ReadParse {
#subroutine to read in the variables
#Stefan Powell version
if (@_) {
local (*in) = @_;
}
local ($i, $loc, $key, $val);
# Read in text
if ($ENV{'REQUEST_METHOD'} eq "GET") {
$in = $ENV{'QUERY_STRING'};
} elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
for ($i = 0; $i < $ENV{'CONTENT_LENGTH'}; $i++) {
$in .= getc;
}
}
@in = split(/&/,$in);
foreach $i (0 .. $#in) {
# Convert plus's to spaces
$in[$i] =~ s/\+/ /g;
# Convert %XX from hex numbers to alphanumeric
$in[$i] =~ s/%(..)/pack("c",hex($1))/ge;
# Split into key and value.
$loc = index($in[$i],"=");
$key = substr($in[$i],0,$loc);
$val = substr($in[$i],$loc+1);
$in{$key} .= '\0' if (defined($in{$key})); # \0 is the multiple separator
$in{$key} .= $val;
}
return 1; # just for fun
}
sub bats {
#return;
$batfile = $denroot."bats/$denfile".".txt";
open (BATS, $batfile);
@bats = <BATS>;
close (BATS);
if ($#bats >= 0) {
chop (@bats);
@denmessages = ("\nEEEK!\n\nA bat has tangled in your hair - you see a tag on its foot: \"$den\"","\nSCREEEECH screeeeech!\n\nA black shadow has swept by and dropped a tag: \"$den\"","\neeeep! eeeep! eeeep!\n\nAh ha! One of the Den-master's bats.\n\nWhat's this - it's dropped a note, \"$den\"","\nIn the light of the moon a jagged silhouette is seen.\n\nOh my, it's closer than it seems.\n\nIt's sweeping down on me,\n\nAnd has left a note to see: \"$den\"","\nFlutter - flutter - flutter\n\nAnother bat; another message: \"$den\"","\npeep...peep peep peep...peep...peep peep...peep peep cheep\n\"$den\" is what the bat peeps","\nLook! Above our heads! It's a bat!\n\nWhat's it doing? It's spelling something... \"$den\"","\nI had a dream that a bat visited me in the night...\n\nTell me about it...\n\nIt was very dark, and windy...\n\nYes, please, do go on...\n\nWell, the bat flew down and sat on my shoulder like a parrot.\n\nAnd then?\n\nIt said \"$den\".\n\nAh... did this make you think of your mother?\n\nNo... but I did think of my Aunt Ursula.","\nI hate going up to the Belfry to get these darn notes. \n\nHmmm, this one says, \"$den\".","\nCome on, drop it... I can't read it upside down\n\nI know I woke you up on the job...\n\nThere we are, hmmm, it says, \"$den\"");
@batads = ("Take a whirl with Spirogram","Catch the Salamander","Climb the Tower of Babel","Solve a utopian mystery","Zap yourself with a Teleporter","Seek the Web Ouija","Fly a Gorgolonian Saucer","Play YesUmNo - the voting game","Check out the Daily Danism","Operate the Headline Machine","Are you receiving Telepathy?","Try the Grim Reaper's Age Guesser","Visit the Gallery 2010","Anagram your name with Word Warp","What's next? Prediction Train","Come see the World's Tallest Hat");
srand (time|$$);
$batad = $batads[int(rand($#batads))];
$denmessage = $denmessages[int(rand($#denmessages))]."\n\n___________________________________________________________\nThere is a new message in your Den at http://www.danzen.com\nDan Zen | mind games | $batad\n\nTo unsubscribe, reply with a request to unsubscribe\n\n\n\n";
foreach $b (@bats) {
$_ = $b;
if (/^(.*)\@(.*)$/) {
$batmail = $b; $batmail =~ s/ //gi;
#open (MAIL, "| /usr/sbin/sendmail -t -f denmaster\@danzen.com");
#print MAIL "To: $batmail\nReply-To: denmaster\@danzen.com\nSubject: BATS\nFrom: denmaster\@danzen.com\n\n$denmessage";
#close (MAIL);
}
}
}
}
sub trainbats {
&header2("$den | Messenger Bats");
print"<br>
<font color=ffffff>Enter your email below and the Den Master will train his bats<br>to let you know when there is a new post in this Den</font>
<br><br><form action=densc method=post>
<input type=hidden name=command value=trainbats>
<input type=hidden name=den value=\"$den\">
<input type=hidden name=archive value=$archive>
<input type=hidden name=color value=\"$color\">
<input type=hidden name=password value=\"$password\">
<input type=checkbox checked name=telepathy> <a href=/telepathy.html><font color=ffffff>Receive Telepathy</font></a> <p><input type=text name=email><p>
<input type=image name=button SRC=/graphics/dens/bats/black.gif border=0><p>";
&footer;
}
sub trainbats2 {
if ($command eq "trainbats") {
$email = $in{'email'};
$email =~ s/ //gi;
if ($email ne "") {
if ($in{'telepathy'}) {
$checktelepathy = 0;
open (TELEPATHY, $telepathyroot."telepathy.txt");
while (<TELEPATHY>) {
chop($_);
if (/^$email$/i) {$checktelepathy = 1; last;}
}
close (TELEPATHY);
if ($checktelepathy == 0) {
open (TELEPATHY, ">> $telepathyroot"."telepathy.txt");
print TELEPATHY $email."\n";
close (TELEPATHY);
}
}
$_ = $email;
unless (/^(.*)\@(.*)$/) {
&header2 ("Email Error");
print "<br><font color=ffffff>Your email address appears invalid<br>The Den Master cannot train the bats<p>Please go back and try again<p>";
exit;
}
$b = $den;
$b =~ s/ /\+/g;
$b =~ tr/A-Z/a-z/;
$batfile = $denroot."bats/$b".".txt";
open (BATS, ">> $batfile");
print BATS "$email\n";
close (BATS);
}
}
}
sub getcookie {
#grab the color for this den from the cookie
%cookie = &parsecookie($ENV{'HTTP_COOKIE'});
$colors = $cookie{'colors'};
if ($colors ne "") {
@colors = split (/\~\~/,$colors);
foreach $a (@colors) {
@dencolor = split (/\^\^/, $a);
if ($dencolor[0] eq $denfile) {
$color = $dencolor[1];
last;
}
}
}
}
sub setcookie {
#grab the colors from the cookie and change this den's
%cookie = &parsecookie($ENV{'HTTP_COOKIE'});
$colors = $cookie{'colors'};
if ($colors ne "") {
@colors = split (/\~\~/,$colors);
foreach $a (@colors) {
@dencolor = split (/\^\^/, $a);
$colors{"$dencolor[0]"} = $dencolor[1];
}
}
$colors{"$denfile"} = $color;
foreach $a (keys(%colors)) {push (@steps, $a."^^".$colors{"$a"});}
$colors = join("\~\~", @steps);
print "Set-Cookie: colors=$colors; expires=Sat, 01-Jan-2002 10:10:10 GMT; path=/;\n";
}
sub parsecookie {
local($in) = @_;
@list = split(/; /,$in);
foreach $coo (@list) {
@final = split(/=/,$coo);
$return{$final[0]} = $final[1];
}
%return;
}