/[suikacvs]/webroot/sccc/board-t/test/subbbs.cgi
Suika

Contents of /webroot/sccc/board-t/test/subbbs.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (hide annotations) (download)
Wed Jan 12 04:23:01 2005 UTC (20 years, 3 months ago) by wakaba
Branch: MAIN
CVS Tags: HEAD
New

1 wakaba 1.1 #!/usr/local/bin/perl
2    
3     use strict;
4     require './jcode.pl';
5    
6     ### subbbs.cgi ver 2.31 (2001/08/22)
7    
8     # システム情報
9     use vars qw($KEEPLOGCOUNT);
10     $KEEPLOGCOUNT = 4096; # ログファイル保持数(システム設定)
11    
12     #==================================================
13     # システム関連(タイムゾーン・シグナル)
14     #==================================================
15    
16     #タイムゾーンをセットする
17     {
18     $ENV{'TZ'} = "JST-9";
19     }
20    
21     #シグナル対処関数
22     sub SigExit {
23     exit(0);
24     }
25    
26     #対応シグナル
27     {
28     $SIG{'PIPE'} = $SIG{'INT'} = $SIG{'HUP'} = $SIG{'QUIT'} = $SIG{'TERM'} = "SigExit";
29     }
30    
31    
32     #==================================================
33     # 初期情報の取得(POST)
34     #==================================================
35    
36     {
37     use vars qw(%FORM);
38     use vars qw($buffer);
39     my (@pairs, $name, $value, $check);
40     $check = '(?:^|[\0-\200\240-\337])(?:[\201-\237\340-\374]{2})*';
41     if ($ENV{'REQUEST_METHOD'} eq "POST") {
42     read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
43     @pairs = split /&/,$buffer;$buffer=undef;
44     foreach (@pairs) {
45     ($name, $value) = split /=/;
46     $value =~ tr/+/ /;
47     $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack('H2',$1)/eg;
48     $value =~ s/</&lt;/g;
49     $value =~ s/>/&gt;/g;
50     $value =~ s/\r\n|\r|\n/<br>/g;
51     $value =~ s/^(?:<br>)+//g;
52     $value =~ s/(?:<br>)+$//g;
53     $value =~ s/(?:<br>){4,}/<br><br><br>/g;
54     $value =~ s/($check)[\201-\237\340-\374]<br>/$1<br>/g;
55     $buffer .= $value;
56     $FORM{$name} = $value;
57     }
58     }
59     if((&jcode'getcode(*buffer))[1] ne 'sjis'){
60     DispError("ERROR!","ERROR:Sjisで書いてね。。。");
61     }
62     if($FORM{'submit'} !~ /^[\x81-\x95|\xE0-\xEF]/ || length($FORM{'submit'}) < 6){
63     DispError("ERROR!","ERROR:文字化けしちゃうよ。。。");
64     }
65     if(length($FORM{'time'})<9){
66     DispError("ERROR!","ERROR:フォーム情報が不正です!");
67     }
68     }
69    
70    
71     #==================================================
72     # 設定
73     #==================================================
74    
75     {
76     use vars qw(%SETTING);
77     use vars qw(%FLAG);
78     use vars qw($HOST);
79     use vars qw($DATE);
80     use vars qw($ID);
81    
82     # 各種PATH生成
83     use vars qw($WWWPATH);
84     use vars qw($PATH);
85     use vars qw($DATPATH);
86     use vars qw($TEMPPATH);
87     use vars qw($IMODEPATH);
88     $FORM{'bbs'} =~ s/\0//g;
89     $PATH = "../" . $FORM{'bbs'} . "/";
90     $DATPATH = $PATH . "dat/";
91     $TEMPPATH = $PATH . "html/";
92     $IMODEPATH = $PATH . "i/";
93    
94     use vars qw($NOWTIME);
95     $NOWTIME = time;
96    
97     $FLAG{'FROM'}=$FORM{'FROM'};
98     $FLAG{'mail'}=$FORM{'mail'};
99     }
100    
101    
102     #==================================================
103     # 初期情報の取得(設定ファイル)
104     #==================================================
105    
106     {
107     # 設定ファイルを読む
108     my ($m_pass,$m_key,$m_value);
109     $m_pass = $PATH . "SETTING.TXT";
110     if(-e $m_pass){
111     open(FILE,$m_pass);
112     foreach (<FILE>){
113     chop;
114     ($m_key,$m_value) = split /=/;
115     $SETTING{$m_key} = $m_value;
116     }
117     close(FILE);
118     }else{
119     # 設定ファイルがない(ERROR)
120     DispError("ERROR!","ERROR:ユーザー設定が消失しています!");
121     }
122    
123     # 欠落情報の補完
124     unless($SETTING{'BBS_THREAD_NUMBER'}){$SETTING{'BBS_THREAD_NUMBER'}=20;}
125     unless($SETTING{'BBS_CONTENTS_NUMBER'}){$SETTING{'BBS_CONTENTS_NUMBER'}=10;}
126     unless($SETTING{'BBS_LINE_NUMBER'}){$SETTING{'BBS_LINE_NUMBER'} = 30;}
127     unless($SETTING{'BBS_MAX_MENU_THREAD'}){$SETTING{'BBS_MAX_MENU_THREAD'}=100;}
128     unless($SETTING{'BBS_BG_COLOR'}){$SETTING{'BBS_BG_COLOR'}="#FFFFFF";}
129     unless($SETTING{'BBS_MENU_COLOR'}){$SETTING{'BBS_MENU_COLOR'}="#CCFFCC";}
130     unless($SETTING{'BBS_MAKETHREAD_COLOR'}){$SETTING{'BBS_MAKETHREAD_COLOR'}="#CCFFCC";}
131     unless($SETTING{'BBS_THREAD_COLOR'}){$SETTING{'BBS_THREAD_COLOR'}="#EFEFEF";}
132     unless($SETTING{'BBS_SUBJECT_COLOR'}){$SETTING{'BBS_SUBJECT_COLOR'}="#FF0000";}
133     unless($SETTING{'BBS_TEXT_COLOR'}){$SETTING{'BBS_TEXT_COLOR'}="#000000";}
134     unless($SETTING{'BBS_NAME_COLOR'}){$SETTING{'BBS_NAME_COLOR'}="#008800";}
135     unless($SETTING{'BBS_LINK_COLOR'}){$SETTING{'BBS_LINK_COLOR'}="#0000FF";}
136     unless($SETTING{'BBS_ALINK_COLOR'}){$SETTING{'BBS_ALINK_COLOR'}="#FF0000";}
137     unless($SETTING{'BBS_VLINK_COLOR'}){$SETTING{'BBS_VLINK_COLOR'}="#660099";}
138     unless($SETTING{'BBS_TITLE_COLOR'}){$SETTING{'BBS_TITLE_COLOR'}="#000000";}
139     unless($SETTING{'BBS_SUBJECT_COUNT'}){$SETTING{'BBS_SUBJECT_COUNT'}=64;}
140     unless($SETTING{'BBS_NAME_COUNT'}){$SETTING{'BBS_NAME_COUNT'}=64;}
141     unless($SETTING{'BBS_MAIL_COUNT'}){$SETTING{'BBS_MAIL_COUNT'}=64;}
142     unless($SETTING{'BBS_MESSAGE_COUNT'}){$SETTING{'BBS_MESSAGE_COUNT'}=4096;}
143     #unless($SETTING{'BBS_THREAD_TATESUGI'}){$SETTING{'BBS_THREAD_TATESUGI'}=5;}
144     unless($SETTING{'timecount'}){$SETTING{'timecount'}=15;}
145     unless($SETTING{'timeclose'}){$SETTING{'timeclose'}=15;}
146     unless($SETTING{'BBS_WAIT_MINUTE'}){$SETTING{'BBS_WAIT_MINUTE'}=3;}
147     unless($SETTING{'BBS_MAX_RES_COUNT'}){$SETTING{'BBS_MAX_RES_COUNT'}=1000;}
148     unless($SETTING{'BBS_MAX_RES_SIZE'}){$SETTING{'BBS_MAX_RES_SIZE'}=500;}
149     }
150    
151    
152     #==================================================
153     # 初期情報の取得(日付)
154     #==================================================
155    
156     {
157     # 日付と時間をげとする
158     my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);
159     my ($myear, $mtd, $dday, $uruu);
160     my ($wmon, $wmday, $wwday, $wdday);
161     my ($nmon, $nday, $dtime, $nhour, $nmin, $nsec);
162     my ($qyear, $quruu, $qmon, $qday, $qrokuyou);
163     ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime($NOWTIME);
164     $myear = $year + 1900;
165     $wday = ("日", "月", "火", "水", "木", "金", "土")[$wday];
166    
167     if ( $SETTING{'BBS_LUNISOLAR_CALENDAR'} ) {
168     # 旧暦の計算(qreki.plが必要)
169     # qreki.plの入手先 → http://www3.biwako.ne.jp/~nobuaki/qreki/
170     require './qreki.pl';
171     ($qyear, $quruu, $qmon, $qday) = &qreki::calc_kyureki($myear, $mon + 1, $mday);
172     $qrokuyou = ( $qmon + $qday ) % 6;
173     $quruu = ("", "閏")[$quruu];
174     $qrokuyou = ("大安", "赤口", "先勝", "友引", "先負", "仏滅")[$qrokuyou];
175     }
176    
177     if (( $SETTING{'BBS_WORLD_CALENDAR'} ) || ( $SETTING{'BBS_DECIMAL_CALENDAR'} )) {
178    
179     # 閏年の判定
180     if (( $myear % 4 == 0 ) && ( $myear % 100 != 0 ) || ( $myear % 400 == 0 )) {
181     $uruu = 1;
182     } else {
183     $uruu = 0;
184     }
185    
186     # 通日の計算 ( 0 〜 364 ( 平年 ), 365 ( 閏年 ) )
187     $mtd = ( 0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334 )[$mon];
188     $dday = $mtd + $mday - 1;
189     if (( $uruu == 1 ) && ( $mon >= 2 )) {
190     $dday++;
191     }
192     }
193    
194     if ( $SETTING{'BBS_WORLD_CALENDAR'} ) {
195     # 世界暦の計算
196     if (( $uruu == 1 ) && ( $dday >= 183 )) {
197     $wdday = $dday - 1;
198     } else {
199     $wdday = $dday;
200     }
201     if (( $uruu == 1 ) && ( $dday == 182 )) {
202     $wmon = 6;
203     $wmday = 31;
204     $wwday = "世";
205     } elsif (( $uruu == 1 ) && ( $dday == 365 ) || ( $uruu == 0 ) && ( $dday == 364 )) {
206     $wmon = 12;
207     $wmday = 31;
208     $wwday = "世";
209     } else {
210     $wmon = int ( $wdday / ( 91 / 3 )) + 1;
211     $wmday = int ( $wdday - ( $wmon - 1 ) * ( 91 / 3 )) + 1;
212     $wwday = ("日", "月", "火", "水", "木", "金", "土")[($wdday % 7)];
213     }
214     }
215    
216     if ( $SETTING{'BBS_DECIMAL_CALENDAR'} ) {
217     # 10進の暦法の計算
218     if ( $dday == 365 ) {
219     $nmon = 9;
220     $nday = 36;
221     } else {
222     $nmon = int ( $dday / 36.5 );
223     $nday = int ( $dday - $nmon * 36.5 );
224     }
225    
226     # 10進の時法の計算
227     $dtime = ( $hour * 3600 + $min * 60 + $sec ) / 0.864;
228     $nhour = int ( $dtime / 10000 );
229     $nmin = int (( $dtime - $nhour * 10000 ) / 100 );
230     $nsec = int ( $dtime - $nhour * 10000 - $nmin * 100 );
231     }
232    
233     # 日付・時間の合成
234     $DATE = sprintf("%04d/%02d/%02d(%s) %02d:%02d",
235     $myear, $mon + 1, $mday, $wday, $hour, $min);
236    
237     if ( $SETTING{'BBS_LUNISOLAR_CALENDAR'} ) {
238     $DATE .= sprintf(" 旧暦:%04d/%s%02d/%02d(%s) %02d:%02d",
239     $qyear, $quruu, $qmon, $qday, $qrokuyou, $hour, $min);
240     }
241    
242     if ( $SETTING{'BBS_WORLD_CALENDAR'} ) {
243     $DATE .= sprintf(" 世界暦:%04d/%02d/%02d(%s) %02d:%02d",
244     $myear, $wmon, $wmday, $wwday, $hour, $min);
245     }
246    
247     if ( $SETTING{'BBS_DECIMAL_CALENDAR'} ) {
248     $DATE .= sprintf(" 十\進暦:%04d/%01d/%02d #%01d%02d",
249     $myear, $nmon, $nday, $nhour, $nmin);
250     }
251    
252     # ID
253     my $idnum = substr($ENV{'REMOTE_ADDR'}, 8);
254     my $idcrypt = substr(crypt($idnum * $idnum, substr($DATE, 8, 2)), -8);
255     $ID = " ID:".$idcrypt;
256    
257     # 有効期限をつくる
258     my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);
259     my $exp = 24 * 60 * 60; $exp *= 30; #有功日数を乗じる
260     ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = gmtime($NOWTIME + $exp);
261     $wday = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday')[$wday];
262     $mon = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec')[$mon];
263     $year = $year+1900;$mday = "0$mday" if ($mday < 10);
264     $FLAG{'expires'} = "$wday, $mday-$mon-$year 00:00:00 GMT";
265     }
266    
267    
268     #==================================================
269     # ホスト取得
270     #==================================================
271    
272     {
273     $FLAG{'PROXY'} = 0;
274     my $host2;
275     $HOST = $ENV{'REMOTE_ADDR'};
276     if ($HOST =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/) {
277     $HOST = gethostbyaddr(pack('c4',split(/\./, $HOST)), 2) || $HOST;
278     }
279     if ($ENV{'HTTP_VIA'} =~ s/.*\s(\d+)\.(\d+)\.(\d+)\.(\d+)/$1.$2.$3.$4/) {
280     $host2 = $ENV{'HTTP_VIA'};
281     }
282     if ($ENV{'HTTP_X_FORWARDED_FOR'} =~ s/^(\d+)\.(\d+)\.(\d+)\.(\d+)(\D*).*/$1.$2.$3.$4/) {
283     $host2 = $ENV{'HTTP_X_FORWARDED_FOR'};
284     }
285     if ($ENV{'HTTP_FORWARDED'} =~ s/.*\s(\d+)\.(\d+)\.(\d+)\.(\d+)/$1.$2.$3.$4/) {
286     $host2 = $ENV{'HTTP_FORWARDED'};
287     }
288     $host2 = gethostbyaddr(pack('c4', split(/\./, $host2)), 2);
289     $HOST .= "[$host2]" if ($host2);
290     if ($HOST =~ /proxy/i && $host2 eq '') { $FLAG{'PROXY'} = 1; }
291     if ($ENV{'HTTP_USER_AGENT'} =~ /ANONYMIZER/i) { $FLAG{'PROXY'} = 1; }
292     if ($host2){ $FLAG{'PROXY'} = 1; }
293     }
294    
295    
296     #==================================================
297     # i-mode検出
298     #==================================================
299    
300     {
301     $FLAG{'imode'}=0;
302     if($FORM{'submit'} eq 'かきこむ'){$FLAG{'imode'}=1;}
303     if($ENV{'HTTP_USER_AGENT'} =~ /DoCoMo\//){$FLAG{'imode'}=1;}
304     }
305    
306    
307     #==================================================
308     # パス情報(名前)
309     #==================================================
310    
311     {
312     $FLAG{'cap'}='';
313     if (-e "../caps.cgi" && $FORM{'mail'} =~ /#.+/) {
314     my ($id1,$name1,$pass1);
315     open(IN,"../caps.cgi");
316     foreach (<IN>) {
317     chop;
318     ($id1,$name1,$pass1) = split /<>/;
319     if($FORM{'mail'} =~ /#$pass1/){
320     $FLAG{'cap'} = "$name1 ★";$ID=" ID:???";
321     last;
322     }
323     }
324     close(IN);
325     }
326     }
327    
328    
329     #==================================================
330     # アクセス規制
331     #==================================================
332    
333     {
334     # 不正PROXY使用ですか、、、?
335    
336     # プロキシ制限の実施
337     if($FLAG{'PROXY'} == 1 && $SETTING{'BBS_PROXY_CHECK'} eq "checked") {
338     DispError("ERROR!","ERROR:PROXY規制中!");
339     }
340     if($HOST !~/jp$/ && $SETTING{'BBS_OVERSEA_PROXY'} eq "checked") {
341     DispError("ERROR!","ERROR:PROXY規制中!");
342     }
343     if($HOST !~ /jp$/ && $FORM{'subject'} ne '' && $SETTING{'BBS_OVERSEA_THREAD'} eq "checked") {
344     DispError("ERROR!","jpドメインからスレッド立ててください");
345     }
346    
347     #-------------------------------ユーザー設定が異常です!
348     if(-e "../$FORM{'bbs'}/uerror.cgi"){
349     open (IN,"../$FORM{'bbs'}/uerror.cgi");
350     foreach (<IN>){
351     chop;
352     if ($HOST =~ /$_/) {
353     DispError("ERROR!","ユーザー設定が異常です!");
354     }
355     }
356     close(IN);
357     }
358    
359     #-------------------------------リモートホストを公開します。
360     if (-e "../$FORM{'bbs'}/chubo.cgi" && !($SETTING{'BBS_NEWSUBJECT'} && $FORM{'subject'})){
361     open (IN,"../$FORM{'bbs'}/chubo.cgi");
362     foreach (<IN>){
363     chop;
364     if ($HOST =~ /$_/) {
365     $FORM{'MESSAGE'} .= '<br><br><font color=red><b>あなたのレスまたはスレッドの内容について問題があり、<br>';
366     $FORM{'MESSAGE'} .= '管理人からの警告にもかかわらず内容に改善が見られませんでしたので、<br>';
367     $FORM{'MESSAGE'} .= "あなたのリモートホスト</b>($HOST)<b>を公開します。<br>";
368     $FORM{'MESSAGE'} .= '解除申請は事務所にお願いします。</b></font>';
369     }
370     }
371     close(IN);
372     }
373    
374     #-------------------------------管理人から警告します。
375     if (-e "../$FORM{'bbs'}/keikoku.cgi" && !($SETTING{'BBS_NEWSUBJECT'} && $FORM{'subject'})){
376     open (IN,"../$FORM{'bbs'}/keikoku.cgi");
377     foreach (<IN>){
378     chop;
379     if ($HOST =~ /$_/) {
380     $FORM{'MESSAGE'} .= '<br><br><font color=orange><b>あなたのレスまたはスレッドの内容について、管理人から警告します。<br>';
381     $FORM{'MESSAGE'} .= '内容に改善が見られない場合、あなたのリモートホストが公開されます。<br>';
382     $FORM{'MESSAGE'} .= '解除申請は事務所にお願いします。</b></font>';
383     }
384     }
385     close(IN);
386     }
387    
388     #-------------------------------個別の規制
389     if (-e "../$FORM{'bbs'}/arashi.cgi" && !($SETTING{'BBS_NEWSUBJECT'} && $FORM{'subject'})){
390     open (IN,"../$FORM{'bbs'}/arashi.cgi");
391     foreach (<IN>){
392     chomp;
393     my ($arashikey , $arashihost);
394     ($arashikey , $arashihost) = (split /<>/ , $_);
395     if (($FORM{'key'} eq $arashikey) && ($HOST =~ /$arashihost/)) {
396     DispError("ERROR!","荒らしさんの使ったリモートホストです。。。");
397     }
398     }
399     close(IN);
400     }
401     }
402    
403    
404     #==================================================
405     # 情報の修正(名前)
406     #==================================================
407    
408     {
409     #名前がなければ名無しさん(かちゅ〜しゃ使用者とそれ以外で振り分け)
410     $FLAG{'NONAME'} = 0;
411     unless($FORM{'FROM'}){
412     if (($ENV{'HTTP_USER_AGENT'} =~ /Katjusha/) || ($ENV{'HTTP_USER_AGENT'} =~ /kage/)) {
413     $FORM{'FROM'} = $SETTING{'BBS_NONAME_NAME_KA'};
414     } else {
415     $FORM{'FROM'} = $SETTING{'BBS_NONAME_NAME'};
416     }
417     $FLAG{'NONAME'} = 1;
418     if ($FLAG{'cap'}) {$FORM{'FROM'}='';}
419     }
420    
421     if (($ENV{'HTTP_USER_AGENT'} !~ /Katjusha/) && ($ENV{'HTTP_USER_AGENT'} !~ /kage/)) {
422     if ($FORM{'FROM'} eq $SETTING{'BBS_NONAME_NAME_KA'}) {
423     $FORM{'FROM'} = $SETTING{'BBS_NONAME_NAME'};
424     }
425     }
426     }
427    
428    
429     #==================================================
430     # 情報の修正(キー)
431     #==================================================
432    
433     # サブジェクトがある場合はキーを現在に設定
434     # サブジェクト&キーがない場合はエラー
435     # サブジェクトが無くキーがある場合はキーを受けとる
436     {
437     if($FORM{'subject'}){
438     $FORM{'key'} = $NOWTIME;
439     }else{
440     if(defined($FORM{'key'})){
441     # キーが数字じゃない場合ばいばい!
442     if($FORM{'key'} =~ /\D/){
443     DispError("ERROR!","ERROR:キー情報が不正です!");
444     }
445     }else{
446     DispError("ERROR!","ERROR:サブジェクトが存在しません!");
447     }
448     }
449     }
450    
451    
452     #==================================================
453     # 名前いれてちょ。。。
454     #==================================================
455    
456     {
457     if($SETTING{'NANASHI_CHECK'} eq 1 && $FLAG{'NONAME'} && $FLAG{'cap'} eq ''){
458     DispError("ERROR!","ERROR:名前いれてちょ。。。");
459     }
460     if($SETTING{'SUBBBS_CGI_ON'} eq 1 && $ENV{'HTTP_COOKIE'} eq ''){
461     if(!$FLAG{'imode'}){
462     if($SETTING{'BBS_NAMECOOKIE_CHECK'} eq "checked"){
463     print "Set-Cookie: NAME=$FLAG{'FROM'}; expires=$FLAG{'expires'}; path=/\n";
464     }
465     if($SETTING{'BBS_MAILCOOKIE_CHECK'} eq "checked"){
466     print "Set-Cookie: MAIL=$FLAG{'mail'}; expires=$FLAG{'expires'}; path=/\n";
467     }
468     }
469     DispError("ERROR!","ERROR:クッキーをオンにしてちょ。");
470     }
471     }
472    
473    
474     #==================================================
475     # ブラウザ変ですよん
476     #==================================================
477    
478     {
479     if($ENV{'HTTP_USER_AGENT'} =~ /Mozilla/){
480     if($ENV{'HTTP_REFERER'} !~ /$ENV{'HTTP_HOST'}/){
481     DispError("ERROR!","ERROR:ブラウザ変ですよん");
482     }
483     if($ENV{'HTTP_REFERER'} !~ /$FORM{'bbs'}/ && $FORM{'subject'} eq ''){
484     DispError("ERROR!","ERROR:ブラウザ変ですよん");
485     }
486     }
487     }
488    
489    
490     #==================================================
491     # スレッドの書き込み規制
492     #==================================================
493    
494     {
495     my $keyfile = $FORM{'key'} . ".dat";
496     if(-s "$DATPATH$keyfile" > 550000) {
497     DispError("ERROR!","ERROR:このスレッド大きすぎます");
498     }
499    
500     if(-e "$DATPATH$keyfile"){
501     #データを取得
502     use vars qw(@keytemp);
503     open(DAT,"$DATPATH$keyfile");
504     @keytemp=<DAT>;
505     close(DAT);
506     my ($date, $subject);
507     $date = (split /<>/,$keytemp[@keytemp-1])[2];
508     $subject = (split /<>/,$keytemp[0])[4];
509     chomp($subject);
510     $FLAG{'subject'} = $subject;
511     $FLAG{'subnum'} = @keytemp;
512    
513     if ($date =~/Over|\Qストッパー\E|停止/) {
514     DispError("ERROR!","ERROR:このスレッドには書けません!");
515     }
516     }
517     }
518    
519    
520     #==================================================
521     # フィールドサイズの判定
522     #==================================================
523    
524     {
525     # 末尾の空白を削る
526     my $check = '(?:^|[\0-\200\240-\337])(?:[\201-\237\340-\374]{2})*';
527     $FORM{'FROM'} =~ s/($check)(?: | )+$/$1/g;
528     $FORM{'mail'} =~ s/($check)(?: | )+$/$1/g;
529     $FORM{'subject'} =~ s/($check)(?: | )+$/$1/g;
530     $FORM{'MESSAGE'} =~ s/($check)(?: | )+<br>/$1<br>/g;
531     $FORM{'MESSAGE'} =~ s/($check)(?: | )+$/$1/g;
532     # unless ($FORM{'FROM'}) {$FORM{'FROM'} = ' ';}
533    
534     if(length($FORM{'subject'}) > $SETTING{'BBS_SUBJECT_COUNT'}){
535     DispError("ERROR!","ERROR:サブジェクトが長すぎます!");
536     }
537     if(length($FORM{'FROM'}) > $SETTING{'BBS_NAME_COUNT'}){
538     DispError("ERROR!","ERROR:名前が長すぎます!");
539     }
540     if(length($FORM{'mail'}) > $SETTING{'BBS_MAIL_COUNT'}){
541     DispError("ERROR!","ERROR:メールアドレスが長すぎます!");
542     }
543     if(length($FORM{'MESSAGE'}) > $SETTING{'BBS_MESSAGE_COUNT'}){
544     DispError("ERROR!","ERROR:本文が長すぎます!<br>このエラーが出る時は、掲示板が移転している場合があります。。");
545     }
546     if(length($FORM{'MESSAGE'}) == 0){
547     DispError("ERROR!","ERROR:本文がありません!");
548     }
549     }
550    
551    
552     #==================================================
553     # NGワードチェック
554     #==================================================
555    
556     #if (-e "../$FORM{'bbs'}/ngword.cgi" && !($SETTING{'BBS_NEWSUBJECT'} && $FORM{'subject'})){
557     if (-e "../$FORM{'bbs'}/ngword.cgi"){
558     open (IN,"../$FORM{'bbs'}/ngword.cgi");
559     foreach (<IN>){
560     chomp;
561     $_ =~ s/\r\n|\r|\n//g;
562     $FORM{'MESSAGE'} =~ s/\Q$_\E/<b>(NGワード)<\/b>/g;
563     # if ($FORM{'MESSAGE'} =~ /$_/) {
564     # DispError("ERROR!","ERROR:NGワードが含まれています。書き直してちょ。");
565     # }
566     }
567     close(IN);
568     }
569    
570    
571     #==================================================
572     # スレッド立てすぎチェック
573     #==================================================
574    
575     {
576     if($FORM{'subject'} && $SETTING{'BBS_THREAD_TATESUGI'}>=2){
577     my $file = $PATH . "RIP.cgi";
578     my @IP;
579     if(-e $file){
580     open(RIP,"<$file");
581     @IP = <RIP>;
582     close(RIP);
583     foreach(@IP){
584     chop;
585     if($HOST eq $_){
586     DispError("ERROR!","ERROR:スレッド立てすぎです。。。");
587     }
588     }
589     @IP=@IP[0..$SETTING{'BBS_THREAD_TATESUGI'}-2];
590     }
591     unshift(@IP,$HOST);
592     open(WIP,">$file");
593     eval{flock(WIP,2);};
594     foreach(@IP){
595     print WIP "$_\n";
596     }
597     eval{flock(WIP,8);};
598     close(WIP);
599     chmod(0666,$file);
600     }
601     }
602    
603    
604     #==================================================
605     # 連続投稿規制
606     #==================================================
607    
608     {
609     if($SETTING{'timecount'}>=2){
610     my ($key,$host1);my @IP;my $count=0;my $file = $PATH . "timecheck.cgi";
611     if(-e $file){
612     open(RIP,"<$file");
613     @IP = <RIP>;
614     close(RIP);
615     foreach(@IP){
616     chop;
617     ($key,$host1) = split /<>/;
618     if($HOST eq $host1){
619     if($FORM{'time'} eq $key){
620     DispError("ERROR!","ERROR:2重カキコですか??");
621     }
622     $count++;
623     }
624     }
625     @IP=@IP[0..$SETTING{'timecount'}-2];
626     }
627     if($count >= $SETTING{'timecount'}) {
628     DispError("ERROR!","ERROR:連続投稿ですか??");
629     }
630     unshift(@IP,"$FORM{'time'}<>$HOST");
631     open(WIP,">$file");
632     eval{flock(WIP,2);};
633     foreach(@IP){
634     print WIP "$_\n";
635     }
636     eval{flock(WIP,8);};
637     close(WIP);
638     chmod(0666,$file);
639     }
640     }
641    
642    
643     #==================================================
644     # 置き換え
645     #==================================================
646    
647     {
648     $FORM{'FROM'} =~s/◆/◇/g;
649     if (($FORM{'FROM'} ne $SETTING{'BBS_NONAME_NAME'}) && ($FORM{'FROM'} ne $SETTING{'BBS_NONAME_NAME_KA'})){
650     $FORM{'FROM'} =~s/★/☆/g;
651     }
652    
653     $FORM{'FROM'} =~ s/&(rl[emo]|lr[emo]);//g;
654     $FORM{'mail'} =~ s/&(rl[emo]|lr[emo]);//g;
655     $FORM{'subject'} =~ s/&(rl[emo]|lr[emo]);//g;
656    
657     $FORM{'FROM'} =~s/削除/"削除"/g;
658     $FORM{'FROM'} =~s/sakujyo/"sakujyo"/g;
659     $FORM{'FROM'} =~s/管理人/"管理人"/g;
660     $FORM{'FROM'} =~s/管直人/"管直人"/g;
661     $FORM{'FROM'} =~s/菅直人/"菅直人"/g;
662    
663     # トリップ
664     my ($key,$salt);
665     $FORM{'FROM'} =~ s/&#/<&>/g;
666     if($FORM{'FROM'}=~/#(.+)/){
667     $key = $1;
668     $salt = substr($key."H.", 1, 2);
669     $salt =~ s/[^\.-z]/\./go;
670     $salt =~ tr/:;<=>?@[\\]^_`/ABCDEFGabcdef/;
671     $FLAG{'trip'} = substr(crypt($key, $salt),-10);
672     }
673    
674     $FORM{'FROM'} =~ s/#.*//g;
675     $FORM{'FROM'} =~ s/<&>/&#/g;
676     $FORM{'mail'} =~ s/#.*//g;
677    
678     if($FLAG{'trip'}){
679     $FORM{'FROM'}.=" "if($FORM{'FROM'});
680     $FORM{'FROM'}.="<trip>";
681     }
682    
683     if($FLAG{'cap'}){
684     $FLAG{'cap'}="@$FLAG{'cap'}"if($FORM{'FROM'});
685     $FORM{'FROM'}.="$FLAG{'cap'}";
686     }
687    
688     my $check = '(?:^|[\0-\200\240-\337])(?:[\201-\237\340-\374]{2})*';
689     $FORM{'FROM'} =~ s/($check)fusianasan/$1<f>/g;
690     $FORM{'FROM'} =~ s/<f>/<\/b>$HOST<b>/g;
691    
692     if ($FORM{'FROM'} =~ /($check)nukeanasan/){
693     $FORM{'FROM'} =~ s/($check)nukeanasan/$1<n>/g;
694     my $USERAGENT = $ENV{'HTTP_USER_AGENT'};
695     if ($USERAGENT =~ /[\0-\37\177-\377]/){
696     DispError("ERROR!","ERROR:User Agentをいじってんじゃねぇよゴルァ(゚Д゚)");
697     }
698     $USERAGENT =~ s/</&lt;/g;
699     $USERAGENT =~ s/>/&gt;/g;
700     $FORM{'FROM'} =~ s/<n>/<\/b><font color=red><small>$USERAGENT<\/small><\/font><b>/g;
701     }
702    
703     $FORM{'FROM'} =~ s/<trip>/◆<\/b>$FLAG{'trip'}<b>/g;
704    
705     $FORM{'MESSAGE'} =~ s/\t//g;
706    
707     if ($SETTING{'BBS_HIRAKATA_CHECK'} eq "checked"){&hirakata;}
708    
709     $FORM{'MESSAGE'} =~ s/($check)[\201-\237\340-\374]&/$1&/g;
710     $FORM{'MESSAGE'} =~ s/(&gt;&gt;\d+-?\d*)/<r>$1<\/r>/g;
711     $FORM{'MESSAGE'} =~ s/<r>&gt;&gt;(\d+)-(\d+)<\/r>/<a href="..\/test\/read.cgi\/$FORM{'bbs'}\/$FORM{'key'}\/n$1-$2" target="_blank">&gt;&gt;$1-$2<\/a>/g;
712     $FORM{'MESSAGE'} =~ s/<r>&gt;&gt;(\d+)-<\/r>/<a href="..\/test\/read.cgi\/$FORM{'bbs'}\/$FORM{'key'}\/n$1-" target="_blank">&gt;&gt;$1-<\/a>/g;
713     $FORM{'MESSAGE'} =~ s/<r>&gt;&gt;(\d+)<\/r>/<a href="..\/test\/read.cgi\/$FORM{'bbs'}\/$FORM{'key'}\/$1" target="_blank">&gt;&gt;$1<\/a>/g;
714     $FORM{'MESSAGE'} =~ s/<\/?r>//g;
715     }
716    
717    
718     #==================================================
719     # 情報の修正
720     #==================================================
721    
722     {
723     # UNICODE置き換え
724     $FORM{'mail'} =~ s/&#[x0-9a-fA-F;]+/&;/g;
725     $FORM{'subject'} =~ s/&#[x0-9a-fA-F;]+/&;/g;
726     if ($SETTING{'BBS_UNICODE'} ne "pass"){
727     $FORM{'FROM'} =~ s/&#[x0-9a-fA-F;]+/&;/g;
728     $FORM{'MESSAGE'} =~ s/&#[x0-9a-fA-F;]+/?/g;
729     }
730    
731     # 1行データからは改行を削ります
732     $FORM{'FROM'} =~ s/<br>//g;
733     $FORM{'mail'} =~ s/<br>//g;
734     $FORM{'subject'} =~ s/<br>//g;
735    
736     # デカ文字対策
737     $FORM{'FROM'} =~ s/"/&quot;/g;
738     $FORM{'mail'} =~ s/"/&quot;/g;
739     $FORM{'subject'} =~ s/"/&quot;/g;
740     ##$FORM{'mail'} =~ s/ //g;
741    
742     # 末尾にsjisの1バイト目があったら削る
743     my $check1 = '(?:^|[\0-\200\240-\337])(?:[\201-\237\340-\374]{2})*';
744     my $check2 = '[\201-\237\340-\374]';
745     $FORM{'FROM'} =~ s/($check1)$check2$/$1/g;
746     $FORM{'mail'} =~ s/($check1)$check2$/$1/g;
747     $FORM{'subject'} =~ s/($check1)$check2$/$1/g;
748     $FORM{'MESSAGE'} =~ s/($check1)$check2$/$1/g;
749    
750     # mail欄にpreと入れると<pre>を、teletypeと入れると<tt>を挿入
751     if ($FORM{'mail'} =~ /pre/) {
752     $FORM{'MESSAGE'} = "<pre>$FORM{'MESSAGE'}</pre>";
753     $FORM{'MESSAGE'} =~ s/ <br> / <br>/g;
754     } elsif ($FORM{'mail'} =~ /teletype/) {
755     $FORM{'MESSAGE'} = "<tt>$FORM{'MESSAGE'}</tt>";
756     }
757     }
758    
759    
760     #==================================================
761     # ID・IP表示
762     #==================================================
763    
764     {
765     if ($FORM{'mail'} ne '' && $SETTING{'BBS_FORCE_ID'} ne "checked") {
766     $ID = " ID:???";
767     }
768     if ($SETTING{'BBS_ADMIN_NAME'} && $FLAG{'cap'} =~ /$SETTING{'BBS_ADMIN_NAME'}/) {
769     $ID = " ID:$SETTING{'BBS_ADMIN_ID'}";
770     }
771     if ($SETTING{'BBS_NO_ID'} ne "checked") {
772     $DATE .= $ID;
773     }
774     if ($SETTING{'BBS_DISP_IP'} eq "checked") {
775     $DATE .=" <font size=1>[ $HOST ]</font>";
776     }
777     }
778    
779    
780     #==================================================
781     # ファイル操作(サブジェクトファイル読み込み)
782     #==================================================
783    
784     {
785     use vars qw(@PAGEFILE);
786     use vars qw(%SUBJECT);
787     use vars qw($FILENUM);
788     my ($subtt,$subtm,$subval,$subnum);
789     my ($file, $value, $filename);
790     my $subject = $PATH . "subject.txt";
791     my $keyfile = $FORM{'key'} . ".dat";
792     undef $subtm;
793     undef $subtt;
794    
795     # サブジェクトファイルを読み込む
796     open(SUBR,"<$subject");
797     eval{flock(SUBR,1);};
798     foreach(<SUBR>){
799     chop;
800     ($file, $value) = split /<>/;
801     unless($file){next;}
802     $filename = $DATPATH . $file;
803     if(-e $filename){ # datが存在する場合順番に追加
804     push(@PAGEFILE,$file);
805     $SUBJECT{$file} = $value;
806     }
807     }
808     eval{flock(SUBR,8);};
809     close(SUBR);
810     # サブジェクト数を取得
811     $FILENUM=@PAGEFILE;
812     if($FORM{'subject'}){$FILENUM++;}
813    
814     # ログを定数に揃える
815     if($FILENUM > $KEEPLOGCOUNT){
816     for(my $start=$KEEPLOGCOUNT;$start<$FILENUM;$start++){
817     my ($key,$delfile);
818     $delfile = $DATPATH . $PAGEFILE[$start];
819     unlink($delfile);
820     $key = $PAGEFILE[$start];
821     $key =~ s/([^\.]*)\.dat/$1/;
822     $delfile = $TEMPPATH . $key . ".html";
823     unlink($delfile);
824     }
825     $FILENUM = $KEEPLOGCOUNT;
826     my @temp;
827     @temp = @PAGEFILE[0..$FILENUM];
828     undef @PAGEFILE;
829     @PAGEFILE = @temp;
830     }
831    
832     # サブジェクトが存在するか?
833     unless($FORM{'subject'}){ # 無い場合
834     # データファイルがあるか検証
835     unless(-e "$DATPATH$keyfile"){
836     DispError("ERROR!","ERROR:該当スレッドがありません!");
837     }
838     $subval = $FLAG{'subject'};
839     $subnum = $FLAG{'subnum'};
840     $subnum++;
841     # if($subnum > 999){$subnum++;}
842     }else{
843     # サブジェクトがある場合それは新規スレッドである・・
844     $subval = $FORM{'subject'};
845     $subnum = 1;
846     }
847    
848     # レス数とdat容量が規定値を超えていたらレス数を+1する
849     my $datafile = $DATPATH . $FORM{'key'} . ".dat";
850     if ($subnum > ($SETTING{'BBS_MAX_RES_COUNT'} - 1)) {$subnum++;}
851     if (-s "$datafile" >= ($SETTING{'BBS_MAX_RES_SIZE'} * 1024)) {$subnum++;}
852    
853     $subtt = "$subval ($subnum)";
854     $subtm = "$keyfile<>$subtt";
855    
856     # サブジェクトハッシュを書き換える
857     $SUBJECT{$keyfile}=$subtt;
858    
859     #スレの1と現在のメール欄からデフォルトのモードを判定
860     unless ($FORM{'subject'}) {
861     open (MODE,"../$FORM{'bbs'}/dat/$FORM{'key'}.dat");
862     my @LOG = <MODE>;
863     close (MODE);
864    
865     my $mailcom = (split /<>/,$LOG[0])[1];
866     undef @LOG;
867     if ($mailcom =~/hane/) {$FLAG{'submode'} = 'hane';}
868     elsif ($mailcom =~/kage/) {$FLAG{'submode'} = 'kage';}
869     elsif ($mailcom =~/sage/) {$FLAG{'submode'} = 'sage';}
870     elsif ($mailcom =~/dame/) {$FLAG{'submode'} = 'dame';}
871     else {$FLAG{'submode'} = '';}
872     }
873     if ($FORM{'mail'} =~/^age/) {$FLAG{'submode'} = '';}
874     elsif ($FORM{'mail'} =~/hane/) {$FLAG{'submode'} = 'hane';}
875     elsif ($FORM{'mail'} =~/kage/) {$FLAG{'submode'} = 'kage';}
876     elsif ($FORM{'mail'} =~/sage/) {$FLAG{'submode'} = 'sage';}
877     elsif ($FORM{'mail'} =~/dame/) {$FLAG{'submode'} = 'dame';}
878    
879     # サブジェクトテキストを開く
880     {
881     my $newsub;
882     $newsub = "";
883    
884     # haneのときは適当な場所に飛ばす
885     if ($FLAG{'submode'} eq 'hane') {
886     my (@temp,$random);
887     srand;
888     $random = int(rand (@PAGEFILE - 1));
889     foreach(@PAGEFILE){
890     if(@temp == $random){
891     $temp[@temp]=$keyfile;
892     $newsub .= "$subtm\n";
893     }
894     if($_ ne $keyfile){
895     $temp[@temp]=$_;
896     $newsub .= "$_<>$SUBJECT{$_}\n";
897     }
898     }
899     @PAGEFILE=@temp;
900     # kageのときは真ん中に持ってくる
901     } elsif ($FLAG{'submode'} eq 'kage') {
902     my (@temp,$middle);
903     $middle = int(@PAGEFILE / 2);
904     foreach(@PAGEFILE){
905     if(@temp == $middle){
906     $temp[@temp]=$keyfile;
907     $newsub .= "$subtm\n";
908     }
909     if($_ ne $keyfile){
910     $temp[@temp]=$_;
911     $newsub .= "$_<>$SUBJECT{$_}\n";
912     }
913     }
914     @PAGEFILE=@temp;
915     # sageの時は上がらない
916     } elsif ($FORM{'subject'} eq "" && $FLAG{'submode'} eq 'sage') {
917     foreach(@PAGEFILE){
918     $newsub .= "$_<>$SUBJECT{$_}\n";
919     }
920     # dameの時は一番下に移す
921     } elsif ($FLAG{'submode'} eq 'dame') {
922     my @temp;
923     foreach(@PAGEFILE){
924     if($_ ne $keyfile){
925     $temp[@temp]=$_;
926     $newsub .= "$_<>$SUBJECT{$_}\n";
927     }
928     }
929     $temp[@temp]=$keyfile;
930     $newsub .= "$subtm\n";
931     @PAGEFILE=@temp;
932     # それ以外は全てage(一番上に移す)
933     } else {
934     my @temp;
935     $temp[0]=$keyfile;
936     $newsub = "$subtm\n";
937     foreach(@PAGEFILE){
938     # 上がるキーは一番最初に持ってくる
939     # keyfileは現在書き込みしたスレッドキー(上がっている)
940     if($_ ne $keyfile){
941     $temp[@temp]=$_;
942     $newsub .= "$_<>$SUBJECT{$_}\n";
943     }
944     }
945     @PAGEFILE=@temp;
946     }
947    
948     #一括書き込み(板飛び対策入り)
949     # 読み書きモードでオープン
950     open(SUBW,"+<$subject");
951     eval{flock(SUBW,2);};
952     # ファイルポインタを先頭に
953     seek(SUBW, 0, 0);
954     print SUBW $newsub;
955     # 新ファイルサイズを出力
956     eval{truncate(SUBW, tell(SUBW));};
957     # (念のため)ロック解除はクローズ処理任せに
958     # eval{flock(SUBW,8);};
959     close(SUBW);
960     }
961     # i-mode用テキストを開く
962     {
963     unless(-e $IMODEPATH){
964     mkdir($IMODEPATH,0777);
965     }
966     my $imodeindex = $IMODEPATH . "index.html";
967     open(SUBW,">$imodeindex");
968     eval{flock(SUBW,2);};
969     # 一括書き込み
970     print SUBW "<HTML>\n";
971     print SUBW "<HEAD>\n";
972     print SUBW "<TITLE>$SETTING{'BBS_TITLE'}</TITLE>\n";
973     print SUBW "</HEAD>\n";
974     print SUBW "おんぷちゃんねる i-mode <a href=\"../../../../i/\">トップ</a><hr>";
975     print SUBW "$SETTING{'BBS_TITLE'}<hr>";
976    
977     my ($count,$key,$end,$subtitle);
978     if($FILENUM<30){$end=$FILENUM;}else{$end=30;}
979     for($count=1;$count<=$end;$count++){
980     @PAGEFILE[$count-1]=~ /(\d*)\.dat/;
981     $key = $1;
982     $subtitle = $SUBJECT{@PAGEFILE[$count-1]};
983     &jcode::z2h_sjis(\$subtitle);
984     print SUBW "$count: <a href=\"../../test/read.cgi/$FORM{'bbs'}/$key/i\">$subtitle</a><br>";
985     }
986     $count=@PAGEFILE;
987     if ($count > 30){
988     print SUBW "<hr><a href=\"../../test/pageview.cgi?bbs=$FORM{'bbs'}&page=2&imode=true\">次</a>\n";
989     }
990     print SUBW "<hr>\n";
991     print SUBW <<EOF;
992     <form action="../../test/bbs.cgi" method="POST">
993     <input type=hidden name=bbs value=$FORM{'bbs'}>
994     <input type=hidden name=time value=$NOWTIME>
995     <input type="hidden" name="imode" value="true">
996     タイトル:<input size="10" name="subject" type="text"><br>
997     名前:<input type=text name=FROM size=10><br>
998     mail:<input type=text name=mail size=10><br>
999     コメント<br>
1000     <textarea ROWS=2 COLS=18 NAME=MESSAGE></textarea><br>
1001     <input type="submit" name="submit" value="新スレ作成"><br>
1002     </form>
1003     EOF
1004     print SUBW "<hr></BODY></HTML>\n";
1005     eval{flock(SUBW,8);};
1006     close(SUBW);
1007     # パーミッション調整
1008     chmod(0666,$imodeindex);
1009     }
1010     # 過去ログメニューをかーくー
1011     {
1012     my $sub = $PATH . "subback.html";
1013     open(HED,">$sub");
1014     eval{flock(HED,2);};
1015     print HED<<EOF;
1016     <html><head><meta http-equiv="Content-Type" content="text/html; charset=Shift_JIS"><META HTTP-EQUIV="pragma" CONTENT="no-cache"><META HTTP-EQUIV="Cache-Control" CONTENT="no-cache"></head><body>
1017     <font size=2><base target="body">
1018     EOF
1019     my $dat;
1020     for(my $count=1;$count<=$FILENUM;$count++){
1021     $PAGEFILE[$count-1]=~/(\d+)\.dat/;
1022     $dat=$1;
1023     print HED "<a href=\"../test/read.cgi/$FORM{'bbs'}/$dat/l50\">$count: $SUBJECT{$PAGEFILE[$count-1]}</a> \n";
1024     }
1025     print HED "<div align=\"right\"><a href=\"./kako/index.html\"><b>倉庫はこちら</b></a>";
1026     print HED "</body></html>";
1027     eval{flock(HED,8);};
1028     close(HED);
1029     }
1030     }
1031    
1032    
1033     #==================================================
1034     # クッキー発行
1035     #==================================================
1036    
1037     {
1038     if(!$FLAG{'imode'}){
1039     # クッキー食わせる
1040     if($SETTING{'BBS_NAMECOOKIE_CHECK'} eq "checked"){
1041     print "Set-Cookie: NAME=$FLAG{'FROM'}; expires=$FLAG{'expires'}; path=/\n";
1042     }
1043     if($SETTING{'BBS_MAILCOOKIE_CHECK'} eq "checked"){
1044     print "Set-Cookie: MAIL=$FLAG{'mail'}; expires=$FLAG{'expires'}; path=/\n";
1045     }
1046     }
1047     }
1048    
1049    
1050     #==================================================
1051     # ファイル操作(DATファイル更新)
1052     #==================================================
1053    
1054     {
1055     my $datafile = $DATPATH . $FORM{'key'} . ".dat";
1056    
1057     open(OUT, ">> $datafile");
1058     eval{flock(OUT,2);};
1059    
1060     print OUT "$FORM{'FROM'}<>$FORM{'mail'}<>$DATE<>$FORM{'MESSAGE'}<>$FORM{'subject'}\n";
1061     push(@keytemp,"$FORM{'FROM'}<>$FORM{'mail'}<>$DATE<>$FORM{'MESSAGE'}<>$FORM{'subject'}\n");
1062    
1063     # レス数が規定値を超えるとスレストをかける
1064     if ($FLAG{'subnum'} > ($SETTING{'BBS_MAX_RES_COUNT'} - 2)) {
1065     my $maxres = $SETTING{'BBS_MAX_RES_COUNT'};
1066     my $maxres1 = $maxres + 1;
1067     print OUT "$maxres1<><>Over $maxres Thread<>このスレッドは$maxresを超えました。<br>もう書けないので、新しいスレッドを立ててくださいです。。。<>\n";
1068     push (@keytemp,"$maxres1<><>Over $maxres Thread<>このスレッドは$maxresを超えました。<br>もう書けないので、新しいスレッドを立ててくださいです。。。<>\n");
1069     }
1070    
1071     # dat容量が規定値を超えるとスレストをかける
1072     if (-s "$datafile" >= ($SETTING{'BBS_MAX_RES_SIZE'} * 1024)) {
1073     my $maxsize = $SETTING{'BBS_MAX_RES_SIZE'} . "KB";
1074     print OUT "$maxsize<><>Over $maxsize data<>このスレッドは$maxsizeを超えました。<br>もう書けないので、新しいスレッドを立ててくださいです。。。<>\n";
1075     push (@keytemp,"$maxsize<><>Over $maxsize data<>このスレッドは$maxsizeを超えました。<br>もう書けないので、新しいスレッドを立ててくださいです。。。<>\n");
1076     }
1077    
1078     eval{flock(OUT,8);};
1079     close(OUT);
1080    
1081     # -----------------------------------------------------------------------
1082     if(-e $PATH."log/"){
1083     my $log = $PATH . "log/" . $FORM{'key'} . ".cgi";
1084     my $num=$FLAG{'subnum'};$num++;
1085     open(WIP,">>$log");
1086     eval{flock(WIP,2);};
1087     print WIP "$num<>$ENV{'REMOTE_ADDR'}<>$HOST<>$NOWTIME\n";
1088     eval{flock(WIP,8);};
1089     close(WIP);
1090     chmod(0600,$log);
1091     }
1092     # -----------------------------------------------------------------------
1093    
1094     # パーミッション調整
1095     chmod(0666,$datafile);
1096     chmod(0777,"$DATPATH");
1097     chmod(0777,"$PATH");
1098     }
1099    
1100    
1101     #==================================================
1102     # ファイル操作(HTML作成用作業ファイル更新)
1103     #==================================================
1104    
1105     #HTML用DATを作成
1106     {
1107     MakeWorkFile($FORM{'key'});
1108     #パーミッション調整
1109     chmod(0777,$TEMPPATH);
1110     }
1111    
1112    
1113     #==================================================
1114     # 本HTML吐き処理
1115     #==================================================
1116    
1117     {
1118     use vars qw($INDEXFILE);
1119     $INDEXFILE = $PATH . "index.html";
1120     open(HTM,">$INDEXFILE");
1121     eval{flock(HTM,2);};
1122     print HTM <<EOF;
1123     <HTML>
1124     <HEAD>
1125     <meta http-equiv="Content-Type" content="text/html; charset=Shift_JIS">
1126     <META HTTP-EQUIV="pragma" CONTENT="no-cache">
1127     <SCRIPT LANGUAGE="JavaScript">
1128     <!--
1129     Name = getCookie("NAME");
1130     Mail = getCookie("MAIL");
1131     function getCookie(key, tmp1, tmp2, xx1, xx2, xx3) {
1132     tmp1 = " " + document.cookie + ";";
1133     xx1 = xx2 = 0;
1134     len = tmp1.length;
1135     while (xx1 < len) {
1136     xx2 = tmp1.indexOf(";", xx1);
1137     tmp2 = tmp1.substring(xx1 + 1, xx2);
1138     xx3 = tmp2.indexOf("=");
1139     if (tmp2.substring(0, xx3) == key) {
1140     return(unescape(tmp2.substring(xx3 + 1, xx2 - xx1 - 1)));
1141     }
1142     xx1 = xx2 + 1;
1143     }
1144     return("");
1145     }
1146     // -->
1147     </SCRIPT>
1148     <TITLE>$SETTING{'BBS_TITLE'}</TITLE>
1149     </HEAD>
1150     <BODY TEXT="$SETTING{'BBS_TEXT_COLOR'}" BGCOLOR="$SETTING{'BBS_BG_COLOR'}" link="$SETTING{'BBS_LINK_COLOR'}" alink="$SETTING{'BBS_ALINK_COLOR'}" vlink="$SETTING{'BBS_VLINK_COLOR'}" background="$SETTING{'BBS_BG_PICTURE'}">
1151     EOF
1152    
1153     if($SETTING{'BBS_TITLE_PICTURE'}){
1154     print HTM "<div align=center>";
1155     if($SETTING{'BBS_TITLE_LINK'}){ print HTM "<a href=\"$SETTING{'BBS_TITLE_LINK'}\" border=0>"; }
1156     print HTM "<img src=\"$SETTING{'BBS_TITLE_PICTURE'}\" border=0>";
1157     if($SETTING{'BBS_TITLE_LINK'}){ print HTM "</a>"; }
1158     print HTM "</div>";
1159     }else{
1160     print HTM "<div align=center>";
1161     if($SETTING{'BBS_TITLE_LINK'}){ print HTM "<a href=\"$SETTING{'BBS_TITLE_LINK'}\" border=0>"; }
1162     # print HTM "<FONT COLOR=\"$SETTING{'BBS_TITLE_COLOR'}\"><H1>$SETTING{'BBS_TITLE'}</H1></FONT>";
1163     if($SETTING{'BBS_TITLE_LINK'}){ print HTM "</a>"; }
1164     print HTM "</div>";
1165     }
1166    
1167     print HTM "\n";
1168     print HTM<<EOF;
1169     <table border=1 cellspacing=8 cellpadding=2 width=95% bgcolor="$SETTING{'BBS_MAKETHREAD_COLOR'}" align=center><tr><td align="center">
1170     <form method=POST action="../test/bbs.cgi">
1171     <TABLE BORDER="0" CELLPADDING="1" WIDTH="100%">
1172     <TR><TD nowrap COLSPAN="2">
1173     <font size=+1><b>$SETTING{'BBS_TITLE'}</b></font><br>
1174     EOF
1175     if ($SETTING{'BBS_PROXY_CHECK'} eq "checked") {
1176     print HTM " <font color=#FF0000>■PROXY規制中■</font><br>\n";
1177     }
1178     print HTM " </TD>\n";
1179     print HTM " <TD width=10% ALIGN=\"right\">";
1180     &HTM("../right.txt",1);
1181     print HTM<<EOF;
1182     </TD>
1183     <TD nowrap width=5% ALIGN="right" VALIGN="top"><a href="#menu">■</a> <a href="#1">▼</a></TD>
1184     </TR>
1185     <TR><TD COLSPAN="3">
1186     EOF
1187     &HTM($PATH."head.txt",1);
1188    
1189     print HTM<<EOF;
1190     <br><font color=red>この板の1スレッドの制限は最大$SETTING{'BBS_MAX_RES_COUNT'}レス、または最大$SETTING{'BBS_MAX_RES_SIZE'}KBになっています。</font><br>
1191     EOF
1192    
1193     print HTM " <br></TD></TR>\n";
1194    
1195     if ($SETTING{'BBS_PASSWORD_CHECK'} ne "checked"){
1196     print HTM<<EOF;
1197     <TR>
1198     <TD nowrap ALIGN="right">タイトル:</TD>
1199     <TD COLSPAN="2"><input type="text" name="subject" size="40"> <input type=submit value="新規スレッド作成" name="submit"></TD>
1200     </TR><TR>
1201     <TD nowrap ALIGN="right">名前:</TD>
1202     <TD>
1203     <SCRIPT Language="JavaScript">
1204     <!--
1205     document.write("<INPUT TYPE=text NAME=FROM SIZE=20 VALUE=");
1206     document.write(Name, ">");
1207     // -->
1208     </SCRIPT>
1209     <NOSCRIPT>
1210     <INPUT TYPE=text NAME=FROM SIZE=20>
1211     </NOSCRIPT>
1212     </TD>
1213     <TD nowrap width=45%>E-mail<font size="1">(省略可)</font>:
1214     <SCRIPT Language="JavaScript">
1215     <!--
1216     document.write("<INPUT TYPE=text NAME=mail SIZE=20 VALUE=");
1217     document.write(Mail, ">");
1218     // -->
1219     </SCRIPT>
1220     <NOSCRIPT>
1221     <INPUT TYPE=text NAME=mail SIZE=20>
1222     </NOSCRIPT>
1223     </TD>
1224     <TD><br></TD></TR><TR>
1225     <TD nowrap ALIGN="right" VALIGN="top">内容:</TD>
1226     <TD COLSPAN="2">
1227     <textarea rows=5 cols=60 wrap=OFF name=MESSAGE></textarea>
1228     <input type=hidden name=bbs value=$FORM{'bbs'}>
1229     <input type=hidden name=time value=$NOWTIME>
1230     </TD></TR></TABLE>
1231     EOF
1232     }else{
1233     print HTM<<EOF;
1234     <TD nowrap COLSPAN="5" ALIGN="center">
1235     <input type=submit value="新規スレッド作成画面へ" name="submit">
1236     <input type=hidden name=bbs value=$FORM{'bbs'}>
1237     <input type=hidden name=time value=$NOWTIME>
1238     </TD></TR></TABLE>
1239     EOF
1240     }
1241     &HTM("../bottom.txt",1);
1242     print HTM "\n</form>\n";
1243     my $lp=int($FILENUM / $SETTING{'BBS_THREAD_NUMBER'});
1244     if($FILENUM != $lp * $SETTING{'BBS_THREAD_NUMBER'}){
1245     $lp++;
1246     }
1247     if($lp>1){
1248     print HTM "<a href=\"../test/pageview.cgi?page=$lp&bbs=$FORM{'bbs'}\">最後のページ</a>";
1249     }
1250    
1251     my $nextpage;
1252     if($FILENUM>$SETTING{'BBS_THREAD_NUMBER'}){
1253     $nextpage=1;
1254     print HTM " <a href=\"../test/pageview.cgi?page=2&bbs=$FORM{'bbs'}\">次のページ</a>";
1255     }
1256    
1257     print HTM " <a href=\"subback.html\">スレッド一覧</a>";
1258     print HTM " <a href=\"i/index.html\">i-mode</a>";
1259     print HTM " <a href=\"http://www.2ch.net/guide/faq.html\">FAQ</a>";
1260     print HTM " <a href=\"index.html\">リロード</a>\n";
1261     print HTM "<table border=0 width=100%><tr>";
1262     print HTM "<td align=\"right\"><a href=\"http://onpumoe.hp.infoseek.co.jp/script/\">GlobalNoteScript</a>";
1263     print HTM "</td></tr></table>";
1264     print HTM "</td></TR>\n";
1265     print HTM "</td></tr><tr><td><font size=2>";
1266     &HTM("../bbstable.txt",1);
1267     print HTM <<EOF;
1268     </font></td></tr></table><br>
1269     <a name="menu"></a>
1270     <table border=1 cellspacing=8 cellpadding=2 width=95% bgcolor="$SETTING{'BBS_MENU_COLOR'}"align=center>
1271     <tr><td><font size=2>
1272     EOF
1273    
1274     ### スレッド一覧を吐き出す
1275     #スレッド吐き出し用にファイル数を調整
1276     if($FILENUM > $SETTING{'BBS_MAX_MENU_THREAD'}){
1277     $FILENUM=$SETTING{'BBS_MAX_MENU_THREAD'};
1278     }
1279     my ($dat, $key, $count);
1280     for($count=1;$count<=$FILENUM;$count++){
1281     $dat=$key=$PAGEFILE[$count-1];
1282     $key=~s/([^\.]*)\.dat/$1/;
1283     unless($1){next;}
1284    
1285     if($SETTING{'BBS_THREAD_NUMBER'} >= $count){
1286     print HTM "<a href=\"../test/read.cgi/$FORM{'bbs'}/$key/l50\" target=\"body\">$count:</a> <a href=\"#$count\">$SUBJECT{$dat}</a> \n";
1287     }else{
1288     print HTM "<a href=\"../test/read.cgi/$FORM{'bbs'}/$key/l50\" target=\"body\">$count: $SUBJECT{$dat}</a> \n";
1289     }
1290     }
1291     print HTM "\n";
1292     print HTM "<div align=\"right\"><a href=\"./subback.html\"><b>スレッド一覧はこちら</b></a></font>\n";
1293     print HTM "</td></tr></table><br>\n";
1294    
1295    
1296     my $headad = "../headad.txt";
1297     if(-e $headad){
1298     my @headad;
1299     open(IN, "$headad");
1300     @headad = <IN>;
1301     close(IN);
1302     if (@headad){
1303     print HTM "<table border=1 cellspacing=8 cellpadding=2 width=95% bgcolor=\"$SETTING{'BBS_MENU_COLOR'}\"align=center><tr><td>\n";
1304     foreach(@headad){print HTM;}
1305     print HTM "</td></tr></table><br>\n";
1306     }
1307     }
1308     &HTM("../headad2.txt",1);
1309    
1310     ### スレッドを吐き出す
1311     #スレッド吐き出し用にファイル数を調整
1312     if($FILENUM > $SETTING{'BBS_THREAD_NUMBER'}){
1313     $FILENUM=$SETTING{'BBS_THREAD_NUMBER'};
1314     }
1315     my ($front, $next, $ancnum, $dap, $first, $line);
1316     for(my $contnum = 0;$contnum < $FILENUM;$contnum++){
1317     $front=$contnum;
1318     $next=$contnum+2;
1319     if($front==0){$front=$FILENUM;}
1320     if($next>$FILENUM){$next=1;}
1321     $ancnum=$contnum+1;
1322     $dap = $PAGEFILE[$contnum];
1323     $dap =~ s/([^\.]*)\.dat/$1/;
1324     if (!-e "$TEMPPATH$dap.html") {
1325     MakeWorkFile($dap);
1326     }
1327     print HTM "\n";
1328     open(IN, "$TEMPPATH$dap.html");
1329     $first=<IN>;
1330     $first =~ s/\$ANCOR/$ancnum/g;
1331     $first =~ s/\$FRONT/$front/g;
1332     $first =~ s/\$NEXT/$next/g;
1333     print HTM $first;
1334     print HTM while <IN>;
1335     close(IN);
1336     print HTM <<EOF;
1337     <input type=hidden name=time value=$NOWTIME>
1338     <b>
1339     <a href="../test/read.cgi/$FORM{'bbs'}/$dap/">レスを全部読む</a>
1340     <a href="../test/read.cgi/$FORM{'bbs'}/$dap/l50">最新レス50</a>
1341     <a href="../test/read.cgi/$FORM{'bbs'}/$dap/-100">レス1-100</a>
1342     <a href="#menu">掲示板のトップへ</a> <a href="../$FORM{'bbs'}/./index.html">リロード</a>
1343     </b></form></DL></td></tr></table></TD></TR></DL></TABLE><br>
1344     EOF
1345    
1346     }
1347    
1348     if ($nextpage){
1349     print HTM<<EOF;
1350     <table border=1 cellspacing=8 cellpadding=2 width=95% bgcolor="$SETTING{'BBS_MENU_COLOR'}"align=center>
1351     <tr><td align=center>
1352     <a href="../test/pageview.cgi?page=2&bbs=$FORM{'bbs'}"><font size=5><b>次のページ</b></font></a>
1353     </td></tr>
1354     </table>
1355     EOF
1356     }
1357    
1358     print HTM "<table border=0 align=center><tr><td><center>";
1359    
1360     print HTM "<br><br>";
1361     &HTM("../bottom_ad.txt",1);
1362     print HTM "\n";
1363     print HTM "</center></tr></td></table></body></html>";
1364     eval{flock(HTM,8);};
1365     close(HTM);
1366     &location;
1367    
1368     }
1369    
1370     sub HTM {
1371     my ($file,$h) = @_;
1372     if(-e $file){
1373     if($h){select(HTM);}
1374     open(IN, "$file");
1375     print while <IN>;
1376     close(IN);
1377     if($h){select(STDOUT);}
1378     }
1379    
1380     }
1381    
1382     sub location {
1383     if ($FLAG{'imode'}){
1384     $PATH .= "i/index.html";
1385     # $PATH =~ s/^\.\.\///g;
1386     print "Content-Type: text/html; charset=shift_jis\n\n";
1387     print <<EOF;
1388     <html><head></head><body>
1389     書き込みが完了しました。<br>
1390     <br>
1391     <a href="$PATH">掲示板に戻る</a><br>
1392     <a href="../test/read.cgi/$FORM{'bbs'}/$FORM{'key'}/i">元のスレッドに戻る</a><br>
1393     </body><html>
1394     EOF
1395     }else{
1396     $PATH .= "index.html";
1397     if ($SETTING{'BBS_LOCATION_CHECK'} eq 'checked') {
1398     print "Location: $PATH \n\n";
1399     } else {
1400     print "Content-Type: text/html; charset=shift_jis\n\n";
1401     print <<EOF;
1402     <html><head>
1403     <title>書きこみました。</title>
1404     <meta http-equiv="Content-Type" content="text/html; charset=Shift_JIS">
1405     <META content=$SETTING{'BBS_WAIT_MINUTE'};URL=$PATH http-equiv=refresh></head>
1406     <body bgcolor=#EEEEEE>
1407     書きこみが終わりました。<br><br>画面が切り替わるまでしばらくお待ち下さい。
1408     </body></html>
1409     EOF
1410     }
1411     }
1412     exit;
1413     }
1414    
1415     #エラー画面(エラー処理)
1416     #DispError(TITLE,TOPIC);
1417     sub DispError {
1418     my ($title,$topic)=@_;
1419     print "Content-Type: text/html; charset=shift_jis\n\n";
1420     #-----------------------------------------------------------------------
1421     print <<EOF;
1422     <html>
1423     <head>
1424     <title>$title</title>
1425     <meta http-equiv="Content-Type" content="text/html; charset=Shift_JIS">
1426     </head>
1427     <body bgcolor="#FFFFFF">
1428     <font size=+1 color=#FF0000><b>$topic</b></font><ul>
1429     <b>$FORM{'subject'} </b><br>
1430     名前: $FORM{'FROM'}<br>
1431     E-mail: $FORM{'mail'}<br>
1432     内容:<br>$FORM{'MESSAGE'}<br><br>
1433     </ul><center>こちらでリロードしてください。<a href="../$FORM{'bbs'}/index.html"> GO! </a><br>
1434    
1435     EOF
1436     my $headad = "../headad.txt";if(-e $headad){open(IN, "$headad");print while <IN>;close(IN);}
1437     print <<EOF;
1438     </body>
1439     </html>
1440     EOF
1441     #-----------------------------------------------------------------------
1442     exit;
1443     }
1444    
1445     #作業用ファイル作成
1446     #MakeWorkFile(KEY-NUMBER);
1447     sub MakeWorkFile {
1448     my $key = $_[0];
1449     my $workfile = $TEMPPATH . $key . ".html";
1450     my $datafile = $DATPATH . $key . ".dat";
1451     my (@messx,@content);
1452     my ($mailto,$time,$brmax,$topnum,$firstlog,$lognum,$name,$mail,$subject,$message);
1453     if(!-e $datafile){
1454     open(SHTM,">$workfile");
1455     print SHTM "return";
1456     close(SHTM);
1457     return;
1458     }
1459     open(SHTM,">$workfile");# ログテンポラリを開く
1460     eval{flock(SHTM,2);};
1461    
1462     # ログのカキコ数を取得
1463     $lognum = @keytemp;
1464     # 1つ目の要素を読み込む
1465     $firstlog = $keytemp[0];
1466     # 改行カット
1467     chomp($firstlog);
1468    
1469     # 1つ目の要素を加工する
1470     ($name,$mail,$time,$message,$subject) = split /<>/,$firstlog;
1471     my $check = '(?:^|[\0-\200\240-\337])(?:[\201-\237\340-\374]{2})*';
1472     $message =~ s/($check)(https?|ftp|gopher|telnet|whois|news)\:([\w|\:\!\#\$\%\=\&\-\^\`\\\|\@\~\[\{\]\}\;\+\*\,\.\?\/]+)/$1<a href=\"$2\:$3\" target=\"_blank\">$2\:$3<\/a>/igo;
1473    
1474     # サブジェクトテーブルを吐き出す(ここは必ず1行にまとめること(処理効率))
1475     #-----------------------------------------------------------------------
1476     print SHTM <<EOF;
1477     <TABLE border=1 cellspacing=8 cellpadding=2 width=95% bgcolor="$SETTING{'BBS_THREAD_COLOR'}" align=center><TR><TD><table border=0 width=100%><TR><td nowrap><a name="\$ANCOR"></a><B>[\$ANCOR:$lognum]</B></td><td><B><FONT size=+1 color="$SETTING{'BBS_SUBJECT_COLOR'}">$subject</FONT></B></td><TD nowrap ALIGN="right"><a href ="#menu">■</a><a href="#\$FRONT">▲</a><a href="#\$NEXT">▼</a></td></tr><tr><td colspan=3><DL>
1478     EOF
1479     #-----------------------------------------------------------------------
1480     # 1つ目の要素のメールへのリンクを作成
1481    
1482     # 末尾にsjisの1バイト目があったら削る
1483     my $check1 = '(?:^|[\0-\200\240-\337])(?:[\201-\237\340-\374]{2})*';
1484     my $check2 = '[\201-\237\340-\374]';
1485     $mail =~ s/($check1)$check2$/$1/g;
1486     $name =~ s/($check1)$check2$/$1/g;
1487    
1488     if($mail ne ''){
1489     $mailto = "<a href=\"mailto:$mail\"><b>$name</b></a>";
1490     }else{
1491     $mailto = "<font color=$SETTING{'BBS_NAME_COLOR'}><b>$name</b></font>";
1492     }
1493    
1494     # 1つ目の要素を吐き出す
1495     print SHTM "<dt>1 名前:$mailto 投稿日:$time<dd>$message<br><br><br>\n";
1496    
1497     # ログ数から、表示コンテンツをチェック
1498     if(@keytemp>$SETTING{'BBS_CONTENTS_NUMBER'}){
1499     # ケツの要素を0〜9番までコンテンツに格納
1500     @content[0..$SETTING{'BBS_CONTENTS_NUMBER'}-1] = @keytemp[@keytemp-$SETTING{'BBS_CONTENTS_NUMBER'}..@keytemp-1];
1501     $topnum=@keytemp-($SETTING{'BBS_CONTENTS_NUMBER'}-1);
1502     }else{
1503     # アタマの要素を1〜10番までコンテンツに格納
1504     @content[0..($SETTING{'BBS_CONTENTS_NUMBER'}-1)] = @keytemp[1..$SETTING{'BBS_CONTENTS_NUMBER'}];
1505     $topnum=2;
1506     }
1507    
1508     foreach(@content){
1509     unless($_){
1510     $topnum++;
1511     next;
1512     }
1513     chop;
1514     ($name,$mail,$time,$message,$subject) = split /<>/;
1515     my $check = '(?:^|[\0-\200\240-\337])(?:[\201-\237\340-\374]{2})*';
1516     $message =~ s/($check)(https?|ftp|gopher|telnet|whois|news)\:([\w|\:\!\#\$\%\=\&\-\^\`\\\|\@\~\[\{\]\}\;\+\*\,\.\?\/]+)/$1<a href=\"$2\:$3\" target=\"_blank\">$2\:$3<\/a>/igo;
1517    
1518     # 要素のメールへのリンクを作成
1519    
1520     # 末尾にsjisの1バイト目があったら削る
1521     my $check1 = '(?:^|[\0-\200\240-\337])(?:[\201-\237\340-\374]{2})*';
1522     my $check2 = '[\201-\237\340-\374]';
1523     $mail =~ s/($check1)$check2$/$1/g;
1524     $name =~ s/($check1)$check2$/$1/g;
1525    
1526     if($mail ne ''){
1527     $mailto = "<a href=\"mailto:$mail\"><b>$name</b></a>";
1528     }else{
1529     $mailto = "<font color=$SETTING{'BBS_NAME_COLOR'}><b>$name</b></font>";
1530     }
1531    
1532     print SHTM "<dt>$topnum 名前:$mailto 投稿日:$time<dd>";
1533     $topnum++;
1534    
1535     @messx = split /<br>/,$message;# メッセージを行でカット
1536     if(@messx<$SETTING{'BBS_LINE_NUMBER'}){
1537     print SHTM "$message <br>";
1538     }else{
1539     for(@messx[0..$SETTING{'BBS_LINE_NUMBER'}]){
1540     print SHTM "$_<br>";
1541     }
1542     $topnum--;
1543     if ($mail =~ /pre/) {
1544     print SHTM "</pre>";
1545     } elsif ($mail =~ /teletype/) {
1546     print SHTM "</tt>";
1547     }
1548     print SHTM "<font color=\"$SETTING{'BBS_NAME_COLOR'}\">(省略されました・・全てを読むには<a href=\"../test/read.cgi/$FORM{'bbs'}/$key/$topnum\" target=\"_blank\">ここ</a>を押してください)</font><br>";
1549     $topnum++;
1550     }
1551     print SHTM "<br>\n";
1552     }
1553     #-----------------------------------------------------------------------
1554     print SHTM <<EOF;
1555     <dt><dd><form method=POST action="../test/bbs.cgi">
1556     <input type=submit value="書き込む" name="submit">
1557     名前:
1558     <SCRIPT Language="JavaScript">
1559     <!--
1560     document.write("<INPUT TYPE=text NAME=FROM SIZE=19 VALUE=");
1561     document.write(Name, ">");
1562     // -->
1563     </SCRIPT>
1564     <NOSCRIPT>
1565     <INPUT TYPE=text NAME=FROM SIZE=19>
1566     </NOSCRIPT>
1567     E-mail<font size="1">(省略可)</font>:
1568     <SCRIPT Language="JavaScript">
1569     <!--
1570     document.write("<INPUT TYPE=text NAME=mail SIZE=19 VALUE=");
1571     document.write(Mail, ">");
1572     // -->
1573     </SCRIPT>
1574     <NOSCRIPT>
1575     <INPUT TYPE=text NAME=mail SIZE=19>
1576     </NOSCRIPT>
1577     <ul>
1578     <textarea rows=5 cols=60 wrap=OFF name=MESSAGE></textarea>
1579     </ul>
1580     <input type=hidden name=bbs value=$FORM{'bbs'}>
1581     <input type=hidden name=key value=$key>
1582     EOF
1583     #-----------------------------------------------------------------------
1584     eval{flock(SHTM,8);};
1585     close(SHTM);
1586     # パーミッション調整
1587     chmod(0666,$workfile);
1588     }
1589    
1590     sub hirakata{
1591     # ひらがなとカタカナの相互変換
1592     my ($check, $value, $i, $k, $ii, $kk);
1593     $check = '(?:^|[\0-\200\240-\337])(?:[\201-\237\340-\374]{2})';
1594     $value = "$FORM{'FROM'}<>$FORM{'mail'}<>$FORM{'MESSAGE'}<>$FORM{'subject'}";
1595     &jcode::h2z_sjis(\$value);
1596     $value =~ s/($check)/$1\0/g;
1597     for ( $i = 64; $i <= 147; $i++ ) {
1598     next if $i == 127;
1599     $k = $i + 94;
1600     $k++ if $i <= 126;
1601     $ii = sprintf("%o", $i); $ii = "\\$ii";
1602     $kk = pack("C", $k);
1603     $value =~ s/\203$ii/\202\0$kk\0/g;
1604     }
1605     for ( $i = 159; $i <= 241; $i++ ) {
1606     $k = $i - 94;
1607     $k-- if $i <= 221;
1608     $ii = sprintf("%o", $i); $ii = "\\$ii";
1609     $kk = pack("C", $k);
1610     $value =~ s/\202$ii/\203\0$kk\0/g;
1611     }
1612     $value =~ s/\0//g;
1613     ($FORM{'FROM'}, $FORM{'mail'}, $FORM{'MESSAGE'}, $FORM{'subject'}) = split /<>/, $value;
1614     }

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24