$title

#!/usr/local/bin/perl ############################################### # bbs39.cgi # V2.4 (2006.9.14) # Copyright(C) CGI-design ############################################### require './cgi-lib.pl'; require './jcode.pl'; require './mimew.pl'; $script = 'bbs39.cgi'; $base = './bbsdata'; #データ格納ディレクトリ $bbsfile = "$base/bbs.txt"; #記事 $nofile = "$base/no.txt"; #記事番号 $wordfile = "$base/word.txt"; #禁止語 $hostfile = "$base/host.txt"; #拒否ホスト $opfile = "$base/option.txt"; #オプション $lockfile = "$base/lock"; #ロック $fcmax = 11; #枠色数-1 $cgi_lib'maxdata = 400000; #入力最大容量（byte） open (IN,"$opfile") || &error("OPEN ERROR"); $opdata = ; close IN; if (!$opdata) { $pass = &crypt('cgi'); chmod(0666,$opfile); open (OUT,">$opfile") || &error("OPEN ERROR"); print OUT "$pass<>掲示板<><><>$base<>$base<><>/usr/lib/sendmail<><><><>5<>100<>720<>3<>150<>150<>1<>0<>#fafaf5,#000000,#c00000,#000000,#000000,#ffffff<>#c7c7a8,#e6e4ce,#e6c9a2,#a8b7c7,#a8c7c4,#a8c7a8,#c9e0c9,#c9e0de,#ccccff,#cc9999,#b8a8c7,#c7c7c7"; close OUT; chmod(0666,$bbsfile); chmod(0666,$nofile); chmod(0666,$wordfile); chmod(0666,$hostfile); } ###　メイン処理　### &ReadParse; while (($n,$val) = each %in) { if ($n =~ /img/) {next;} $val =~ s/&/&/g; $val =~ s//>/g; $val =~ s/"/"/g; if ($n eq 'com') {$val =~ s/\r\n|\r|\n/
/g;} elsif ($val =~ /\r|\n/) {&error;} $in{$n} = $val; } $mode = $in{'mode'}; $num = $in{'num'}; open (IN,"$opfile") || &error("OPEN ERROR"); ($pass,$title,$com_adm,$home,$savedir,$loaddir,$adm_mail,$sendmail,$bg_img,$home_icon,$title_icon,$page,$logmax,$dspw,$img_max,$max_w,$max_h,$img_pos,$regmode,$colors,$fc) = split(/<>/,); close IN; ($bg_color,$text_color,$title_color,$sub_color,$com_color,$combg_color) = split(/,/,$colors); @fc = split(/,/,$fc); if ($page == 0) {$page = 5;} if ($mode eq 'regin') {®in;} elsif ($mode eq 'resin') {&resin;} elsif ($mode eq 'edtin') {&edtin;} elsif ($mode eq 'search') {&search;} elsif ($mode eq 'admin') {&admin;} else {&main;} print "\n"; exit; ### sub header { print "Content-type: text/html\n\n"; print "\n"; print "$title\n"; $head = 1; } ### sub main { if ($in{'newwrt'}) {&newwrt;} elsif ($in{'edtwrt'}) {&edtwrt;} elsif ($in{'delwrt'}) {&delwrt;} &header; print "\n"; print "

"; if ($home) {if ($home_icon) {print "

";} else {print "HOME";}} print "

"; if ($title_icon) {print "

";} else {print "$title";} print "

"; if ($regmode) {print "｜投稿";} print "｜検索｜

\n"; if (!$num) { print "

$com_adm

\n"; if (!$regmode) {&in_form;} } print "
"; $back = $num - $page; $next = $num + $page; $sum = 0; $m = -1; $start = 1; open (IN,"$bbsfile") || &error("OPEN ERROR"); while () { ($no,$rno,$img,$date,$name,$mail,$hp,$sub,$com,$color,$pwd,$host) = split(/<>/); $sum++; if (!$rno) {$m++;} if ($m < $num || $next <= $m) {next;} if (!$rno && !$start) {print "
\n";} &bbs_dsp; $start = 0; } close IN; print "\n"; print "
\n"; if (0 <= $back) { print "\n"; } if ($next <= $m) { print "\n"; } if ($page <= $m) { print "\n"; } print "

\n"; $i = 1; for ($k=0; $k<=$m; $k+=$page) { if ($k == $num) {print "\n";} else {print "\n";} $i++; } print "

P$i

全 $sum件　[管理]

