#!/usr/mesh/bin/perl # NChat.pl is freeware: (c)GOMASUKE # Dept. of Computer Science, Faculty of Engineering, # Shizuoka Univ., Hamamatsu, Japan # Ver.1.0 1997/05/23 # # The following DENY BLOCK: write permission denied domain(0) require './jcode.pl'; $base = 'http://www2s.biglobe.ne.jp/~kibita/cgi-bin/'; $pg = '970525.cgi'; $file = './xxx.txt'; $max = 50; $mmax = 200; @week = ("Sun","Mon","Tue","Wed","Thu","Fri","Sat"); ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdat) = localtime(time); $mon++; $date = sprintf("%02d/%02d<%3s>%02d:%02d", $mon,$mday,$week[$wday],$hour,$min); $rh = $ENV{'REMOTE_HOST'}; $ra = $ENV{'REMOTE_ADDR'}; $ref = $ENV{'HTTP_REFERER'}; $ref =~ s/%7E/~/gi; if ($ra =~ /^xxx\.xxx\.xxx\./) { $rh = "adm"; $ra = "adm"; } $date = "($date $ra)"; $ENV{'REQUEST_METHOD'} =~ tr/a-z/A-Z/; if ($ENV{'REQUEST_METHOD'} eq "GET") { $dat = $ENV{'QUERY_STRING'}; } else { read(STDIN, $dat, $ENV{'CONTENT_LENGTH'}); } @buf = split('&',$dat); foreach $item (@buf) { ($var,$value) = split('=',$item); $value =~ tr/+/ /; $value =~ s/%([0-9a-fA-F][0-9a-fA-F])/pack("C", hex($1))/eg; &jcode'convert(*value,'sjis'); if ($var eq "msg") { $imsg = $value; } $value =~ s//>/g; $value =~ s/\r\n/\n/g; $value =~ s/\r/\n/g; #Win,Mac $value =~ s/\n//g; $value =~ s/ / /g; $value =~ tr/ / /s; $itm{$var} = $value; } $name = $itm{'name'}; $mail = $itm{'mail'}; $dln = $itm{'dln'}; $msg = $itm{'msg'}; $ln = length($msg); if ($ln != 0) { $act = "w"; } $acl = 0; if ($act eq "w") { if ($ref =~ /^$base/) { $acl = 1; if ($rh eq $ra) { $rh = gethostbyaddr(pack("C4", split('\.',$rh)),2) || $ra; } DENY: { # if ($rh =~ /\.zzz\.(or|ne)\.jp/i) { $acl = 2; last DENY; } # if ($rh =~ /\.interq\.(or|ne)\.jp/i) { $acl = 2; last DENY; } # if ($rh =~ /\.eznet\.(or|ne)\.jp/i) { $acl = 2; last DENY; } # if ($rh =~ /\.interwave\.(or|ne)\.jp/i) { $acl = 2; last DENY; } # if ($ra =~ /^xxx\.xxx\.xxx\./) { $acl = 2; last DENY; } } } else { $acl = 3; } } print "Content-type: text/html\n\n"; print < N88CHAT N88CHAT
投稿者: Email(任意):
内容: 改行・タグは無視されます。何も書かないと更新(reload)します
EOF if ($acl == 1 && ($ln > $mmax || $name eq "")) { print "\n"; } else { print "\n"; } print "
  行数: \n"; print "

\n"; if ($acl == 1 && ($ln > $mmax || $ln < 2)) { print "文字数を減らして下さい($ln char)
\n"; $acl = 0; } if ($acl == 1 && $name eq "") { print "名前を入力して下さい
\n"; $acl = 0; } if ($acl == 2) { print "ごめんなさい。$rhのドメインからは書き込めません
\n"; } if ($acl == 3) { print "正規のフォームから書き込んで下さい($ref)
\n"; } if ($acl == 1) { &wrt; } else { &dsp; } print < $ra($rh:$acl)
EOF exit; sub dsp { $i = 1; @d = (); if (-e $file) { open(IN,"<$file"); while(!eof(IN) && $i <= $max) { chop($a = ); push(@d,$a); $i++; } close(IN); } &send; } sub wrt { $i = 1; @d = (); $b = "$name<$mail<$msg<$date<$rh"; if (-e $file) { open(IN,"+<$file"); flock(IN,2); while(!eof(IN) && $i < $max) { chop($a = ); push(@d,$a); $i++; } } else { exit; } unshift(@d,$b); seek(IN,0,0); foreach (@d) { print IN "$_\n"; } close(IN); &send; } sub send { $i = 0; foreach (@d) { ($name,$mail,$msg,$date,$ad) = split('<',$_); if ($mail eq "") { print "$name>$msg $date
\n"; } else { print "$name>$msg $date
\n"; } $i++; if ($i == $dln) { last; } } }