#!/usr/local/bin/perl # *** This file is written by Shift JIS code. *** # *** 3 gyou shita no nihongo ga mojibake suru baaini wa # *** kono fairu wa Shift JIS to site hirakarete imasen. # *** Shift JIS kohdo no fairu to shite hiraite kudasai. # このファイルはShift JISコードで書かれています。 # # program name : gb_sl.cgi (guest book cgi for Shift JIS code with lock) # # function : (1) count guest number and message number. # (2) show form for new message. # (3) show messages written on book1 by Shift JIS code. # (4) add new message to book1 by Shift JIS code. # # note : This gb_sl.cgi is first made for BIGLOBE(mesh) by perl ver.4 # using gb_s.txt(ver.1.6). # This cgi is written by Shift JIS code. # This cgi is for the site where flock function is not # available in perl cgi. # programmer : makoto takenaka : takesoft@mxs.meshnet.or.jp # # copyright : (c) 1996, 1997 by Makoto Takenaka # # version(date): # 1.0(Oct 26, 1996) # 1.1(Oct 31, 1996) Add owner mode using password in name field. # 1.2(Nov 12, 1996) Check (size of book1) = (size of book2). # 1.3(Nov 14, 1996) Check book2 size in(4.4) # and change die to exit in sub error_message. # Rewrite $m_count after new message is added to book1, # Insert comment for old message anchor tags. # Change section number of subroutine show_html. # Change 0-adding method in $date. # 2.0(Dec 12, 1996) Change double quotations to single quotations in # substitutions of $password, $owner_name, $owner_url # and $owner_mail. "o" is added in next line for bad # implementation of perl. # $value =~ s/&/&/go; # 2.1(Dec 18, 1996) Make $msg_limit, limit of $message. # $name and $mail is required for message. # Use truncate. # 2.2(Jan 12, 1997) Change horizontal lines. # 2.3(Jan 31, 1997) Add sub wrap to word-wrap $message for the other # browsers except Netscape Navigator 2.0/3.0 # 2.4(Feb 13, 1997) Change escape codes after sub wrap for $message. # Change to "$year += 1900;", this works well until # 2038/01/19. Change "local($jc) in sub wrap. # # calling form : called from other Web page. #
called from # form in this cgi. # *** is directory where gb_sl.cgi is placed. # # #(0) Print type of data and include jcode.pl. # print "Content-type: text/html\n\n"; # # if jcode.pl is not prepared in your site, prepare it by yourself, # put it in the same directory as gb_sl.cgi and chage 'jcode.pl' # to './jcode.pl' or full file name. # require 'jcode.pl'; # #(1) Set constants. # Change $pwd and $lock_dir to full path if required, # like next lines. Type of full path name is different from site to site. # # $pwd = "/home/usr3/user-id/public_html/gb/"; # $lock_dir = "/home/usr3/user-id/public_html/lock/"; # # Number in parentheses is file access mask number. # $limit = 50000; # limit of book1 byetes $msg_limit = 2000; # limit of $message (bytes) $msg_limit2 = $msg_limit/2; # limit of $message (zenkaku chars) $line_limit = 77; # limit of bytes in a line $home_page = "../index.html"; # first web page html file $pwd = "./"; # present working directory $book1 = $pwd."book1.html"; # file name of book1(606) $book2 = $pwd."book2.html"; # file name of book2(606) $g_count_file = $pwd."g_count.txt"; # number of guests (606) $m_count_file = $pwd."m_count.txt"; # number of messages(606) # $lock_dir = "../lock/"; # directory of lock files(777) $target_file = $lock_dir."gb_mtarget.txt"; #target of link for message $lock_file = $lock_dir."gb_mlock.txt"; #symbolic link file for message $gctarget_file = $lock_dir."gb_gctarget.txt"; #target for guest count $gclock_file = $lock_dir."gb_gclock.txt"; #symbolic link for guest count # # Change next four variables to your own data. # $password = 'gbmaster3'; # password for owner mode $owner_name = '管理者'; # owner name $owner_url = 'http://www2a.meshnet.or.jp/~user-id/'; $owner_mail = 'user-id@xxx.yyyyyyy.or.jp'; # $owner_mode = ""; # = "yes"; if owner mode. # $line_limit = $line_limit - 1; # Adjust $line_limit $textarea_limit = $line_limit - 6; # limit of bytes in line for hard wrap if(-e $book1) {$book1_byte = (-s $book1);} # Get size of book1. else {&error_message("(1): File $book1 is not found.");} # if(-e $book2) {$book2_byte = (-s $book2);} # Get size of book2. else {&error_message("(1): File $book2 is not found.");} # #(2) get parameters from sent data. # if ($ENV{'REQUEST_METHOD'} eq "POST") { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); } else { $buffer = $ENV{'QUERY_STRING'}; } # @pairs = split(/&/, $buffer); # foreach $pair (@pairs) { ($pname, $value) = split(/=/, $pair); $value =~ tr/+/ /; $value =~ s/%([0-9a-fA-F][0-9a-fA-F])/pack("C", hex($1))/eg; &jcode'convert(*value, 'sjis'); # Convert to Shift JIS code if($pname ne 'message') { $value =~ s/&/&/g; # Change & to & $value =~ s/\x22/"/g; # Change " to " $value =~ s//>/g; # Change > to > } $value =~ s/\x0D\x0A/\x0A/g; # Change CR LF to LF $value =~ s/\x0D/\x0A/g; # Change CR to LF $parameters{$pname} = $value; } # $name = $parameters{'name'}; $url = $parameters{'url'}; unless($url) { $url = "http://"; } $mail = $parameters{'mail'}; $message = $parameters{'message'}; if(length($message) > $msg_limit) {$message = substr($message, 0, $msg_limit);} # Cut long message. # # Wrap $message if characters in a line is greater than $line_limit. # &wrap(*message, $line_limit); # $message =~ s/&/&/g; # Change & to & $message =~ s/\x22/"/g; # Change " to " $message =~ s//>/g; # Change > to > # if($name =~ /^$password\b/) { $owner_mode = "yes"; $name = $owner_name; if($url eq "http://") {$url = $owner_url;} unless($mail) {$mail = $owner_mail;} } # ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); $year += 1900; # Add 1900, which is valid until 2038/01/19. $mon++; $thisday = (Sun,Mon,Tue,Wed,Thu,Fri,Sat)[$wday]; if ($sec < 10) {$sec = "0$sec";} if ($min < 10) {$min = "0$min";} if ($hour < 10) {$hour = "0$hour";} if ($mday < 10) {$mday = "0$mday";} if ($mon < 10) {$mon = "0$mon";} # $date = "$year/$mon/$mday $thisday $hour:$min:$sec"; # #(3) show form and book1 and exit if message is empty (called from tag or # submitted without message). # unless($name && $mail && $message) { &show_html(1); exit 0; } # #(4) Add new message to book1. # #(4.0) Check and set lock file. # #(4.0.0) Make link target file. # unless(-e $target_file) { open(TARGET, ">$target_file"); print TARGET $date; close(TARGET); } # #(4.0.1) Delete lock file if it is too old. # If symlink is not available, use stat instead of lstat. # if(-e $lock_file) { lstat($lock_file); $lock_sec = (-M _)*24*3600; # seconds after last modified if($lock_sec > 600) # 10 min = 600 sec {unlink($lock_file);} # Delete $lock_file if more than 600 sec old. } # #(4.0.2) Wait a few seconds for lock file if exist. # for($wait=0; $wait<100 ; $wait++) { unless(-e $lock_file){last;} # break if $lock_file is not exist sleep(1); if($wait > 5) { &show_html(2); exit 1; } } # #(4.0.3) Make symbolic link file $lock_file. # If symlink is not available in your site, use link instead of # symlink (change "symlink" to "link" in the next line) and use # stat instead of lstat in (4.0.1). # unless(symlink($target_file, $lock_file)) { &show_html(3); exit 1; } # #(4.1) Read message number $m_count. # open(COUNTFILE, "$m_count_file") || &error_message("(4.1):Unable to open $m_count_file"); $m_count = ; $m_count = $m_count + 1; close(COUNTFILE); # #(4.2) Write new message to book2. # open(BOOK2, "+<$book2") || &error_message("(4.2):Unable to open $book2"); # flock(BOOK2, 2); # print BOOK2 "
\n"; if($url ne "http://") { if($owner_mode) { print BOOK2 "[$m_count]
$name "; } else { print BOOK2 "[$m_count]$name さん"; } } else { print BOOK2 "[$m_count] $name さん"; } if($mail) { print BOOK2 "($mail) $date\n"; } else { print BOOK2 " $date\n"; } # print BOOK2 "
\n$message\n
\n"; # #(4.3) Add old message in book1 to book2. # open(BOOK1, "+<$book1") || &error_message("(4.3): Unable to open $book1"); # flock(BOOK1, 2); print(BOOK2 ) || &error_message("(4.3): Unable to add BOOK1 to BOOK2"); # truncate(BOOK2, tell(BOOK2)); # #(4.4) Copy book2 to book1. # seek(BOOK1, 0, 0); seek(BOOK2, 0, 0); # print(BOOK1 ) || &error_message("(4.4): Unable to copy BOOK2 to BOOK1"); # flock(BOOK1, 8); close(BOOK1); # flock(BOOK2, 8); close(BOOK2); # #(4.5) Incremet $m_count on $m_count_file. # No increment for error between (4.2)-(4.4) # Increment to written $m_count because another process may # increment $m_count during (4.2)-(4.4). # open(COUNTFILE, "+< $m_count_file") || &error_message("(4.5):Unable to open $m_count_file"); # flock(COUNTFILE, 2); $m_count = ; $m_count = $m_count + 1; seek(COUNTFILE, 0, 0); print COUNTFILE $m_count; # flock(COUNTFILE, 8); close(COUNTFILE); # #(5) Delete $lock_file and $target_file. # unlink($lock_file) && unlink($target_file); # #(6) Show form and messages. # &show_html(0); # exit 0; # End of Main Program # # subroutine show_html # sub show_html { local($incr) = @_; # # $incr = 1 if called from tag, $incr = 0 if called from this form. # #(S1) set guest number $g_count. # #(S1.1) $incr is 1. # if ($incr == 1) { # # (S1.1.1) Make targer file if not exist. # unless(-e $gctarget_file) { open(TARGET, ">$gctarget_file"); print TARGET $date; close(TARGET); } # #(S1.1.2) Delete lock file if it is too old. # If symlink is not available, use stat instead of lstat. # if(-e $gclock_file) { lstat($gclock_file); $lock_sec = (-M _)*24*3600; # seconds after last modified if($lock_sec > 600) # 10 min = 600 sec {unlink($gclock_file);} #Delete $gclock_file if more than 600 sec old. } # #(S1.1.3) Make symbolic link file $gclock_file. # If symlink is not available in your site, use link instead of # symlink (change "symlink" to "link" in the next line) and use # stat instead of lstat in (1.1.2). # unless(symlink($gctarget_file, $gclock_file)) { # #(S1.1.4) If symlink is failed, just show previous $g_count. # open(COUNTFILE, "$g_count_file") || &error_message("show_html:Unable to open $g_count_file"); $g_count = ; close(COUNTFILE); } else { # #(S1.1.5) Increment $g_count if symbolic link file is made successfully. # open(COUNTFILE, "+< $g_count_file") || &error_message("show_html:Unable to open $g_count_file"); # flock(COUNTFILE, 2); $g_count = ; $g_count = $g_count + $incr; seek(COUNTFILE, 0, 0); print COUNTFILE $g_count; # flock(COUNTFILE, 8); close(COUNTFILE); # unlink($gclock_file) && unlink($gctarget_file); } } else { # #(S1.2) $incr is not 1. # open(COUNTFILE, "$g_count_file") || &error_message("show_html:Unable to open $g_count_file"); $g_count = ; close(COUNTFILE); } # #(S2) set message number $m_count. # open(COUNTFILE, "$m_count_file") || &error_message("show_html:Unable to open $m_count_file"); $m_count = ; close(COUNTFILE); # #(S3) Show head part of guest book page. # print < Guest Book EOF print ''; print <message 1-100]\n"; print "["; print <<'EOF'; ホームページへ戻る]