\n"; # 次の行は著作権表示ですので削除しないで下さい。# print "CGI-design\n"; } ### sub bbs_dsp { if (!$rno || $mode eq 'edtin' || $mode eq 'search') { print "

\n"; if ($rno) {print "

";} } else {print "

\n";} print "\n"; print "\n"; if (!$mode) { if (!$rno) { print "\n"; } print ""; } print "

　$sub　 $name　 $date\n"; if ($hp) {print "　HP";} if ($mail) {print "　Mail";} print "

[修正]

\n"; if (!$rno) {print "\n"; } print "

\n"; } $com =~ s/([^=^\"]|^)(http\:[\w\.\~\-\/\?\&\+\=\:\@\%\;\#\%]+)/$1$2<\/a>/g; if ($com_color) {$fcolor = $com_color;} else {$fcolor = $color;} print "

\n"; @img = split(/!:/,$img); $n = 0; for ($i=0; $i<$#img; $i+=4) {if ($img[$i]) {$n++;}} if ($img_pos && $n < 3) { &imgdsp(' hspace=8 align=left'); print "$com"; } else { print "$com

\n"; &imgdsp(' hspace=2'); } print "

\n"; } ### sub imgdsp { $k = 0; for ($i=0; $i<$#img; $i+=4) { if ($img[$i]) { $imgfile = "$loaddir/$no-$k.$img[$i]"; $imgsrc = "

"; if ($img[$i+3]) {print "$imgsrc\n";} else {print "$imgsrc\n";} } $k++; } } ### sub regin { &header; print "\n"; print "

[Return]

\n"; print "投稿
\n"; &in_form; } ### sub in_form { print "\n"; print "\n"; if ($mode eq 'resin') { print "\n"; &getcook; $sub=$com=''; $submit = '返信する'; } elsif ($mode eq 'edtin') { print "\n"; print "\n"; print "\n"; $com =~ s/
/\r/g; $pwd = ''; } else { &getcook; $sub=$com=''; $submit = '投稿する'; } print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; for (0 .. $img_max) {print "\n";} print "\n"; print "\n";} else { print "

名前

メール

ＨＰ

題名

内容

\n"; if (!$color) {$color = $fc[0];} foreach (@fc) { if ($color eq $_) {$chk = ' checked';} else {$chk = '';} print "\n"; } print "

画像",$_+1,"

修正キー

（英数8文字以内）

"; if ($mode ne 'edtin') {print "

\n"; print "

\n"; if ($admpass) { print "

\n"; print "

\n"; } print "

\n"; } ### sub newwrt { &in_chk; ($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime; $year += 1900; $mon++; $week = ('日','月','火','水','木','金','土')[$wday]; $nowdate = sprintf("$year年$mon月$mday日($week) %2d:%02d",$hour,$min); &lock; open (IN,"$nofile") || &error("OPEN ERROR"); $no = ; close IN; $no++; open (OUT,">$nofile") || &error("OPEN ERROR"); print OUT $no; close OUT; $img = ''; for (0 .. 3) { &img("$savedir/$no-$_","img$_"); $img .= "$type!:$width!:$height!:$big!:"; } if ($in{'pwd'} ne '') {$pwd = &crypt($in{'pwd'});} else {$pwd = '';} $newdata = "$no<>$in{'rno'}<>$img<>$nowdate<>$in{'name'}<>$in{'mail'}<>$in{'hp'}<>$in{'sub'}<>$in{'com'}<>$in{'color'}<>$pwd<>$host<>\n"; if (!$in{'rno'}) { $i = $stop = 0; open (IN,"$bbsfile") || &error("OPEN ERROR"); while () { ($no,$rno,$img) = split(/<>/); $i++; if ($logmax && $logmax <= $i && !$rno) {$stop = 1;} if (!$stop) {push(@new,$_);} else { @img = split(/!:/,$img); for (0 .. 3) { if ($img[4*$_]) {unlink "$savedir/$no-$_.$img[4*$_]";} } } } close IN; unshift(@new,$newdata); } else { $mat = 0; open (IN,"$bbsfile") || &error("OPEN ERROR"); while () { ($no,$rno) = split(/<>/); if ($no eq $in{'rno'}) {$mat = 1; push(@new,$_);} elsif ($rno eq $in{'rno'}) {push(@new,$_);} else {push(@tmp,$_);} } close IN; if ($mat) {push(@new,$newdata);} push(@new,@tmp); } open (OUT,">$bbsfile") || &error("OPEN ERROR"); print OUT @new; close OUT; &unlock; &setcook; &send; print "Location: $script\n\n"; exit; } ### sub send { if (!$adm_mail) {return;} $cont = "■投稿日時： $nowdate\n"; $cont .= "■名前： $in{'name'}\n"; $cont .= "■メール： $in{'mail'}\n"; $cont .= "■ＨＰ： http://$in{'hp'}\n"; $cont .= "■題名： $in{'sub'}\n"; $cont .= "■内容： \n$in{'com'}"; $cont =~ s/&/&/g; $cont =~ s/<//g; $cont =~ s/"/"/g; $cont =~ s/\r\n|\r|
/\n/g; &jcode'convert(*cont,'jis'); $sub = &mimeencode($title); $in{'name'} =~ s/ //g; $mail = $in{'mail'}; if (!$mail) {$mail = $adm_mail;} $from = &mimeencode("$in{'name'} <$mail>"); if (!open(MAIL,"| $sendmail -t")) {&error("メールを送信できません");} print MAIL "To: $adm_mail\n"; print MAIL "From: $from\n"; print MAIL "Subject: $sub\n"; print MAIL "MIME-Version: 1.0\n"; print MAIL "Content-type: text/plain; charset=ISO-2022-JP\n"; print MAIL "Content-Transfer-Encoding: 7bit\n\n"; print MAIL "$cont\n"; close(MAIL); } ### sub in_chk { $addr = $ENV{'REMOTE_ADDR'}; $host = gethostbyaddr(pack("C4", split(/\./, $addr)), 2) || $addr; open (IN,"$hostfile") || &error("OPEN ERROR"); @deny = split(/
/,); close IN; $flag = 0; foreach (@deny) { s/\*/\.\*/g; if ($_ && $host =~ /$_/i) {$flag = 1; last;} } if ($flag) {&error("投稿できません");} if (!$in{'name'}) {&error("名前を入力して下さい");} if (!$in{'com'}) {&error("内容を入力して下さい");} $wcom = "$in{'name'}$in{'sub'}$in{'com'}"; open (IN,"$wordfile") || &error("OPEN ERROR"); @deny = split(/
/,); close IN; $flag = 0; foreach (@deny) {if ($_ && 0 <= index($wcom,$_)) {$flag = 1; last;}} if ($flag) {&error("投稿できません");} if ($wcom !~ /(\x82[\x9F-\xF2])|(\x83[\x40-\x96])/) {&error;} $in{'hp'} =~ s/^http\:\/\///; } ### sub resin { &header; print "\n"; print "

