/[suikacvs]/okuchuu/blue-oceans/board-t/board.cgi
Suika

Contents of /okuchuu/blue-oceans/board-t/board.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (hide annotations) (download)
Mon Dec 3 06:23:35 2001 UTC (23 years ago) by wakaba
Branch: MAIN
Branch point for: wakaba
Initial revision

1 wakaba 1.1 #!/usr/bin/perl
2     ## This file is euc-jisx0213 encoding.
3    
4     use Suika::CGI;
5     $myvesion = '1.00 (2001-08-22)';
6    
7     $about_perl = <<"EOH";
8     <address class="version" style="font-size: 50%">
9     FlasH BBS Pro v1.41 [©¦<a href="http://www7.big.or.jp/~jawa/">Shigeto Nakazawa</a>] ¤ò¥Ù¡¼¥¹¤Ë<a href="http://www.ne.jp/asahi/minazuki/bakera/">¿å̵·î¤Ð¤±¤é</a>¤¬²þ¤
10     + <a href="mailto:wakaba\@suika.fam.cx">¼ãÍÕ</a>¤Î quick hack $myversion
11     </address>
12     EOH
13    
14     ## h12-05-06 ¿å̵·î¤Ð¤±¤é <bakera@star.email.ne.jp>
15     ## h09-01-17 ¤¸¤ã¤ï@Ãæß·½Å¿Í <jawa@big.or.jp>
16     ## FlasH BBS Pro 1.41 <http://www7.big.or.jp/~jawa/>
17    
18     #°ìÈÌÀßÄê
19     $max_size = 512 * 1024;
20     $max_msg = 2000;
21     $admin_email = 'blue-oceans@suika.fam.cx';
22     $this_name = 'board';
23     $gif_allnews = '';
24     $gif_news = '';
25     $gif_new_news = '';
26     $gif_width = 20;
27     $gif_height = 14;
28     $default_title = 'Âê̾¤òÆþ¤ì¤Æ²¼¤µ¤¤';
29     $default_name = '¤ªÌ¾Á°¤ò¤É¤¦¤¾';
30     $default_email = 'ÅŻҥᥤ¥ë¥¢¥É¥ì¥¹¤ò¤É¤¦¤¾¡£(¾Êά²Äǽ)';
31     $default_comment = 'ËÜʸ¤ò¤É¤¦¤¾';
32     $arc_dir = './log/';
33     $log_dir = './log/';
34     $base_url = "http://suika.fam.cx/~okuchuu/blue-oceans/";
35     $rfc_base_uri = 'http://dnsbalance.ring.gr.jp/pub/doc/RFC';
36     $logfile = $log_dir.'bo.log';
37    
38     #¥í¥Ã¥¯¥Õ¥¡¥¤¥ë¸¡½Ð»þ¤Î¥ê¥È¥é¥¤²ó¿ô
39     $retry = 3;
40    
41     #ʸ»ú¥³¡¼¥É
42     $mojicode = "euc";
43    
44     #NN2 ¤Ç charset=EUC-JP ¤òÁ÷¤ë¤È²½¤±¤ë¤é¤·¤¤¡£
45     if( $ENV{'HTTP_USER_AGENT'} =~ /compatible/ ){
46     $charset = ';charset=EUC-JP';
47     }elsif( $ENV{'HTTP_USER_AGENT'} =~ /Mozilla\/2.0/ ){
48     $charset = '';
49     }else{
50     $charset = ';charset=EUC-JP';
51     }
52    
53     &read_form;
54    
55     #¥Ñ¥é¥á¡¼¥¿¤Î½èÍý
56     #¥Ç¥Õ¥©¥ë¥È
57     $uri_mode = 'all';
58     $tree = 0;
59     $new_kiji = 10;
60     $max_tree = 10;
61     $nazo = '';
62     $indent = 'ul';
63     $max_depth = 40;
64     $margin = 3;
65    
66     $ID = $OPT{'id'};
67     $uri_query = "id=$ID";
68     $form_query = "<input type=\"hidden\" name=\"id\" value=\"$ID\">";
69     if($OPT{'link'}){
70     $uri_mode = $OPT{'link'};
71     &add_query('link', $uri_mode);
72     }
73     if($OPT{'tree'}){
74     $tree = $OPT{'tree'};
75     &add_query('tree', $tree);
76     }
77     if($OPT{'new_kiji'}){
78     $new_kiji = $OPT{'new_kiji'};
79     &add_query('new_kiji', $new_kiji);
80     }
81     if($OPT{'tmp_new_kiji'}){
82     $new_kiji = $OPT{'tmp_new_kiji'};
83     #¤³¤Î¥Ñ¥é¥á¡¼¥¿¤Ï¥¯¥¨¥ê¡¼¤ËÈ¿±Ç¤·¤Ê¤¤¡£
84     }
85     if($OPT{'max_tree'}){
86     $max_tree = $OPT{'max_tree'};
87     &add_query('max_tree',$max_tree);
88     }
89     if($OPT{'nazo'}){
90     $nazo = $OPT{'nazo'};
91     &add_query('nazo', $nazo) if ( $nazo ne 'only' );
92     }
93     if($OPT{'indent'}){
94     $indent = $OPT{'indent'};
95     &add_query('indent', $indent);
96     }
97     if($OPT{'max_depth'}){
98     $max_depth = $OPT{'max_depth'};
99     &add_query('max_depth', $max_depth);
100     }
101     if($OPT{'margin'}){
102     $margin = $OPT{'margin'};
103     &add_query('margin', $margin);
104     }
105    
106     $cookie_name = 'board';
107     $title = '¥Ö¥ë¡¼¥ª¡¼¥·¥ã¥ó¥º·Ç¼¨ÈÄ';
108     $backurl = '../top';
109     $back_name = 'Ìܼ¡';
110     $html_info = '';
111     $link_element = '';
112     ## Administrator
113     $address_element = "<address><a href=\"mailto:blue-oceans\@suika.fam.cx\">¥Ö¥ë¡¼¥ª¡¼¥·¥ã¥ó¥º</a></address>";
114    
115    
116     $defhead = <<"EOH";
117    
118     <html lang="ja">
119     <head>
120     <title>$title</title>
121     <link rel="stylesheet" type="text/css" href="/s/simpledoc">
122     <link rel="stylesheet" type="text/css" href="../bo-style">
123     <link rel="index" href="../top" />
124     </head>
125     <body>
126     <h1>$title</h1>
127     EOH
128     $def_header_http = <<EOH;
129     Content-Type: text/html; charset=euc-jisx0213
130     Content-Language: ja
131     Content-Style-Type: text/css
132     Content-Script-Type: text/javascript
133    
134     EOH
135    
136     $deffoot = <<"EOH";
137     $address_element
138     $about_perl
139     </body></html>
140     EOH
141    
142     $navi_usage = '<div class="navi"><p>[';
143     $navi_ichiran = "<a href=\"$this_name?$uri_query\">°ìÍ÷ɽ¼¨</a>";
144     $navi_num = " / <a href=\"$this_name?$uri_query;md=num\">ºÇ¿·µ­»ö</a>";
145     $navi_new = " / <a href=\"$this_name?$uri_query;md=new\">¿·µ¬Åê¹Æ</a>";
146     $navi_back = " / <a href=\"$backurl\">$back_name</a> ]</p></div>";
147     $html_navi = "<p class=\"navi\">$navi_usage$navi_ichiran$navi_num$navi_new$navi_back</p>";
148    
149    
150     ##
151    
152     &get_cookie;
153     if ($nazo eq 'only') {&nazo_only; }
154     elsif ($OPT{'md'} eq 'reg') {&regist; }
155     elsif ($OPT{'md'} eq 'del') {&delete; }
156     elsif ($OPT{'md'} eq 'viw') {&view; }
157     elsif ($OPT{'md'} eq 'new') {
158     $html_navi = "<p class=\"navi\">$navi_usage$navi_ichiran$navi_num$navi_back";
159     &html_form('root');
160     }
161     elsif ($OPT{'md'} eq 'set') { &set; }
162     elsif ($OPT{'md'} eq 'num') {
163     $html_navi = "<p class=\"navi\">$navi_usage$navi_ichiran$navi_new$navi_back";
164     &number;
165     }
166     else {
167     $html_navi = "<p class=\"navi\">$navi_usage$navi_num$navi_new$navi_back";
168     &ichiran;
169     }
170     &html_footer;
171     exit 0;
172    
173     # [ ¥Ø¥Ã¥À¡¼Éôʬɽ¼¨ ]
174     #
175    
176     sub html_header {
177     my($sub_title) = @_;
178     my $s;
179     if ($sub_title) {
180     $s = <<"_EOF_";
181     Content-Type: text/html; charset=euc-jisx0213
182     Content-Language: ja
183     Content-Style-Type: text/css
184     Content-Script-Type: text/javascript
185    
186     <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN">
187     <html lang="ja">
188     <head>
189     <link rel="stylesheet" type="text/css" href="/s/simpledoc">
190     <link rel="stylesheet" type="text/css" href="../bo-style">
191     $link_element
192     <title>$title ($sub_title)</title>
193     _EOF_
194    
195     if($indent eq 'css'){
196     my($i, $tmp_margin);
197     $s .= '<style type="text/css"><!--';
198     for( $i = 1; $i <= $max_depth; $i++ ){
199     $tmp_margin = $margin * $i;
200     print ".lv$i\{margin-left:$tmp_margin\%\}";
201     }
202     $s .= '--></style>';
203     }
204     $s .= <<"_EOF_";
205     </head>
206     <body>
207     <h1><a name="top">$title</a></h1>
208     $html_navi
209     <h2>$sub_title</h2>
210     _EOF_
211     return $s;
212     }
213     print $s;
214     }
215    
216     sub html_footer {
217     print<<"_EOF_";
218     $deffoot
219     _EOF_
220     }
221    
222     # [ °ìÍ÷ɽ¼¨ ]
223     #
224    
225     sub ichiran {
226     &set_cookie;
227     local($s) = &html_header('°ìÍ÷ɽ¼¨');
228    
229     #¥í¥°Æɤ߽Ф·
230     open(LOG, $logfile) or &Suika::CGI::Error::die('open', file => $logfile);
231     print $s;
232     my($count, $last_nj);
233     $count = <LOG>;chop($count);
234     $last_nj = <LOG>;chop($last_nj);
235    
236     if( $indent eq 'css' || $indent eq 'ul' ){
237     $prt_elm = 'ul';
238     $cld_elm = 'li';
239     }else{
240     $prt_elm = 'div';
241     $cld_elm = 'p';
242     }
243    
244     print $html_info;
245     print '<div class="set"><h3>µ­»ö°ìÍ÷</h3>';
246     print "<p><em class=\"note\">([Á´]¤òÁªÂò¤¹¤ë¤È´ØÏ¢µ­»ö¤â´Þ¤á¤Æ°ì³çɽ¼¨¤Ç¤­¤Þ¤¹¡£)</em></p>\n";
247     $tree = int($tree/$max_tree) * $max_tree;
248     $end_tree = $tree + $max_tree;
249     my($tree_count) = 0;
250     while (<LOG>) {
251     my($last_lx) = -1;
252     $tree_count++;
253     next if $tree_count <= $tree;
254     next if $tree_count > $end_tree;
255     print "\n<hr>\n<$prt_elm class=\"tree\">";
256     @datas = &divide_log($_);
257     foreach (@datas) {
258     my($no,$res,$lx,$tn,$title,$name,$email,$date,$act) = &divide_data($_);
259     if ( $indent eq 'ul' && $last_lx > -1 ){
260     my($l_diff) = $last_lx - $lx;
261     if( $l_diff < 0 ){
262     print "<$prt_elm>";
263     }elsif( $l_diff > 0){
264     my($i);
265     print "</$cld_elm>";
266     for($i = 1; $i <= $l_diff; $i++){
267     print "</$prt_elm></$cld_elm>";
268     }
269     }else{
270     print "</$cld_elm>";
271     }
272     }
273     if($indent eq 'css'){
274     print "<$cld_elm class=\"lv$lx\">";
275     }else{
276     print "<$cld_elm>";
277     }
278     if ($res eq 'root') {
279     print "[<a href=\"$this_name?$uri_query;md=set;tn=$tn\">Á´</a>]";
280     } elsif ($indent eq 'space') {
281     my($space_width) = $lx * 2 + 2;
282     print '¡¡' x $space_width;
283     }
284     print "<a href=\"$this_name?$uri_query;md=viw;no=$no;tn=$tn\">";
285     if ($no > $count - $new_kiji) {
286     print "[¿·]";
287     } else {
288     print "[¡¦]";
289     }
290     print " $title</a> : ";
291     if ($COOKIE{'name'} eq $name) {
292     print "<strong>$name</strong>"; #¼«Ê¬¤Îµ­»ö¤ò¶¯Ä´É½¼¨
293     } else {
294     print $name;
295     }
296     print " <span class=\"date\">($date)</span>";
297     $last_lx = $lx;
298     }
299     if ( $indent eq 'ul' ){
300     # print "<!--$last_lx-->";
301     my($i);
302     for($i = 1; $i <= $last_lx; $i++){
303     print "</$cld_elm></$prt_elm>";
304     }
305     }
306     print "</$cld_elm></$prt_elm>";
307     }
308     close(LOG);
309     print"</div>\n";
310    
311     &navi_form($tree_count);
312     }
313    
314     # [ ¸ÄÊ̤ǵ­»ö¤ÎÆâÍƤòɽ¼¨¤¹¤ë ]
315     #
316    
317     sub view {
318     local($s) = $def_header_http.$defhead.$html_navi."<h2>µ­»ö$OPT{'no'}</h2>";
319     my(@kiji_datas) = &divide_log(&search_tree);
320     my($kiji_data) = &search_data(@kiji_datas);
321    
322     $s .= &kiji_view($kiji_data);
323     $s .= "<div class=\"comment-navi\">";
324     my($no,$rq_res,$lx,$tn,$title,$name,$email,$date,$rq_act,$file_pwd,$rhost,$ipad,$comment) = &divide_data($kiji_data);
325     foreach (@kiji_datas) {
326     my($no,$res,$lx,$tn,$title,$name,$email,$date,$act,$pwd,$rhost,$ipad,$comment) = &divide_data($_);
327     if ($rq_res == $no) {
328     $parent = "¤³¤Îµ­»ö¤Ï¡Ö<a href=\"$this_name?$uri_query;md=viw;no=$no;tn=$OPT{'tn'}\">$title</a>¡×¤Ø¤Î¥³¥á¥ó¥È¤Ç¤¹¡£";
329     }
330     if (($res == $OPT{'no'}) && ($res ne 'root')) {
331     $children .= "<li>¡Ö<a href=\"$this_name?$uri_query;md=viw;no=$no;tn=$OPT{'tn'}\">$title</a>¡×$name<span class=\"date\">($date)</span></li>";
332     }
333     }
334     if ($rq_res eq 'root') { $parent = '¥ë¡¼¥Èµ­»ö¤Ç¤¹¡£'; }
335     elsif (!$parent) { $parent = '¸µ¤Ë¤Ê¤Ã¤¿µ­»ö¤Ï¤ß¤Ä¤«¤ê¤Þ¤»¤ó¤Ç¤·¤¿¡£'; }
336     if (!$children) { $children = '¥³¥á¥ó¥È¤ÏÅê¹Æ¤µ¤ì¤Æ¤¤¤Þ¤»¤ó¡£</p>'; }
337     else{$children = "°Ê²¼¤Î¥³¥á¥ó¥È¤¬Åê¹Æ¤µ¤ì¤Æ¤¤¤Þ¤¹¡£</p>\n<ul class=\"comment\">$children</ul>";}
338     $s .= <<"_EOF_";
339     <p>$parent
340     $children
341     <hr></div>
342     _EOF_
343     if ($rq_act > 6) {
344     $s .= '<p>¤³¤Îµ­»ö¤ËÂФ·¤Æ¥³¥á¥ó¥È¤òÅê¹Æ¤¹¤ë¤³¤È¤Ï½ÐÍè¤Þ¤»¤ó¡£</p>';
345     return 0;
346     }elsif( $nazo eq 'no' ){
347     $s .= '<!--Æ楹¥±¥ë¥Á¥â¡¼¥É¤Ç¤Ï¥³¥á¥ó¥È¤ÎÅê¹Æ¤Ï½ÐÍè¤Þ¤»¤ó¡£-->';
348     return 0;
349     }
350     if ($title =~ /^[Rr][Ee]\^\d+\:(.*)/) {$title = "Re: $1";}
351     elsif ($title =~ /^[Rr][Ee]\[\d+\]\:(.*)/) {$title = "Re: $1";}
352     elsif ($title =~ /^[Rr][Ee]\:(.*)/) {$title = "Re: $1";}
353     else {$title = "Re: $title"; }
354     $comment = "<br>$comment";
355     $comment =~ s/<br>((&gt;)+)/\n$1&gt;/ig;
356     $comment =~ s/<br>/\n&gt; /ig;
357     $comment =~ s/\n//;
358     $s .= '<p>¤³¤Îµ­»ö¤Ë´Ø¤¹¤ë¥³¥á¥ó¥È¤òÅê¹Æ¤¹¤ë¾ì¹ç¤Ï°Ê²¼¤ÎÅê¹ÆÍó¤Ë½ñ¤­¹þ¤ó¤Ç²¼¤µ¤¤¡£</p>';
359     $s .= &html_form($OPT{'no'},$title,$comment,$OPT{'tn'},$lx,1);
360    
361     #Åê¹Æ¼Ôºï½ü
362     if (crypt($COOKIE{'pwd'},$file_pwd) eq $file_pwd) {
363     $s .= <<"_EOF_";
364     <hr>
365     <form action="./$this_name" method="post">
366     <p>
367     $form_query
368     <input type="hidden" name="md" value="del">
369     <input type="hidden" name="code" value="$OPT{'code'}">
370     <input type="hidden" name="tn" value="$OPT{'tn'}">
371     <input type="hidden" name="no" value="$OPT{'no'}">
372     <input type="hidden" name="pwd" value="$COOKIE{'bbs_pwd'}">
373     <input type="submit" value="¤³¤Îµ­»ö¤ÎÆâÍƤòºï½ü¤¹¤ë">
374     <em class="note">(´°Á´¤Ëºï½ü½ÐÍè¤Ê¤¤¾ì¹ç¤â¤¢¤ê¤Þ¤¹¡£)</em></p>
375     </form>
376     _EOF_
377     }
378    
379     print ($s.$deffoot);
380     exit;
381     }
382    
383     # [ ¥»¥Ã¥Èɽ¼¨ ]
384     #
385    
386     sub set {
387     my($last_lx) = -1;
388     print &html_header('¥»¥Ã¥Èɽ¼¨');
389    
390     if( $indent eq 'css' || $indent eq 'ul' ){
391     $prt_elm = 'ul';
392     $cld_elm = 'li';
393     }else{
394     $prt_elm = 'div';
395     $cld_elm = 'p';
396     }
397    
398     print<<"_EOF_";
399     <div class=\"set\">
400     <h3><a name="list">µ­»ö°ìÍ÷</a></h3>
401     <$prt_elm class="tree">
402     _EOF_
403     @kiji_datas = &divide_log(&search_tree);
404     foreach (@kiji_datas) {
405     my($no,$res,$lx,$tn,$title,$name,$email,$date,$act) = &divide_data($_);
406     my($num_no) = int($no);
407     $reply[$res] .= "$num_no-";
408     if ( $indent eq 'ul' && $last_lx > -1 ){
409     my($l_diff) = $last_lx - $lx;
410     if( $l_diff < 0 ){
411     print "<$prt_elm>";
412     }elsif( $l_diff > 0){
413     my($i);
414     print "</$cld_elm>";
415     for($i = 1; $i <= $l_diff; $i++){
416     print "</$prt_elm></$cld_elm>";
417     }
418     }else{
419     print "</$cld_elm>";
420     }
421     }
422     if($indent eq 'css'){
423     print "<$cld_elm class=\"lv$lx\">";
424     }else{
425     print "<$cld_elm>";
426     }
427     $last_lx = $lx;
428     if ($res ne 'root' && $indent eq 'space') {
429     my($space_width) = $lx * 2 + 2;
430     print '¡¡' x $space_width;
431     }
432     print "<a href=\"#c$num_no\">¡¦ $title</a> : $name <span class=\"date\">($date)</span>";
433     print "</$cld_elm>\n" unless ($indent eq 'ul');
434     }
435     if ( $indent eq 'ul' ){
436     # print "<!--$last_lx-->";
437     my($i);
438     for($i = 1; $i <= $last_lx; $i++){
439     print "</$cld_elm></$prt_elm>";
440     }
441     }else{
442     print "</$prt_elm>";
443     }
444    
445     print"</$cld_elm></$prt_elm></div>\n";
446    
447     foreach $data (@kiji_datas) {
448     my($no,$res,$lx,$tn,$title,$name,$email,$date,$act,$pwd,$rhost,$ipad,$comment) = &divide_data($data);
449     my($num_no) = int($no);
450    
451     print "<p>No.<a name=\"c$num_no\">$num_no</a>";
452     if ($res eq 'root') {
453     print '<em class="note">(¿Æµ­»ö)</em>';
454     } else {
455     $res = int($res);
456     print "<a href=\"#c$res\">¢¥<em>[$res]</em></a>";
457     }
458     if (!$reply[$no]) {
459     print ' / <em class="note">(Ãí¼á¤Ê¤·)</em>';
460     } else {
461     chop($reply[$no]);
462     my(@replys) = split(/-/,$reply[$no]);
463     foreach (@replys) {
464     print " / <a href=\"#c$_\">¢§<em>[$_]</em></a>";
465     }
466     }
467     print "</p>\n";
468    
469     print &kiji_view($data);
470     if( $nazo eq 'no' ){
471     print '<!--Æ楹¥±¥ë¥Á¥â¡¼¥É¤Ç¤Ï¥³¥á¥ó¥È¤ÎÅê¹Æ¤Ï½ÐÍè¤Þ¤»¤ó¡£-->';
472     }else{
473     print "<p><a href=\"$this_name?$uri_query;md=viw;no=$no;tn=$OPT{'tn'}\">¥³¥á¥ó¥È¤òÅê¹Æ</a> / ";
474     }
475     print "<a href=\"#list\">µ­»ö°ìÍ÷</a></p><hr>";
476     }
477     }
478    
479     # [ ºÇ¿·µ­»ö°ì³çµ¡Ç½ ]
480    
481     sub number {
482     print &html_header("ºÇ¿·µ­»ö");
483     print "<p>ºÇ¶á¤Îµ­»ö $new_kiji ·ï¤òɽ¼¨¤·¤Æ¤¤¤Þ¤¹¡£</p>";
484     print '<p>[';
485     my($i,$j,$tmp);
486     for ( $i = 1; $i <= 10; $i++ ){
487     $j = $i * 10;
488     unless ($new_kiji == $j){
489     if($tmp){
490     print ' / ' ;
491     }else{
492     $tmp = 1;
493     }
494     print "<a href=\"$this_name?$uri_query;md=num;tmp_new_kiji=$j\">$j ·ï</a>";
495     }
496     }
497     print ' ]</p>';
498     open(LOG,$logfile) or &error('Æɤ߹þ¤ß¥¨¥é¡¼','¥í¥°¤ÎÆɤ߹þ¤ß¤¬½ÐÍè¤Þ¤»¤ó¡£´ÉÍý¼Ô¤ËÏ¢Íí¤·¤Æ¤¯¤À¤µ¤¤¡£');
499     my($count, $last_nj);
500     $count = <LOG>;chop($count);
501     $last_nj = <LOG>;chop($last_nj);
502     while (<LOG>) {
503     @datas = &divide_log($_);
504     foreach $data (@datas) {
505     my($no,$res,$lx,$tn,$title,$name,$email,$date,$act) = &divide_data($data);
506     if ($no > $count - $new_kiji) {
507     push(@nums,$data);
508     }
509     }
510     last if @nums >= $new_kiji;
511     }
512     close(LOG);
513    
514     @nums = reverse(sort(@nums));
515     print '<ul class="new">';
516     my($list_order);
517     foreach $data (@nums) {
518     my($no,$res,$lx,$tn,$title,$name,$email,$date,$act,$pwd,$rhost,$ipad,$comment) = &divide_data($data);
519     $list_order++;
520     print "<li><p>$list_order: µ­»öNo.$no</p>\n";
521     print &kiji_view($data);
522     print<<"_EOF_";
523     <p><a href="$this_name?$uri_query;md=viw;no=$no;tn=$tn">¥³¥á¥ó¥È¤òÅê¹Æ</a> / <a href="$this_name?$uri_query;md=set;tn=$tn">¥»¥Ã¥È¤Çɽ¼¨</a></p><hr></li>
524     _EOF_
525     }
526     print '</ul>';
527     }
528    
529     # [ Åê¹Æ¥Õ¥©¡¼¥à¤òɽ¼¨ ]
530     #
531    
532     sub html_form {
533     my($no,$title,$comment,$tn,$lx,$c) = (@_);
534     local($s); $s = $def_header_http.$defhead if $c != 1;
535     $s .= '<h2>µ­»ö¤ÎÅê¹Æ</h2>';
536    
537     if ($no eq '') { $no = 'root'; }
538     $title = "($default_title)" unless $title;
539     $comment = "($default_comment)" unless $comment;
540     if($COOKIE{'name'}){
541     $my_name = $COOKIE{'name'};
542     }else{
543     $my_name = "($default_name)";
544     }
545     if($COOKIE{'email'}){
546     $my_email = $COOKIE{'email'};
547     }else{
548     $my_email = "($default_email)";
549     }
550    
551     $nj = time() . '-' . &random_string(8);
552    
553     $s .= <<"_EOF_";
554     <script type="text/javascript" defer="defer"><!--
555     function check(myform){
556     if(!myform.name.value ){
557     alert("Åê¹Æ¼Ô̾¤òµ­Æþ¤·¤Æ¤¯¤À¤µ¤¤¡£");
558     myform.name.focus();
559     return false;
560     } else if(!myform.title.value ){
561     alert("Âê̾¤òµ­Æþ¤·¤Æ¤¯¤À¤µ¤¤¡£");
562     myform.title.focus();
563     return false;
564     } else if(!myform.comment.value ){
565     alert("ËÜʸ¤òµ­Æþ¤·¤Æ¤¯¤À¤µ¤¤¡£");
566     myform.comment.focus();
567     return false;
568     } else {
569     return true;
570     }
571     }
572     //--></script>
573     <form action="./$this_name" method="post" onsubmit="return check(this);">
574     <p><label accesskey="S" for="title">Âê̾(<span class="key">S</span>):</label>
575     <input type="text" name="title" id="title" size="40" maxlength="80" value="$title"></p>
576     <p><label accesskey="N" for="name">̾Á°(<span class="key">N</span>):</label>
577     <input type="text" name="name" id="name" size="40" maxlength="42" value="$my_name"></p>
578     <p><label accesskey="E" for="email">¥á¥¤¥ë(<span class="key">M</span>):</label>
579     <input type="text" name="email" id="email" size="60" maxlength="120" value="$my_email"></p>
580     <p><label accesskey="B" for="comment">ËÜʸ(<span class="key">B</span>):</label>
581     <br><textarea name="comment" id="comment" rows="10" cols="70">$comment</textarea></label></p>
582     <p><input type="submit" value="Á÷¿®">
583     $form_query
584     <input type="hidden" name="md" value="reg"><input type="hidden" name="no" value="$no"><input type="hidden" name="tn" value="$tn"><input type="hidden" name="lx" value="$lx"><input type="hidden" name="pwd" value="$COOKIE{'pwd'}"><input type="hidden" name="nj" value="$nj"><input type="hidden" name="code" value="$OPT{'code'}"></p>
585     </form>
586     _EOF_
587     if ($c == 1) {
588     $s;
589     } else {
590     print ($s);
591     }
592     }
593    
594     # [ µ­»öÆâÍƤòɽ¼¨ ]
595    
596     sub kiji_view {
597     my($data) = @_;
598     my($no,$res,$lx,$tn,$title,$name,$email,$date,$act,$tm_pwd,$rhost,$ipad,$comment) = &divide_data($data);
599     # &jcode'convert(*comment,'euc');
600     $comment = &squelch($comment) if $nazo;
601     $comment =~ s/(<br>|\s|¡¡)+$//g;
602     $comment =~ s/^(>|&gt;)([^<]*)/<q class=\"responce\">&gt;$2<\/q>/g;
603     $comment =~ s/<br>(>|&gt;)([^<]*)/<br><q class=\"responce\">&gt;$2<\/q>/g;
604    
605     #URL ¤Ë¥¢¥ó¥«¡¼¤òÀßÄꤹ¤ë
606     if( $uri_mode eq 'uri' || $uri_mode eq 'all' ){
607     $comment =~ s/(https?|ftp|gopher|telnet|nntp|news)\:([\w|\:\!\#\$\%\=\&\-\^\`\\\|\@\~\[\{\]\}\;\+\*\,\.\?\/]+)/<a href=\"$1\:$2\">$1\:$2<\/a>/ig;
608     }
609     if( $uri_mode eq 'rfc' || $uri_mode eq 'all' ){
610     $comment =~ s/(\W)([Rr][Ff][Cc]\s?)([1-9]\d*)(\W)/$1<a href=\"$rfc_base_uri\/rfc$3.txt\">$2$3<\/a>$4/g;
611     }
612     # &jcode'convert(*comment,$mojicode);
613     if ($email) { $name = "<a href=\"mailto:$email\">$name</a>"; }
614     local($s) = <<"_EOF_";
615     <!-- message start -->
616     <div class="message"><h3 class="subject">$title</h3>
617     <div class="message-header"><p><cite class="from">$name</cite>
618     <span class="date">($date)</span><!--$rhost($ipad)--></p></div>
619     <div class="message-body">
620     <p>$comment</p></div></div>
621     <!-- message end -->
622     _EOF_
623     $s;
624     }
625    
626     # [ µ­»öÅÐÏ¿½èÍý ]
627    
628     sub regist {
629     my($title,$name,$email,$comment,$lx,$tn,$pwd,$ref_url) = ($OPT{'title'},$OPT{'name'},$OPT{'email'},$OPT{'comment'},$OPT{'lx'},$OPT{'tn'},$OPT{'pwd'},$ENV{'HTTP_REFERER'});
630     $title =~ s/^\($default_title\)//;
631     $title =~ s/\r\n//g;
632     $title =~ s/[\r\n]//g;
633     $name =~ s/^\($default_name\)//;
634     $name =~ s/\r\n//g;
635     $name =~ s/[\r\n]//g;
636     $email =~ s/^\($default_email\)//;
637     $email =~ s/\r\n//g;
638     $email =~ s/[\r\n]//g;
639     $comment =~ s/^\($default_comment\)//;
640     $comment =~ s/^\s+//g;
641     $comment =~ s/(\s|¡¡)+$//g;
642     $comment =~ s/\r\n/<br>/g;
643     $comment =~ s/[\r\n]/<br>/g;
644     $lx++;
645     $pwd =~ s/\r\n//g;
646     $pwd =~ s/\r|\n//g;
647     $ref_url =~ s/\?(.|\n)*//g;
648     s/\%7E/\~/g;
649    
650     #Åê¹Æ¥Á¥§¥Ã¥¯
651     if($ENV{'REQUEST_METHOD'} ne "POST"){
652     &method_error();
653     # }elsif($base_url && ($ref_url !~ $base_url)){
654     # &error('ÉÔÀµÅê¹Æ','¥¢¥¯¥»¥¹¤Ï¼õ¤±Æþ¤ì¤é¤ì¤Þ¤»¤ó¤Ç¤·¤¿¡£³°Éô¤«¤é¤ÎÉÔÀµ¤ÊÅê¹Æ¤¬¹Ô¤ï¤ì¤¿²ÄǽÀ­¤¬¤¢¤ê¤Þ¤¹¡£Àµ¤·¤¤Åê¹Æ¤Ç¤â¤³¤Î¥¨¥é¡¼¤¬½Ð¤ë¾ì¹ç¤Ï¡¢¥Ö¥é¥¦¥¶¤¬ Referer ¤òÁ÷½Ð¤¹¤ëÀßÄê¤Ë¤Ê¤Ã¤Æ¤¤¤ë¤«³Îǧ¤·¤Æ¤¯¤À¤µ¤¤¡£');
655     }elsif (length($title) > 80) {
656     $_ = length($title) - 80;
657     &error('Âê̾ÆþÎÏ¥¨¥é¡¼',"Âê̾¤¬Ä¹¤¹¤®¤Þ¤¹¡£$_ ¥Ð¥¤¥Èºï¸º¤·¤Æ¤¯¤À¤µ¤¤¡£");
658     }elsif (!$title) {
659     &error('Âê̾ÆþÎÏ¥¨¥é¡¼','Âê̾¤¬ÆþÎϤµ¤ì¤Æ¤¤¤Þ¤»¤ó¡£');
660     }elsif (!$name) {
661     &error('Åê¹Æ¼Ô̾ÆþÎÏ¥¨¥é¡¼','Åê¹Æ¼Ô̾¤¬ÆþÎϤµ¤ì¤Æ¤¤¤Þ¤»¤ó¡£');
662     }elsif (length($name) > 42) {
663     $_ = length($name) - 42;
664     &error('Åê¹Æ¼Ô̾ÆþÎÏ¥¨¥é¡¼',"Åê¹Æ¼Ô̾¤¬Ä¹¤¹¤®¤Þ¤¹¡£$_ ¥Ð¥¤¥Èºï¸º¤·¤Æ¤¯¤À¤µ¤¤¡£");
665     }elsif ($email && $email !~ /\w[\w\.\-]*\@\w[\w\.\-]*\.\w+/){
666     &error('¥á¡¼¥ë¥¢¥É¥ì¥¹ÆþÎÏ¥¨¥é¡¼','¥á¡¼¥ë¥¢¥É¥ì¥¹¤Î½ñ¼°¤¬ÉÔÀµ¤Ç¤¹¡£Á´³Ñʸ»ú¤ò»È¤Ã¤Æ¤¤¤Ê¤¤¤«¡¢¶õÇò¤ò´Þ¤á¤Æ¤¤¤Ê¤¤¤«³Îǧ¤·¤Æ¤¯¤À¤µ¤¤¡£');
667     }elsif (length($email) > 120) {
668     $_ = length($email) - 120;
669     &error('¥á¡¼¥ë¥¢¥É¥ì¥¹ÆþÎÏ¥¨¥é¡¼',"¥á¡¼¥ë¥¢¥É¥ì¥¹¤¬Ä¹¤¹¤®¤Þ¤¹¡£$_ ¥Ð¥¤¥Èºï¸º¤·¤Æ¤¯¤À¤µ¤¤¡£");
670     }elsif (!$comment) {
671     &error('ËÜʸÆþÎÏ¥¨¥é¡¼','ËÜʸ¤¬ÆþÎϤµ¤ì¤Æ¤¤¤Þ¤»¤ó¡£¶õÇò¤Î¤ß¤ÎÅê¹Æ¤Ï½ÐÍè¤Þ¤»¤ó¡£');
672     }elsif (length($comment) > $max_msg) {
673     $_ = length($comment) - $max_msg;
674     &error('ËÜʸÆþÎÏ¥¨¥é¡¼',"ËÜʸ¤¬Ä¹¤¹¤®¤Þ¤¹¡£$_ ¥Ð¥¤¥Èºï¸º¤·¤Æ¤¯¤À¤µ¤¤¡£");
675     }elsif ((!$pwd) || (length($pwd) > 8)) { $pwd = &random_string(8); }
676     my($salt) = &random_string(2);
677     $file_pwd = crypt($pwd,$salt);
678     &get_date;
679    
680     open(LOG,$logfile) or &error('Æɤ߹þ¤ß¥¨¥é¡¼','¥í¥°¤ÎÆɤ߹þ¤ß¤¬½ÐÍè¤Þ¤»¤ó¡£´ÉÍý¼Ô¤ËÏ¢Íí¤·¤Æ¤¯¤À¤µ¤¤¡£');
681     my($count, $last_nj);
682     $count = <LOG>;chop($count);
683     $last_nj = <LOG>;chop($last_nj);
684     my(@all_log) = <LOG>;
685     close(LOG);
686    
687     $this_nj = $OPT{'nj'};
688    
689     if (++$count > 9999) {
690     &error('µ­»ö¥«¥¦¥ó¥¿¤Î¥ª¡¼¥Ð¡¼¥Õ¥í¡¼','ÅÐÏ¿µ­»ö¿ô¤¬ 10,000 ¤Ë㤷¤¿¤¿¤á¡¢Åê¹Æ¤ò¼õ¤±ÉÕ¤±¤ë¤³¤È¤¬½ÐÍè¤Þ¤»¤ó¡£Åê¹Æ¤ò¼õ¤±ÉÕ¤±¤ë¤Ë¤Ï¡¢´û¸¤Îµ­»ö¤òºÆÊÔÀ®¤·¤Æ·Ç¼¨ÈĤκÇŬ²½¤ò¹Ô¤¦É¬Íפ¬¤¢¤ê¤Þ¤¹¡£´ÉÍý¼Ô¤ËÏ¢Íí¤·¤Æ¤¯¤À¤µ¤¤¡£');
691     # }elsif ($this_nj eq $last_nj){
692     # &error('Æó½ÅÅê¹Æ','Æó½ÅÅê¹Æ¤Ç¤¹¡£Åê¹Æ¥Ü¥¿¥ó¤¬Ï¢ÂǤµ¤ì¤Æ¤·¤Þ¤Ã¤¿²ÄǽÀ­¤¬¤¢¤ê¤Þ¤¹¡£°ìÍ÷ɽ¼¨¤ò¥ê¥í¡¼¥É¤·¤Æµ­»ö¤¬Åê¹Æ¤µ¤ì¤¿¤«³Îǧ¤·¤Æ¤¯¤À¤µ¤¤¡£ºÆÅê¹Æ¤ÎºÝ¤Ï¡¢Åê¹Æ¥Õ¥©¡¼¥à¤ò¥ê¥í¡¼¥É¤·¤ÆÅê¹Æ¤ò¤ä¤êľ¤·¤Æ¤¯¤À¤µ¤¤¡£');
693     }
694    
695     my($kiji_no) = substr("0000",length($count)).$count;
696    
697     $rhost = $ENV{'REMOTE_HOST'};
698     $ipad = $ENV{'REMOTE_ADDR'};
699    
700     if ($OPT{'no'} eq 'root') {
701     $kiji_data = "$kiji_no<>root<>0<>$kiji_no<>$title<>$name<>$email<>$date_now<>0<>$file_pwd<>$rhost<>$ipad<>$comment\n";
702     unshift(@all_log,$kiji_data);
703     } else {
704     foreach $tree (@all_log) {
705     if ($tn == (split(/<>/,$tree))[0]) {
706     @datas = &divide_log($tree);
707     $flag1 = 0; $flag2 = 0;
708     $kiji_data = "$kiji_no<>$OPT{'no'}<>$lx<>$tn<>$title<>$name<>$email<>$date_now<>0<>$file_pwd<>$rhost<>$ipad<>$comment";
709     foreach $data (@datas) {
710     if (($flag2 == 1) && ($temp_lx >= (split(/<>/,$data))[2])){
711     $tree_data = "$tree_data<#>$kiji_data";
712     $flag2 = 2;
713     }
714     if ($flag1) { $tree_data = "$tree_data<#>$data"; }
715     else { $tree_data = $data; $flag1 = 1; }
716     if (($OPT{'no'} == (split(/<>/,$data))[0]) && (!$flag2)) {
717     $flag2 = 1; $temp_lx = (split(/<>/,$data))[2];
718     }
719     }
720     if ($flag2 == 1){ $tree_data = "$tree_data<#>$kiji_data"; }
721     unshift (@new,"$tree_data\n");
722     }
723     else { push (@new,$tree); }
724     }
725     @all_log = @new;
726     }
727    
728     #ÍÆÎÌ¥ª¡¼¥Ð¡¼¤·¤¿µ­»ö¤òºï½ü
729     if ($max_size < 1500) { $max_size = 1500; }
730     $size = -s $logfile;
731     while ($size > $max_size){
732     my($delete) = pop(@all_log);
733     $size -= length($delete);
734     &delete_log($delete);
735     }
736     &write_file($count, $this_nj, @all_log);
737    
738     $COOKIE{'name'} = $name;
739     $COOKIE{'email'} = $email;
740     $COOKIE{'pwd'} = $pwd;
741     &set_cookie;
742     local($s) = $def_header_http.$defhead.$html_navi.'<h2>Åê¹Æ¤Î¼õÍý</h2>';
743     $s .= <<"_EOF_";
744     <p>¸æÅê¹ÆÍ­Æñ¤¦¤´¤¶¤¤¤Þ¤¹¡£°Ê²¼¤ÎÆâÍƤò¼õÍý¤·¤Þ¤·¤¿¡£</p>
745     _EOF_
746     $s .= &kiji_view($kiji_data);
747     print ($s.$deffoot);
748     exit;
749     }
750    
751     # [ Åê¹Æ¼Ôºï½ü½èÍý ]
752    
753     sub delete {
754     my(@kiji_datas) = &divide_log(&search_tree);
755     my($kiji_data) = &search_data(@kiji_datas);
756     my($no,$res,$lx,$tn,$title,$name,$email,$date,$act,$file_pwd,$rhost,$ipad,$comment) = &divide_data($kiji_data);
757     if (crypt($COOKIE{'pwd'},$file_pwd) ne $file_pwd) {
758     &error('ºï½ü¥¨¥é¡¼','»ØÄꤷ¤¿µ­»ö¤Îºï½ü¤Ï¤Ç¤­¤Þ¤»¤ó¡£´û¤Ëºï½ü¤µ¤ì¤Æ¤¤¤Ê¤¤¤«³Îǧ¤·¤Æ¤¯¤À¤µ¤¤¡£¤É¤¦¤·¤Æ¤âºï½ü¤·¤¿¤¤¾ì¹ç¤Ï´ÉÍý¼Ô¤ËÏ¢Íí¤·¤Æ¤¯¤À¤µ¤¤¡£');
759     }
760     &get_date;
761    
762     #¾Úµò¤ò»Ä¤·¤Æ¤ª¤¯¡£
763     &delete_log($kiji_data);
764    
765     open(LOG,$logfile) or &error('Æɤ߹þ¤ß¥¨¥é¡¼','¥í¥°¤ÎÆɤ߹þ¤ß¤¬½ÐÍè¤Þ¤»¤ó¡£´ÉÍý¼Ô¤ËÏ¢Íí¤·¤Æ¤¯¤À¤µ¤¤¡£');
766     my($count, $last_nj);
767     $count = <LOG>;chop($count);
768     $last_nj = <LOG>;chop($last_nj);
769     my($delete_notice);
770     if (@kiji_datas == 1) {
771     while (<LOG>) {
772     unless (/^$OPT{'no'}/) { push(@new,$_); }
773     }
774     $delete_notice = '<p>µ­»ö¤Ï¥Ä¥ê¡¼¤ò¹½À®¤·¤Æ¤¤¤Ê¤«¤Ã¤¿¤¿¤á¡¢´°Á´¤Ë¾ÃÌǤ·¤Æ¤¤¤Þ¤¹¡£</p>';
775     } else {
776     my($kiji_data) = "$no<>$res<>$lx<>$tn<><del datetime=\"$datetime\">$title</del><em>(Åê¹Æ¼Ôºï½ü)</em><>$name<><>$date<>8<>Null<>$rhost<>$ipad<>Åê¹Æ¼Ô¤Ë¤è¤Ã¤Æºï½ü¤µ¤ì¤Þ¤·¤¿¡£(ºï½ü: $date_now)";
777     my($flag) = 0;
778     my($tree_data);
779     foreach (@kiji_datas) {
780     if ($flag) { $tree_data .= "<#>"; } else { $flag = 1; }
781     if (/^$OPT{'no'}/) { $tree_data .= $kiji_data; }
782     else { $tree_data .= $_; }
783     }
784     $tree_data =~ s/\n//;
785     while (<LOG>) {
786     if (!/^$OPT{'tn'}/) { push(@new,$_); }
787     else { push(@new,"$tree_data\n"); }
788     }
789     $delete_notice = '<p>µ­»ö¤Ï¥Ä¥ê¡¼¤Î°ìÉô¤ò¹½À®¤·¤Æ¤¤¤¿¤¿¤á¡¢(Åê¹Æ¼Ôºï½ü) ¤È¤¤¤¦µ­»ö¤Ëº¹¤·Âؤ¨¤é¤ì¤Æ¤¤¤Þ¤¹¡£</p>';
790     }
791     close(LOG);
792     &write_file($count, $this_nj, @new);
793     print &html_header("Åê¹Æ¼Ôºï½ü");
794     print<<"_EOF_";
795     <hr>
796     <p>µ­»ö No.$OPT{'tn'}¡Ö$title¡×¤òºï½ü¤·¤Þ¤·¤¿¡£</p>
797     $delete_notice
798     <p><a href="$this_name?$uri_query">°ìÍ÷ɽ¼¨</a>¤ò¥ê¥í¡¼¥É¤·¤Æ¡¢µ­»ö¤¬ºï½ü¤µ¤ì¤¿¤³¤È¤ò³Îǧ¤·¤Æ¤¯¤À¤µ¤¤¡£</p>
799     <hr>
800     _EOF_
801     }
802    
803     # [ ¥Ç¡¼¥¿½èÍý´ØÏ¢ÈÆÍÑ¥µ¥Ö ]
804    
805     sub divide_log {
806     my($data) = @_;
807     chop($data);
808     return split(/<#>/,$data);
809     }
810     sub divide_data {
811     my $data = @_;
812     return split(/<>/,$_[0]);
813     }
814    
815     sub search_data {
816     my(@kiji_datas) = @_;
817     my($search_data_no) = $OPT{'no'};
818     my($hit_data);
819     foreach(@kiji_datas){
820     if ( /^$search_data_no/ ) {
821     $hit_data = $_;
822     last;
823     }
824     }
825     return $hit_data;
826     }
827    
828     sub search_tree {
829     my($search_tree_no) = $OPT{'tn'};
830     my($hit_data);
831     open(LOG,$logfile) or &error('Æɤ߹þ¤ß¥¨¥é¡¼','¥í¥°¤ÎÆɤ߹þ¤ß¤¬½ÐÍè¤Þ¤»¤ó¡£´ÉÍý¼Ô¤ËÏ¢Íí¤·¤Æ¤¯¤À¤µ¤¤¡£');
832     my($count, $last_nj);
833     $count = <LOG>;chop($count);
834     $last_nj = <LOG>;chop($last_nj);
835     while (<LOG>) {
836     if ( /^$search_tree_no/ ){
837     $hit_data = $_;
838     last;
839     }
840     }
841     close(LOG);
842     return $hit_data;
843     }
844    
845     # [ ¥Õ¥©¡¼¥à¤«¤é¥Ç¡¼¥¿¼èÆÀ ]
846    
847     sub read_form {
848     %OPT = %Suika::CGI::param;
849     return;
850     my($pair,$buffer);
851     if ($ENV{'REQUEST_METHOD'} eq "POST") { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
852     } else { $buffer = $ENV{'QUERY_STRING'}; }
853     my(@pairs) = split(/[&;]/,$buffer); #¥Ñ¥é¥á¡¼¥¿¶èÀÚ¤ê¤Ë ; ¤ò»È¤¨¤ë¤è¤¦¤Ë²þ¤¡£
854     foreach $pair (@pairs) {
855     my($name,$value) = split(/=/,$pair);
856     $value =~ tr/+/ /;
857     $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
858     $OPT{$name} = &change_code($value);
859     }
860     }
861    
862     # [ ¥¯¥Ã¥­¡¼½èÍý ]
863    
864     sub get_cookie {
865     my($pair,%DUMMY);
866     my($cookies) = $ENV{'HTTP_COOKIE'};
867     my(@pairs) = split(/;/,$cookies);
868     foreach $pair (@pairs) {
869     my($name,$value) = split(/=/,$pair);
870     $name =~ s/ //g;
871     $value =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack("C", hex($1))/eg;
872     $DUMMY{$name} = $value;
873     }
874     @pairs = split(/,/,$DUMMY{$cookie_name});
875     foreach $pair (@pairs) {
876     my($name,$value) = split(/:/,$pair);
877     $COOKIE{$name} = &change_code($value);
878     }
879     }
880     sub set_cookie {
881     my($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime(time + 30*24*60*60);
882     $year += 100 if $year < 99;
883     $year += 1900;
884     $sec = "0$sec" if $sec < 10;
885     $min = "0$min" if $min < 10;
886     $hour = "0$hour" if $hour < 10;
887     $mday = "0$mday" if $mday < 10;
888     $mon = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec')[$mon];
889     $youbi = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday')[$wday];
890     $date_gmt = "$youbi, $mday\-$mon\-$year $hour:$min:$sec GMT";
891     my($cook);
892     foreach $valname ('name','email','pwd'){
893     my($tmp) = $COOKIE{$valname};
894     $tmp =~ s/(\W)/sprintf("%%%02X", unpack("C", $1))/eg;
895     $cook .= "$valname:$tmp,";
896     }
897     print "Set-Cookie: $cookie_name=$cook; expires=$date_gmt\n";
898     }
899    
900     # [ ʸ»ú¥³¡¼¥É´ØÏ¢ ]
901    
902     sub change_code {
903     my($text)=$_[0];
904     &jcode'convert(*text,$mojicode);
905     $text =~ s/&/&amp;/g;
906     $text =~ s/</&lt;/g;
907     $text =~ s/>/&gt;/g;
908     return $text;
909     }
910    
911     # [ ÆüÉÕ¼èÆÀ ]
912    
913     sub get_date {
914     $ENV{'TZ'} = "JST-9"; # TimeZone (ÆüËÜ»þ´Ö = ¹ñºÝɸ½à»þ(JST) - 9»þ´Ö)
915     my($sec,$min,$hour,$day,$mon,$year) = localtime();
916     if ($year < 99) { $year += 100; }
917     $year += 1900;
918     $mon++;
919     $sec = "0$sec" if $sec < 10;
920     $min = "0$min" if $min < 10;
921     $hour = "0$hour" if $hour < 10;
922     $mon = "0$mon" if $mon < 10;
923     $day = "0$day" if $day < 10;
924     $date_now = "$year/$mon/$day $hour:$min:$sec";
925     $datetime = "$year-$mon-${day}T$hour:$min:$sec+09:00";
926     }
927    
928     # [ µ­Ï¿¥Õ¥¡¥¤¥ë¤Î½èÍý ]
929    
930     sub write_file {
931     my($count,$this_nj,@lines) = @_;
932    
933     #¥×¥í¥»¥¹ID ¤«¤é¥Æ¥ó¥Ý¥é¥ê¥Õ¥¡¥¤¥ë̾¤òÀ¸À®
934     $pros = $$;
935     $pros = time unless $pros;
936     $tmp_file = "$ID$pros.tmp";
937    
938     #¾¤Î¥Æ¥ó¥Ý¥é¥ê¥Õ¥¡¥¤¥ë¤ò¸¡º÷
939     opendir(DIR,$log_dir) or &error('¥·¥¹¥Æ¥à¥¨¥é¡¼','ºî¶È¥Ç¥£¥ì¥¯¥È¥ê¤Î¥ª¡¼¥×¥ó¤Ë¼ºÇÔ¤·¤Þ¤·¤¿¡£´ÉÍý¼Ô¤¬²¿¤«¤ò˺¤ì¤Æ¤¤¤ë²ÄǽÀ­¤¬¤¢¤ê¤Þ¤¹¡£');
940     @list = readdir(DIR);
941     closedir(DIR);
942     unless (@list) { &error('¥·¥¹¥Æ¥à¥¨¥é¡¼','ºî¶È¥Ç¥£¥ì¥¯¥È¥ê¤¬´°Á´¤Ë¶õ¤Ç¤¹¡£'); }
943     @lists = grep(/$ID.*\.tmp/,@list);
944    
945     #¥Æ¥ó¥Ý¥é¥ê¥Õ¥¡¥¤¥ë¤¬¤¢¤ë¾ì¹ç
946     my($retry_counter) = $retry;
947     while (@lists) {
948     if (--$retry_counter <= 0) {
949     #¤·¤Ó¤ì¤òÀڤ餷¤¿
950     foreach (@lists) {
951     #¥Æ¥ó¥Ý¥é¥ê¥Õ¥¡¥¤¥ë¤òËõ»¦
952     unlink("$log_dir$_") if (-e "$log_dir$_");
953     }
954     &error('¥Ó¥¸¡¼','¤¿¤Àº£º®»¨¤·¤Æ¤¤¤Þ¤¹¡£»þ´Ö¤ò¤ª¤¤¤ÆºÆÅټ¹Ԥ·¤Æ¤¯¤À¤µ¤¤¡£');
955     }
956     sleep(1);
957     opendir(DIR,"$log_dir");
958     @list = readdir(DIR);
959     closedir(DIR);
960     @lists = grep(/$ID.*\.tmp/,@list);
961     }
962    
963     #¥Æ¥ó¥Ý¥é¥ê¥Õ¥¡¥¤¥ë¤Ë½ñ¤­¹þ¤à
964     open(WRITE,">$log_dir$tmp_file") or &error('½ñ¤­¹þ¤ß¥¨¥é¡¼','µ­Ï¿¥Õ¥¡¥¤¥ë¤Î½ñ¤­¹þ¤ß¤¬½ÐÍè¤Þ¤»¤ó¡£´ÉÍý¼Ô¤ËÏ¢Íí¤·¤Æ¤¯¤À¤µ¤¤¡£');
965     print WRITE "$count\n";
966     print WRITE "$this_nj\n";
967     print WRITE @lines;
968     close(WRITE);
969    
970     #¤â¤¦°ìÅÙ¾¤Î¥Æ¥ó¥Ý¥é¥ê¥Õ¥¡¥¤¥ë¤ò¸¡º÷
971     opendir(DIR,$log_dir);
972     @list = readdir(DIR);
973     closedir(DIR);
974     @lists = grep(/$ID.*\.tmp/,@list);
975     @lists = grep(!/$tmp_file/,@lists);#¼«Ê¬¼«¿È¤Ï½ü³°
976     if (@lists) {#¾¤Ç½ñ¤­¹þ¤ßÃæ¤Ç¤¢¤ì¤Ð½ñ¤­¹þ¤ß¤òÃæ»ß¤·¤Æ½ªÎ»
977     unlink("$log_dir$tmp_file") if (-e "$log_dir$tmp_file");
978     &error('½ñ¤­¹þ¤ß¤Î¶¥¹ç','Ê̤νñ¤­¹þ¤ß¤Î½èÍýÃæ¤Ç¤¹¡£¤¹¤³¤·»þ´Ö¤ò¤ª¤¤¤Æ¤«¤é¡¢ºÆÅÙ¤´ÍøÍѲ¼¤µ¤¤¡£');
979     }
980     rename("$log_dir$tmp_file",$logfile) or &error('½ñ¤­¹þ¤ß¤Î¶¥¹ç','½ñ¤­¹þ¤ß¤Ë¼ºÇÔ¤·¤Þ¤·¤¿¡£ºÆÅټ¹Ԥ·¤Æ¤¯¤À¤µ¤¤¡£');
981     chmod 0666, $logfile;
982     }
983    
984     sub delete_log{
985     my($delete) = @_;
986     open(WRITE,">> $arc_dir${ID}.txt") or &error('¥¨¥é¡¼','ºï½ü¥í¥°¤Î¥·¥¹¥Æ¥à¥¨¥é¡¼¤Ç¤¹¡£´ÉÍý¼Ô¤ËÏ¢Íí¤·¤Æ¤¯¤À¤µ¤¤¡£');
987     @datas = &divide_log($delete);
988     @datas = sort(@datas);
989     foreach $data (@datas) {
990     my($no,$res,$lx,$tn,$title,$name,$email,$date,$act,$pwd,$rhost,$ipad,$comment) = &divide_data($data);
991     print WRITE "No:$no $title\n";
992     print WRITE "$date";
993     print WRITE "$res ¤Ø¤Î¥³¥á¥ó¥È" unless ($res eq 'root');
994     print WRITE "\n";
995     $comment =~ s/<br>/\n/g;
996     $comment =~ s/&gt;/>/g;
997     $comment =~ s/&lt;/</g;
998     $comment =~ s/&amp;/&/g;
999     print WRITE "$comment\n\n";
1000     }
1001     close(WRITE);
1002     }
1003    
1004     sub random_string{
1005     my($str_length) = @_;
1006     my($str,$i);
1007     srand();
1008     for ($i=0; $i<$str_length; $i++){
1009     $str .= substr('abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789./', int(rand(64)),1);
1010     }
1011     return $str;
1012     }
1013    
1014     # [ ¥¨¥é¡¼½èÍý ]
1015    
1016     sub error {
1017     my($err_msg,$err_description) = @_;
1018     print<<"_EOF_";
1019     Content-type: text/html; $charset_code
1020     Content-Language: ja
1021    
1022     <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN"
1023     "http://www.w3.org/TR/html4/strict.dtd">
1024     <html lang="ja">
1025     <head>
1026     $link_element
1027     <link rel="stylesheet" type="text/css" href="/s/simpledoc">
1028     <link rel="stylesheet" type="text/css" href="../bo-style">
1029     <title>(¥¨¥é¡¼Êó¹ð)</title>
1030     </head>
1031     <body>
1032     <h1><a name="top">¥¨¥é¡¼</a></h1>
1033     <h2>$err_msg</h2>
1034     <p>$err_description</p>
1035     _EOF_
1036     &html_footer;
1037     exit;
1038     }
1039    
1040     sub method_error{
1041     print<<"_EOF_";
1042     Status: 405 Method Not Allowed
1043     Allow: POST
1044     Content-type: text/html; $charset_code
1045     Content-Language: ja
1046    
1047     <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN"
1048     "http://www.w3.org/TR/html4/strict.dtd">
1049     <html lang="ja">
1050     <head>
1051     <link rel="stylesheet" type="text/css" href="/s/simpledoc">
1052     <link rel="stylesheet" type="text/css" href="../bo-style">
1053     <title>(¥¨¥é¡¼Êó¹ð)</title>
1054     </head>
1055     <body>
1056     <h1><a name="top">¥¨¥é¡¼</a></h1>
1057     <h2>ÉÔÀµÅê¹Æ</h2>
1058     <p>¥¢¥¯¥»¥¹¤Ï¼õ¤±Æþ¤ì¤é¤ì¤Þ¤»¤ó¤Ç¤·¤¿¡£³°Éô¤«¤é¤ÎÉÔÀµ¤ÊÅê¹Æ¤¬¹Ô¤ï¤ì¤¿²ÄǽÀ­¤¬¤¢¤ê¤Þ¤¹¡£</p>
1059     _EOF_
1060     &html_footer;
1061     exit;
1062     }
1063    
1064     sub navi_form{
1065     my($tree_count) = @_;
1066     my($this_page,$page_navi);
1067     my($tmp_query) = $uri_query;
1068     $tmp_query =~ s/;tree=\d+//;
1069     if($tree_count){
1070     for ($i = 0; $i < $tree_count; $i += $max_tree) {
1071     $j = $i / $max_tree + 1;
1072     if ($tree == $i) {
1073     $this_page = $j;
1074     } else {
1075     $page_navi .= "/ <a href=\"$this_name?$tmp_query;tree=$i\">$j¥Ú¡¼¥¸</a>\n"
1076     }
1077     }
1078     }
1079     $page_navi .= "( $this_page / $j ¥Ú¡¼¥¸ )" if $j > 1;
1080     print<<"_EOF_";
1081     <div class="pagenavi"><hr>
1082     <p><a href="$this_name?$uri_query;md=new">¿·µ¬Åê¹Æ</a>
1083     $page_navi</p>
1084     <hr></div>
1085     _EOF_
1086     }
1087    
1088     sub nazo_only{
1089     my(%nazo);
1090     my(@env);
1091     my($name, $value);
1092     open(LOG, $logfile) or &error('Æɤ߹þ¤ß¥¨¥é¡¼','¥í¥°¤ÎÆɤ߹þ¤ß¤¬½ÐÍè¤Þ¤»¤ó¡£´ÉÍý¼Ô¤ËÏ¢Íí¤·¤Æ¤¯¤À¤µ¤¤¡£');
1093     while(<LOG>){
1094     while( m|(¡Ú.+?¡Û)|g ){
1095     $nazo{"$1"} ++;
1096     }
1097     }
1098     close(LOG);
1099     print &html_header("ÆæÅý·×¾ðÊó");
1100     if(%nazo){
1101     print '<ul>';
1102     while (($name, $value) = each(%nazo)){
1103     push(@env, "$name = $value");
1104     }
1105     foreach (sort(@env)){
1106     print "<li><p>$_</p></li>";
1107     }
1108     print '</ul>';
1109     }else{
1110     print '<p>Not Found.</p>';
1111     }
1112     &html_footer;
1113     exit;
1114     }
1115    
1116     sub location{
1117     my($location) = @_;
1118     print <<"_EndOfText_";
1119     Status: 302 Found
1120     Location: $location
1121     Content-Type: text/html; charset=EUC-JP
1122     Content-Language: ja
1123    
1124     _EndOfText_
1125     print &html_header("$location");
1126     print "<p><a href=\"$location\">$location</a> ¤ò»²¾È¤·¤Æ¤¯¤À¤µ¤¤¡£</p>";
1127     &html_footer;
1128     exit;
1129     }
1130    
1131     sub add_query{
1132     my($name, $value) = @_;
1133     $uri_query .= ";$name=$value";
1134     $form_query .= "<input type=\"hidden\" name=\"$name\" value=\"$value\">";
1135     }
1136    
1137     sub squelch{
1138     my($data) = @_;
1139     #Ææ¤ò¥¹¥±¥ë¥Á¤¹¤ë
1140     if( $nazo eq 'no' ){
1141     $data =~ s/(¡Ú[^<]+?¡Û)/<del class="nazo">$1<\/del>/g;
1142     }
1143     return $data;
1144     }

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24