掲 示 板

EOF # # Lock file error at (4.0.2) # if($incr == 2) {print "*** No write due to long wait for lock file ***
\n";} # # Lock file error at (4.0.3) # if($incr == 3) {print "*** No write due to symbolic link failure of lock file ***
\n";} # #(S4) Show form for message. # if($owner_mode){$name = $password;} # if($book1_byte < $limit) { print <<'EOF';
Webページに対する御意見御要望をどんどんお書き下さい。下の ”送る”ボタンを押すと送付され、このフォームの下に表示されます。 半角カタカナは文字化けしますので使用しないで下さい。”送る”ボタンを 押してから応答があるまでの間には、”送る”ボタンや再読み込みボタンを 押さないで下さい。二重書き込みになります。

お名前(必ずお書き下さい)
EOF print <
貴方のホームページのURL

メールアドレス(必ずお書き下さい)

メッセージ(全角 $msg_limit2 文字まで。 EOF print <<'EOF'; Netscape Navigator 2.0以上の場合自動改行。その他の場合一行が EOF print "$line_limit"; print <<'EOF'; バイトを越えると強制改行)
EOF print <
EOF print <<'EOF';
EOF } else { print <<'EOF';
申し訳ありません。
今は、掲示板ファイルがいっぱいになったか、掲示板ファイルに
異常が発生したので書き込めません。
またの御利用をお願いします。

EOF } # #(S5) Print book1. # open(BOOK1, "$book1") || &error_message("show_html:Unable to open $book1"); print ; #print whole book1 to STDOUT. close(BOOK1); # #(S6) Print last part of guest book page. # print "