[Return]

\n"; print "*****　返　信　*****

\n"; $mat = 0; open (IN,"$bbsfile") || &error("OPEN ERROR"); while () { ($no,$rno,$img,$date,$name,$mail,$hp,$sub,$com,$color,$pwd,$host) = split(/<>/); if ($no eq $in{'no'} || $rno eq $in{'no'}) {$mat = 1; &bbs_dsp;} elsif ($mat) {last;} } close IN; print "

\n"; &in_form; } ### sub edtin { &header; print "\n"; print "

[Return]

\n"; open (IN,"$bbsfile") || &error("OPEN ERROR"); while () { ($no,$rno,$img,$date,$name,$mail,$hp,$sub,$com,$color,$pwd,$host) = split(/<>/); if ($no eq $in{'no'}) {last;} } close IN; $addr = $ENV{'REMOTE_ADDR'}; $inhost = gethostbyaddr(pack("C4", split(/\./, $addr)), 2) || $addr; if ($inhost ne $host) { if ($in{'pwd'} eq '') { print "

修正キーを入力して下さい

\n"; print "\n"; print "\n"; exit; } $mat = &decrypt($in{'pwd'},$pass); if ($mat) {$admpass = 1;} else { $admpass = 0; if ($pwd eq '') {&error("該当の記事に修正キーが設定されていません");} $mat = &decrypt($in{'pwd'},$pwd); if (!$mat) {&error("修正キーが違います");} } } print "*****　修正・削除　*****

