#!/usr/mesh/bin/perl # PwebML.pl is freeware: (c)GOMASUKE # kibita@orange.ne.jp # Dept. of Computer Science, Faculty of Engineering, # Shizuoka Univ., Hamamatsu, Japan # Ver.1.0 1997/05/26 require './jcode.pl'; $mailto = '/usr/lib/sendmail -t -n'; $base = 'http://www.hogehoge.co.jp/~foo/'; $pg = 'pwebml.cgi'; $url = ''; $file = './xxxML.txt'; $cfile = './xxxMLc.txt'; $email = 'foo@bar.co.jp'; $org = "ML of Hogehoge Web site"; $subject = "Hogehoge ML"; @week = ("Sun","Mon","Tue","Wed","Thu","Fri","Sat"); ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdat) = localtime(time); $year += 1900; #VALID THRU 12/2037 $mon++; $date = sprintf("%3s, %02d/%02d/%4d %02d:%02d:%02d %s", $week[$wday],$mon,$mday,$year,$hour,$min,$sec,$ENV{'TZ'}); $ENV{'REQUEST_METHOD'} =~ tr/a-z/A-Z/; if ($ENV{'REQUEST_METHOD'} eq "POST") { read(STDIN, $dat, $ENV{'CONTENT_LENGTH'}); } else { $dat = $ENV{'QUERY_STRING'}; } @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; $value =~ s/\r\n/\n/g; $value =~ s/\r/\n/g; if ($var eq "mail") { $smail = $value; } &jcode'convert(*value,'jis'); $itm{$var} = $value; } if ($dat eq "dsp" || $dat eq "") { print "Content-type: text/html\n\n"; print < HogehogeML HogehogeML
ハンドル名:
返信先(任意):
UserID:
PassWD:

内容: 適宜、改行を入れて下さい

　

cgi script (c)GOMASUKE<PwebML.pl> EOF exit; } open(IN,"<$file"); chop(@a = ); close(IN); @adrs = (); foreach (@a) { ($id,$pd,$ad) = split('<',$_); $pwd{$id} = $pd; push(@adrs,$ad); } $n = @adrs; $name = $itm{'name'}; $madrs = $itm{'madrs'}; $madrs =~ s/ //g; $uid = $itm{'uid'}; $uid =~ s/ //g; $pass = $itm{'pass'}; $pass =~ s/ //g; $mail = $itm{'mail'}; &jcode'convert(*smail,'sjis'); $ref = $ENV{'HTTP_REFERER'}; $ref =~ s/%7E/~/gi; if (!($ref =~ /^$base/)) { print "Content-type: text/html\n\n"; print "正規のフォームから送信して下さい($ref)\n"; exit; } if ($uid eq "" || $pwd{$uid} ne $pass) { print "Content-type: text/html\n\n"; print "ユーザIDかパスワードが違います($uid or $pass)\n"; exit; } if ($name eq "") { print "Content-type: text/html\n\n"; print "ハンドル名を入力して下さい\n"; exit; } $mail2 = $smail; $mail2 =~ s/　//g; $mail2 =~ s/ //g; $mail2 =~ s/\n//g; if ($mail2 eq "") { print "Content-type: text/html\n\n"; print "本文を入力して下さい\n"; exit; } $a = ""; if ($madrs =~ /[\w\.\-]+@[\w\.\-]+/) { $a = $&; } if ($madrs ne "" && $madrs ne $a) { print "Content-type: text/html\n\n"; print "返信先が誤まっています($madrs)\n"; exit; } $bcc = join(',',@adrs); $rh = $ENV{'REMOTE_HOST'}; $ra = $ENV{'REMOTE_ADDR'}; if ($rh eq $ra) { $rh = gethostbyaddr(pack("C4", split('\.',$rh)),2) || $ra; } open(IN,"+<$cfile"); flock(IN,2); chop($ct = ); $ct++; seek(IN,0,0); print IN "$ct\n"; close(IN); open(ML,"| $mailto"); print ML "From: $email\n"; if ($madrs eq "") { print ML "Reply-To: $email\n"; } else { print ML "Reply-To: $madrs\n"; } print ML <\n/g; print "Content-type: text/html\n\n"; print "Mail Receipt\n"; print "

ML send script completed

\n"; print "ブラウザの戻るで前画面へ戻って下さい
\n"; print "$n人に送付されました

\n"; print "$smail

\n"; print "\n"; } else { print "Location: $url\n\n"; } exit;