\n"; # Next line is an example of anchor tag to old message data. # print "[message 1-100]\n"; print ""; print <<'EOF'; ホームページへ戻る]


初期設置日:1997年2月13日/最終変更日:1997年2月13日/gb_sl (ver.2.4)

EOF } # END of SUBROUTINE show_html # # SUBROUTINE wrap # sub wrap { local(*msg, $limit) = @_; # # This subroutine wrap $msg, so that each line length is less or equal # to ($limit + 1). Return number of lines in new $msg. # local(@old_lines, @new_lines, @byte_lines, $max, $len, $iline, $i, $line); local($jc); # #(w1) Set constants. # $jc = '[\201-\237\340-\374][\100-\176\200-\374]'; # Shift JIS code # #(w2) Split $msg into lines. # @old_lines = split(/\n/, $msg); # #(w3) Check length of each lines. # $max = 0; foreach $i(0..$#old_lines) { $len = length($old_lines[$i]); $byte_lines[$i] = $len; $max = ($max > $len) ? $max : $len ; } # if($max <= $limit){return ($#old_lines + 1);} # #(w4) Wrap long lines. # $iline = 0; #new line number # foreach $i(0..$#old_lines) { if($byte_lines[$i] <= $limit) { $new_lines[$iline] = $old_lines[$i]; $iline++; } else { $line = ''; # Clear $line. $len = 0; $_ = $old_lines[$i]; # while(length($_)) { $zen_space = int(($limit - $len + 1)/2); s/^(($jc){1,$zen_space}|.)// ; $line .= $&; $len = length($line); if($len >= $limit) { $new_lines[$iline] = $line; $line = ''; $len = 0; $iline++; } } if($len) { $new_lines[$iline] = $line; $iline++; } } } $msg = join("\n", @new_lines); $iline; # Return number of lines in new $msg. } # # SUBROUTINE error_message # sub error_message { local($msg) = @_; # # print message and stop this perl program. # print $msg; # exit 1; }