\n"; $wcom = $com; &bbs_dsp; print "
\n"; $com = $wcom; &in_form; } ### sub in_pwchk { open (IN,"$bbsfile") || &error("OPEN ERROR"); while () { ($no,$rno,$img,$date,$name,$mail,$hp,$sub,$com,$color,$pwd,$host) = split(/<>/); if ($no eq $in{'no'}) {last;} } close IN; $addr = $ENV{'REMOTE_ADDR'}; $inhost = gethostbyaddr(pack("C4", split(/\./, $addr)), 2) || $addr; if ($inhost eq $host) {return;} if ($in{'edtpw'} eq '') {&error;} $mat = &decrypt($in{'edtpw'},$pass); if ($mat) {return;} if ($pwd eq '') {&error;} $mat = &decrypt($in{'edtpw'},$pwd); if (!$mat) {&error;} } ### sub edtwrt { &in_pwchk; &in_chk; &lock; open (IN,"$bbsfile") || &error("OPEN ERROR"); while () { ($no,$rno,$img,$date,$name,$mail,$hp,$sub,$com,$color,$pwd,$host) = split(/<>/); if ($no eq $in{'no'}) { if ($in{'pwd'} ne '') {$pwd = &crypt($in{'pwd'});} @img = split(/!:/,$img); $img = ''; for $n (0 .. 3) { &img("$savedir/$no-$n","img$n"); if ($type) { if ($type ne $img[4*$n]) {unlink "$savedir/$no-$n.$img[4*$n]";} $img .= "$type!:$width!:$height!:$big!:"; } else { $img .= "$img[4*$n]!:$img[4*$n+1]!:$img[4*$n+2]!:$img[4*$n+3]!:"; } } push(@new,"$no<>$rno<>$img<>$date<>$in{'name'}<>$in{'mail'}<>$in{'hp'}<>$in{'sub'}<>$in{'com'}<>$in{'color'}<>$pwd<>$host<>\n"); } else {push(@new,$_);} } close IN; open (OUT,">$bbsfile") || &error("OPEN ERROR"); print OUT @new; close OUT; &unlock; print "Location: $script?num=$num\n\n"; exit; } ### sub delwrt { &in_pwchk; &lock; open (IN,"$bbsfile") || &error("OPEN ERROR"); while () { ($no,$rno,$img) = split(/<>/); if ($no eq $in{'no'} || $rno eq $in{'no'}) { @img = split(/!:/,$img); for (0 .. 3) { if ($img[4*$_]) {unlink "$savedir/$no-$_.$img[4*$_]";} } } else {push(@new,$_);} } close IN; open (OUT,">$bbsfile") || &error("OPEN ERROR"); print OUT @new; close OUT; &unlock; print "Location: $script?num=$num\n\n"; exit; } ### sub search { &header; print "\n"; print "

[Return]

\n"; print "キーワードを入力し「検索」をクリックして下さい。キーワードを複数指定する場合はスペースで区切って下さい。\n"; print "\n"; if (!$in{'word'}) {return;} $in{'word'} =~ s/　/ /g; @word = split(/\s+/,$in{'word'}); $back = $num - 10; $next = $num + 10; $m = -1; open (IN,"$bbsfile") || &error("OPEN ERROR"); while () { $find = 0; foreach $word (@word) {if (0 <= index($_,$word)) {$find = 1;} else {$find = 0; last;}} if (!$find) {next;} $m++; if ($m < $num) {next;} if ($next <= $m) {last;} ($no,$rno,$img,$date,$name,$mail,$hp,$sub,$com,$color) = split(/<>/); &bbs_dsp; print "
\n"; } close IN; print "\n"; if (0 <= $back) { print "\n"; } if ($next <= $m) { print "\n"; } print "

\n"; } ### sub admin { &header; print "\n"; $inpass = $in{'pass'}; if ($inpass eq '') { print "

[Return]

\n"; print "

パスワードを入力して下さい

\n"; print "\n"; print "\n"; exit; } $mat = &decrypt($inpass,$pass); if (!$mat) {&error("パスワードが違います");} print "\n"; print "

　Return

\n"; $wrt = $in{'wrt'}; if ($in{'word'}) {&dword;} elsif ($in{'set'}) {&setup;} else {&dhost;} } ### sub dhost { if ($in{'host'}) { open (IN,"$hostfile") || &error("OPEN ERROR"); $com = ; close IN; open (OUT,">$hostfile") || &error("OPEN ERROR"); print OUT "$in{'host'}
$com"; close OUT; } elsif ($wrt) { open (OUT,">$hostfile") || &error("OPEN ERROR"); print OUT $in{'com'}; close OUT; } print "投稿を拒否するホスト名を入力して改行して下さい。
任意の文字を「*」で指定できます。　（例） a123*.ne.jp\n"; print "

\n"; print "\n"; print "\n"; print "

\n"; open (IN,"$hostfile") || &error("OPEN ERROR"); $com = ; close IN; $com =~ s/
/\r/g; print "\n"; } ### sub dword { if ($wrt) { open (OUT,">$wordfile") || &error("OPEN ERROR"); print OUT $in{'com'}; close OUT; } print "禁止語を１語ずつ改行して入力して下さい。\n"; print "

\n"; print "\n"; print "\n"; print "\n"; print "

\n"; open (IN,"$wordfile") || &error("OPEN ERROR"); $com = ; close IN; $com =~ s/
/\r/g; print "\n"; } ### sub setup { if ($wrt) { if ($in{'newpass'} ne '') {$pass = &crypt($in{'newpass'});} $title = $in{'title'}; $com_adm = $in{'com'}; $home = $in{'home'}; $savedir = $in{'savedir'}; $loaddir = $in{'loaddir'}; $adm_mail = $in{'adm_mail'}; $sendmail = $in{'sendmail'}; $icon = $in{'icon'}; if ($icon) { &img("$savedir/$icon",'img'); if ($type) {$icontype = "$icon.$type";} else {$icontype = '';} if ($icon eq 'wall') {$bg_img = $icontype;} elsif ($icon eq 'home') {$home_icon = $icontype;} elsif ($icon eq 'title') {$title_icon = $icontype;} } $page = $in{'page'}; $logmax = $in{'logmax'}; $dspw = $in{'dspw'}; $img_max = $in{'img_max'}; $max_w = $in{'max_w'}; $max_h = $in{'max_h'}; $img_pos = $in{'img_pos'}; $regmode = $in{'regmode'}; $colors = $in{'colors'}; $colors =~ s/\0/,/g; $in{'fc'} =~ s/\0/,/g; @fc = split(/,/,$in{'fc'}); open (OUT,">$opfile") || &error("OPEN ERROR"); print OUT "$pass<>$title<>$com_adm<>$home<>$savedir<>$loaddir<>$adm_mail<>$sendmail<>$bg_img<>$home_icon<>$title_icon<>$page<>$logmax<>$dspw<>$img_max<>$max_w<>$max_h<>$img_pos<>$regmode<>$colors<>$in{'fc'}"; close OUT; } print "下記に入力後、「設定する」を押して下さい。\n"; print "

\n"; print "\n"; print "\n"; print "\n"; print "

\n"; print "

\n"; print "\n"; $com_adm =~ s/
/\r/g; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; if ($img_pos) {$chk0 = ''; $chk1 = ' checked';} else {$chk0 = ' checked'; $chk1 = '';} print "\n"; if ($regmode) {$chk0 = ''; $chk1 = ' checked';} else {$chk0 = ' checked'; $chk1 = '';} print "\n"; print "\n"; @name = ('基本背景色','基本文字色','タイトル色','見出し文字色','内容文字色','内容背景色'); @colors = split(/,/,$colors); for (0 .. $#name) { print "\n"; } print "\n"; print "\n"; print "

タイトル

コメント

ホームURL

画像格納ディレクトリ

画像読出ディレクトリ

受信メールアドレス

sendmail パス

壁紙、アイコン

\n"; @name = ('壁紙','ホーム','タイトル'); @data = ($bg_img,$home_icon,$title_icon); @icon = ('wall','home','title'); for (0 .. $#name) { print "$name[$_]"; if ($data[$_]) { if ($_) {$w = '';} else {$w = ' width=30';} print "

　"; } else {print "（無）　";} } print "

記事表\示

件/ページ（親記事数）　　最大件（親/返信記事の合計）　　表\示幅px

画像表\示

　　横px　縦px\n"; print "　　表\示位置下　横

投稿フォーム

常時表\示　　　投稿時表\示

カラーコード

$name[$_]

\n"; print "\n"; print "

枠色

\n"; for (0 .. $fcmax) {print "\n";} print "

パスワード変更

（英数8文字以内）

\n"; } ### sub img { $type=$width=$height=$big=$mac=''; $imgdata = $in{"$_[1]"}; if (!$imgdata) {return;} foreach (@in) { if (/$_[1]/ and /Content-Type:(.+)/i) { if ($1 =~ /image\/.*jpeg/i) {$type = 'jpg';} elsif ($1 =~ /image\/gif/i) {$type = 'gif';} elsif ($1 =~ /image\/.*png/i) {$type = 'png';} } if (/application\/x-macbinary/i) {$mac = 1;} } if (!$type) {&error("このファイルはアップロードできません");} if ($mac) { $leng = substr($imgdata,83,4); $leng = unpack("%N",$leng); $imgdata = substr($imgdata,128,$leng); } $img_file = "$_[0].$type"; open (IMG,">$img_file") || &error("$img_fileファイルを作成できません"); binmode IMG; print IMG $imgdata; close IMG; chmod (0666,$img_file); ($t,$width,$height) = &getImageSize("$img_file"); if (!$width || !$height) {&error("ファイルを認識できません");} $big = 0; if ($max_w && $max_w < $width) {$rate_w = $max_w / $width; $big = 1;} else {$rate_w = 1;} if ($max_h && $max_h < $height) {$rate_h = $max_h / $height; $big = 1;} else {$rate_h = 1;} if ($big) { if ($rate_w < $rate_h) {$rate = $rate_w;} else {$rate = $rate_h;} $width = int($width * $rate); $height = int($height * $rate); } } #========================================= # Get Image Pixel Size.（出典：stdio-902） #========================================= sub getImageSize { local($file_name) = @_; local($head); return if (!open IMG, $file_name); binmode IMG; read IMG, $head, 8; if ($head eq "\x89\x50\x4e\x47\x0d\x0a\x1a\x0a") { local($width, $height); if (read(IMG, $head, 4) != 4 || read(IMG, $head, 4) != 4 || $head ne 'IHDR') { close IMG; return "PNG", 0; } read IMG, $head, 8; close IMG; $width = unpack "N", substr($head, 0, 4); $height = unpack "N", substr($head, 4, 4); return "PNG", $width, $height; } $head = substr $head, 0, 3; if ($head eq "\x47\x49\x46") { local($head, $width, $height); seek IMG, 6, 0; read IMG, $head, 4; close IMG; ($width, $height) = unpack "vv", $head; return "GIF", $width, $height; } $head = substr $head, 0, 2; if ($head eq "\xff\xd8") { local($head, $width, $height, $w1, $w2, $h1, $h2, $l1, $l2, $length); seek IMG, 2, 0; while (read IMG, $head, 1) { last if ($head eq ""); if ($head eq "\xff") { $head = getc IMG; if ($head =~ /^[\xc0-\xc3\xc5-\xcf]$/) { seek IMG, 3, 1; last if (read(IMG, $head, 4) != 4); close IMG; ($h1, $h2, $w1, $w2) = unpack "C4", $head; $height = $h1 * 256 + $h2; $width = $w1 * 256 + $w2; return "JPG", $width, $height; } elsif ($head eq "\xd9" || $head eq "\xda") { last; } else { last if (read(IMG, $head, 2) != 2); ($l1, $l2) = unpack "CC", $head; $length = $l1 * 256 + $l2; seek IMG, $length - 2, 1; } } } close IMG; return "JPG", 0; } return 0; } ### sub setcook { my($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime(time+60*24*60*60); $ww = (Sun,Mon,Tue,Wed,Thu,Fri,Sat)[$wday]; $month = (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec)[$mon]; $gmt = sprintf("%s, %02d-%s-%04d %02d:%02d:%02d GMT",$ww,$mday,$month,$year+1900,$hour,$min,$sec); $cook = "$in{'name'}<>$in{'mail'}<>$in{'hp'}<>$in{'color'}<>$in{'pwd'}<>"; print "Set-Cookie: bbs39=$cook; expires=$gmt;\n"; } ### sub getcook { my($n,$val); foreach (split(/;\s*/,$ENV{'HTTP_COOKIE'})) { ($n,$val) = split(/=/); if ($n eq 'bbs39') {last;} $val = ''; } ($name,$mail,$hp,$color,$pwd) = split(/<>/,$val); } ### sub lock { $retry = 3; if (-e $lockfile) { $locktime = (stat($lockfile))[9]; if ($locktime < time - 60) {&unlock;} } while (!mkdir($lockfile, 0755)) { if (--$retry < 0) {&error("busy!");} sleep(1); } } ### sub unlock {rmdir($lockfile);} ### sub crypt { @salt = ('a' .. 'z','A' .. 'Z','0' .. '9'); srand; $salt = "$salt[int(rand($#salt))]$salt[int(rand($#salt))]"; return crypt($_[0],$salt); } ### sub decrypt { $salt = $_[1] =~ /^\$1\$(.*)\$/ && $1 || substr($_[1],0,2); if (crypt($_[0],$salt) eq $_[1] || crypt($_[0],'$1$' . $salt) eq $_[1]) {return 1;} return 0; } ### sub error { if (!$head) {&header; print "\n";} print "

ERROR !!

$_[0]\n"; print "\n"; exit; }