ガタガタさんのいいねボタン改のPHPコード
<?php
///////////////////////////////////////////////////
// いいねボタン改 Ver2.2
// 製作者 :ガタガタ
// サイト :https://do.gt-gt.org/
// ライセンス:MITライセンス
// 全文 :https://ja.osdn.net/projects/opensource/wiki/licenses%2FMIT_license
// 公開日 :2021.12.30
// 最終更新日:2023.03.02
//
// このプログラムはどなたでも無償で利用・複製・変更・
// 再配布および複製物を販売することができます。
// ただし、上記著作権表示ならびに同意意志を、
// このファイルから削除しないでください。
///////////////////////////////////////////////////
header('Content-Type: text/html; charset=UTF-8');
$include = get_included_files();
if (array_shift($include) === __FILE__) {
die('このファイルへの直接のアクセスは禁止されています。');
}
include_once(dirname(__FILE__).'/admin/inc/_config.php');
class newiine {
// コンストラクタ宣言
public function __construct() {
date_default_timezone_set('Asia/Tokyo');
$this->today = date("Y/m/d");
$this->time = date("H:i:s");
$this->visitorIP = $_SERVER["REMOTE_ADDR"];
global $limitPost;
global $saveperiod;
$this->iineLimit = $limitPost;
$this->saveperiod = $saveperiod;
$this->sorteddate = date("Y/m/d", strtotime('-'.$this->saveperiod.' day'));
}
// タグなどの送信を拒否
public function entity($txt) {
$newTxt = htmlentities($txt);
return $newTxt;
}
public function doublequotation($txt) {
$newTxt = '"' .$txt. '"';
return $newTxt;
}
// URL名がindex.htmlもしくはindex.phpで終わる場合はURLを丸める
public function checkURL($url) {
$filenames = array('index.html', 'index.php');
foreach ($filenames as $filename) {
if (strpos($url, $filename) !== false) {
$url = rtrim($url, $filename);
}
}
return $url;
}
// URLからタイトルを取得する
public function getHTMLtitle($URL) {
$http_response_header = null;
if( $source = @file_get_contents($URL)) {
//文字コードをUTF-8に変換し、正規表現でタイトルを抽出
if (preg_match('/<title>(.*?)<\/title>/i', mb_convert_encoding($source, 'UTF-8', 'ASCII,JIS,UTF-8,EUC-JP,SJIS'), $result)) {
$title = $result[1];
} else {
//TITLEタグが存在しない場合
$title = 'タイトルを取得できませんでした。';
}
} else {
//エラー処理
if($http_response_header === null) {
$title = "指定したページが見つかりませんでした。data-iineurlの値を確認してください。";
} elseif(count($http_response_header) > 0){
//「$http_response_header[0]」にはステータスコードがセットされている
$status_code = explode(' ', $http_response_header[0]); //「$status_code[1]」にステータスコードの数字だけが入る
//エラーの判別
switch($status_code[1]){
//404エラーの場合
case 404:
$title = "指定したページが見つかりませんでした。data-iineurlの値を確認してください。";
break;
//500エラーの場合
case 500:
$title = "指定したページがあるサーバーにエラーがあります";
break;
//その他のエラーの場合
default:
$title = "何らかのエラーによって指定したページのデータを取得できませんでした";
}
}else{
//タイムアウトの場合 or 存在しないドメインだった場合
$title = "タイムエラー or URLが間違っています";
}
}
return $title;
}
private function checkTodaysCount($btnName, $iineNewCountLimit) {
$count = $this->openCSV($btnName, 'count');
$countLimit = '';
if ($iineNewCountLimit !== "false") {
// 個別にいいね回数上限が設定されていれば、それに従う
$countLimit = $iineNewCountLimit;
} else {
$countLimit = $this->iineLimit;
}
if ($count < $countLimit) {
// 上限に達していない場合はfalseを返す
return false;
} else {
// 上限に達している場合はtrueを返す
return true;
}
}
// CSVを開いて当該いいねボタンに関するデータを引っ張り出す関数
public function openCSV($planeBtnName, $mode = null, $URL = null) {
$btnName = mb_convert_encoding($planeBtnName, "UTF-8");
if($mode === true) {
$filename = dirname(__FILE__, 1). '/datas/'.$btnName.'.csv';
} else {
$filename = 'datas/'.$btnName.'.csv';
}
if($mode === 'count' && !file_exists($filename)) {
return 0;
}
if(file_exists($filename)) {
$fp = fopen($filename, "r");
$csvArray = array();
// CSVからデータを取得し二次元配列に変換する
$row = 0;
while( $ret_csv = fgetcsv( $fp, 0 ) ) {
$col = 0;
while($col < count( $ret_csv )) {
$csvArray[$row][$col] = $ret_csv[$col];
++$col;
}
++$row;
}
fclose($fp);
// いいね数を返すモード
if($mode === 'count') {
if(!$csvArray) {
return 0;
}
$count = 0;
foreach ($csvArray as $key => $value) {
if($value[2] === $this->visitorIP && $value[3] === $this->today) {
$count += $value[5];
}
}
return $count;
}
// データがある場合は、取得した二次元配列から、
// リクエストの飛んできたいいねボタンのデータを探す。なければfalseを返す
$num = false;
if($mode === null) {
foreach ($csvArray as $key => $value) {
if($value[2] === $this->visitorIP && $value[3] === $this->today && $value[0] === $URL) {
$num = $key;
}
}
}
} else {
$num = false;
$csvArray = false;
}
return array($num, $csvArray);
}
// CSVファイルに二次元配列を上書きする関数
private function rewriteCSV($planeBtnName, $csvArray, $num) {
$btnName = mb_convert_encoding($planeBtnName, "UTF-8");
$filename = 'datas/'.$btnName.'.csv';
$fp = fopen($filename, 'w');
// 二次元配列を1行ずつCSV形式に直して書き込む
foreach ($csvArray as $key => $v) {
if ($key !== $num) {
$v[0] = $this->doublequotation($v[0]);
$v[1] = $this->doublequotation($v[1]);
}
$line = implode(',' , $v);
fwrite($fp, $line . "\n");
}
// ファイルを閉じる
fclose($fp);
}
// 過去3ヶ月分の詳細ないいねログを統合する関数
public function sortOutData($btnname, $url) {
list($num, $csvArray) = $this->openCSV($btnname);
if($csvArray === false) {
return;
}
$time1 = strtotime($this->today);
$time2 = strtotime($csvArray[0][3]);
$days = ($time1 - $time2) / (60 * 60 * 24);
if($days > $this->saveperiod) {
$sum = 0;
$newarray = array();
foreach ($csvArray as $value) {
if*1 / (60 * 60 * 24) > $this->saveperiod) {
$sum += $value[5];
} else {
$value[0] = $this->doublequotation($value[0]);
$value[1] = $this->doublequotation($value[1]);
$newarray[] = $value;
}
}
$sourOutedData = array($this->doublequotation($url), $this->doublequotation($this->getHTMLtitle($url)), 'admin', $this->sorteddate, $this->time, $sum);
array_unshift($newarray, $sourOutedData);
// $btnname = mb_convert_encoding($btnname, "UTF-8");
$filename = 'datas/'.$btnname.'.csv';
$fp = fopen($filename, 'w');
// 二次元配列を1行ずつCSV形式に直して書き込む
foreach ($newarray as $v) {
$line = implode(',' , $v);
fwrite($fp, $line . "\n");
}
// ファイルを閉じる
fclose($fp);
}
}
// いいね数を増やす関数!
public function newiineCount($postPath, $btnName, $iinecountlimit) {
// IPアドレスが拒否されていれば、いいねを拒否する
$IPs = file('datas/setting/deny.dat');
$checkIP = false;
foreach($IPs as $IP) {
if($this->visitorIP === trim($IP)) {
$checkIP = true;
}
}
//$btnNameのCSVのIPアドレス(何個あるのかは調べなければわからない)が$this->visitorIPに一致するときはは$checkIP = trueにする。
if($checkIP === true) {
echo 'denyIP';
} else {
$rowtitle = $this->getHTMLtitle($postPath);
$newtitle = $this->doublequotation($rowtitle);
$newURL = $this->doublequotation($postPath);
$filename = 'datas/'.$btnName.'.csv';
list($num, $csvArray) = $this->openCSV($btnName, null, $postPath);
if($this->checkTodaysCount($btnName, $iinecountlimit)) {
echo 'upper';
} elseif($num === false) {
// まずは古いログを整理
$this->sortOutData($btnName, $postPath);
// 今日はまだいいねしていない場合は新しい行で受け付ける
$data = array($newURL, $newtitle, $this->visitorIP, $this->today, $this->time, 1);
$fp = fopen($filename, 'a');
if(flock($fp, LOCK_EX)) {
$line = implode(',' , $data);
fwrite($fp, $line . "\n");
flock($fp, LOCK_UN);
}
fclose($fp);
$sum = $this->newiineSum($btnName);
echo $sum;
} elseif($num !== false) {
// 今日はいいねしているけど1日上限数未満の場合は上書きして受け付ける
$count = $csvArray[$num][5];
$newCount = $count + 1;
$newdata = array($newURL, $newtitle, $this->visitorIP, $this->today, $this->time, $newCount);
$addArray = array($newdata);
array_splice($csvArray, $num, 1, $addArray);
$this->rewriteCSV($btnName, $csvArray, $num);
$sum = $this->newiineSum($btnName);
echo $sum;
} else {
// それ以外の場合は受け付けない
echo 'else';
}
}
}
// いいねボタンの総いいね数を返す関数
public function newiineSum($btnName) {
list($num, $csvArray) = $this->openCSV($btnName);
$sum = 0;
$today = false;
if($csvArray) {
foreach ($csvArray as $value) {
$sum = $sum + $value[5];
if($value[2] === $this->visitorIP) {
$today = true;
}
}
}
$ret_array = array($sum, $today);
$datas = json_encode($ret_array);
echo $datas;
}
}
?>
日本企業のChatGPT利用法
シェアした動画はシンギュラリティサロンというyoutube動画。年配の男性4人のトーク番組で、一人の男性はセーラ服を着て登場しているが、トーク内容はいたってまじめな番組。私は、かなり信用している。
ChatGPTをめぐる国内の状況2~企業は後ろ向きから前のめりへ、この一週間で状況は一変 - YouTube
国内の名だたる企業は、マイクロソフトのクラウドAzureでopenAIのAPIを使用しているそうです。OpenAIの主張の「APIの使用では、質問をAIの学習に使用することはない。」を信用して使用しているとのこと。私は、まだ、有料のAPIは使用したことがありません。Google ColabでGITHUBのCAMELを動かそうとしたことがありますが、エラーで動かせませんでした。GITHUBのプログラムでGoogle Colabで即動くものはあまりないというのが今までの実感です。
KENTさんのregist.cgi
以下次のKENTさんのURLで公開されているpatioのregist.cgiです。KENTさんはフリーソフトだが、著作権は放棄していないと言っています。
https://www.kent-web.com/bbs/patio.html
#!/usr/local/bin/perl
#┌─────────────────────────────────
#│ WEB PATIO : regist.cgi - 2022/03/26
#│ copyright (c) kentweb, 1997-2022
#│ https://www.kent-web.com/
#└─────────────────────────────────
# モジュール宣言
use strict;
use CGI::Carp qw(fatalsToBrowser);
use lib "./lib";
use CGI::Minimal;
# 設定ファイル認識
require "./init.cgi";
my %cf = set_init();
# データ受理
CGI::Minimal::max_read_size($cf{maxdata});
my $cgi = CGI::Minimal->new;
error('容量オーバー') if ($cgi->truncated);
my %in = parse_form($cgi);
# 認証モード
my %au = authent() if ($cf{authkey});
if ($in{mode} eq 'regist') { regist(); }
if ($in{mode} eq 'edit') { edit_log(); }
error("不明な処理です");
#-----------------------------------------------------------
# 記事投稿処理
#-----------------------------------------------------------
sub regist {
# 投稿チェック
if ($cf{postonly} && $ENV{REQUEST_METHOD} ne 'POST') {
error("不正なリクエストです");
}
# 権限チェック
if ($cf{authkey} && $au{rank} < 2) {
error("投稿の権限がありません");
}
# フォーム入力チェック
form_check();
# ホスト/時間取得
my ($host,$addr) = get_host();
my ($date,$time) = get_time();
# 汚染チェック
$in{res} =~ s/\D//g;
# 投稿キーチェック
if ($cf{use_captcha} > 0) {
require $cf{captcha_pl};
if ($in{captcha} !~ /^\d{$cf{cap_len}}$/) {
error("投稿キーが入力不備です。<br>投稿フォームに戻って再読込み後、再入力してください");
}
# 投稿キーチェック
# -1 : キー不一致
# 0 : 制限時間オーバー
# 1 : キー一致
my $chk = cap::check($in{captcha},$in{str_crypt},$cf{captcha_key},$cf{cap_time},$cf{cap_len});
if ($chk == 0) {
error("投稿キーが制限時間を超過しました。<br>投稿フォームに戻って再読込み後、指定の数字を再入力してください");
} elsif ($chk == -1) {
error("投稿キーが不正です。<br>投稿フォームに戻って再読込み後、再入力してください");
}
}
# トリップ
my ($moto,$name) = trip_name($in{name});
# パスワード暗号化
my $pwd = encrypt($in{pwd}) if ($in{pwd} ne "");
# 初期化
my ($maxflag,$read_no);
## --- 新規投稿(新規スレッド作成)
if ($in{res} eq "") {
# indexファイル
my ($i,$flg,@new,@tmp,@top);
open(DAT,"+< $cf{datadir}/index1.log") or error("open err: index1.log");
eval "flock(DAT,2);";
my $top = <DAT>;
# 連続投稿IPチェック
my ($no,$hos,$tim) = split(/<>/, $top);
if ($host eq $hos && $cf{wait} > $time - $tim) {
close(DAT);
error("連続投稿はもうしばらく時間をおいて下さい");
}
my $new = $no + 1;
# index展開
while(<DAT>) {
my ($sub,$key) = (split(/<>/))[1,6];
$i++;
# スレッド名重複
if ($sub eq $in{sub}) {
$flg++;
last;
} elsif ($key == 2) {
push(@top,$_);
next;
}
# 規定数オーバーは@tmp代入
if ($i >= $cf{i_max}) {
push(@tmp,$_);
# 規定数内は@new代入
} else {
push(@new,$_);
}
}
# スレッド名重複はエラー
if ($flg) {
close(DAT);
error("<b>「$in{sub}」</b>は既存スレッドと重複しています。<br>別のスレッド名を指定してください");
}
# ファイルアップ
my ($upflg,%ex,%w,%h);
if ($cf{image_upl} && ($in{upfile1} || $in{upfile2} || $in{upfile3})) {
($ex{1},$w{1},$h{1},$ex{2},$w{2},$h{2},$ex{3},$w{3},$h{3}) = upload($time);
# 画像アップのときはフラグを立てる
if ($ex{1} || $ex{2} || $ex{3}) { $upflg = $time; }
}
# 現行index更新
unshift(@new,"$new<>$in{sub}<>0<>$name<>$date<>$name<>1<>$upflg<>\n");
unshift(@new,@top) if (@top > 0);
unshift(@new,"$new<>$host<>$time<>\n");
seek(DAT,0,0);
print DAT @new;
truncate(DAT,tell(DAT));
close(DAT);
# 過去index更新
if (@tmp > 0) {
$i = @tmp;
open(DAT,"+< $cf{datadir}/index2.log") or error("open err: index2.log");
eval "flock(DAT,2);";
while(<DAT>) {
$i++;
if ($i > $cf{p_max}) {
my ($delno) = split(/<>/);
open(IN,"$cf{datadir}/log/$delno.cgi");
my $top = <IN>;
my $log = <IN>;
close(IN);
my ($no,$sub,$nam,$eml,$com,$dat,$ho,$pw,$url,$mlo,$myid,$tim,$upl1,$upl2,$upl3) = split(/<>/, $log);
# 画像は削除
my $n;
foreach my $upl ($upl1, $upl2, $upl3) {
my ($ex,$w,$h) = split(/,/,$upl);
$n++;
if ($ex) { unlink("$cf{upldir}/$tim-$n$ex"); }
}
unlink("$cf{datadir}/log/$delno.cgi");
unlink("$cf{datadir}/log/$delno.dat");
next;
}
push(@tmp,$_);
}
seek(DAT,0,0);
print DAT @tmp;
truncate(DAT,tell(DAT));
close(DAT);
}
# スレッド更新
open(OUT,"+> $cf{datadir}/log/$new.cgi") or error("write err: $new.cgi");
print OUT "$new<>$in{sub}<>0<>1<>\n";
print OUT "0<>$in{sub}<>$name<>$in{email}<>$in{comment}<>$date<>$host<>$pwd<>$in{url}<>$in{mlo}<>$au{id}<>$time<>$ex{1},$w{1},$h{1}<>$ex{2},$w{2},$h{2}<>$ex{3},$w{3},$h{3}<>\n";
close(OUT);
# 参照ファイル生成
open(NO,"+> $cf{datadir}/log/$new.dat") or error("write err: $new.dat");
print NO "0:";
close(NO);
# パーミッション変更
chmod(0666, "$cf{datadir}/log/$new.cgi");
chmod(0666, "$cf{datadir}/log/$new.dat");
# メール通知
sendmail($name,$date,$host) if ($cf{mailing});
# 記事番を覚えておく
$read_no = $new;
# --- 返信投稿
} else {
# 連続投稿チェック
open(IN,"$cf{datadir}/index1.log") or error("open err: index1.log");
my $top = <IN>;
close(IN);
my ($no,$hos2,$tim2) = split(/<>/,$top);
if ($host eq $hos2 && $cf{wait} > $time - $tim2) {
error("連続投稿はもうしばらく時間をおいて下さい");
}
# スレッド読み込み
open(DAT,"+< $cf{datadir}/log/$in{res}.cgi") or error("open err: $in{res}.cgi");
eval "flock(DAT,2);";
my $top = <DAT>;
my @log = <DAT>;
# 先頭ファイル分解
my ($no,$sub,$res,$key) = split(/<>/, $top);
# ロックチェック
if ($key eq '0' || $key eq '2') {
close(DAT);
error("このスレッドはロック中のため返信できません");
}
# 末尾ファイルを分解、重複チェック
my ($no2,$sb2,$na2,$em2,$co2) = split(/<>/,$log[$#log]);
if ($name eq $na2 && $in{comment} eq $co2) { error("重複投稿は禁止です"); }
# 採番
my $newno = $no2 + 1;
# 記事数チェック
if ($cf{m_max} < $res+1) { error("最大記事数をオーバーしたため投稿できません"); }
elsif ($cf{m_max} == $res+1) { $maxflag = 1; }
else { $maxflag = 0; }
# ファイルアップ
my ($upflg,%ex,%w,%h);
if ($cf{image_upl} && ($in{upfile1} || $in{upfile2} || $in{upfile3})) {
($ex{1},$w{1},$h{1},$ex{2},$w{2},$h{2},$ex{3},$w{3},$h{3}) = &upload($time);
# 画像アップのときはフラグを立てる
if ($ex{1} || $ex{2} || $ex{3}) { $upflg = $time; }
}
# スレッド更新
$res++;
unshift(@log,"$no<>$sub<>$res<>1<>\n");
push(@log,"$newno<>$in{sub}<>$name<>$in{email}<>$in{comment}<>$date<>$host<>$pwd<>$in{url}<>$in{mlo}<>$au{id}<>$time<>$ex{1},$w{1},$h{1}<>$ex{2},$w{2},$h{2}<>$ex{3},$w{3},$h{3}<>\n");
seek(DAT,0,0);
print DAT @log;
truncate(DAT,tell(DAT));
close(DAT);
## --- 規定記事数オーバのとき
if ($maxflag) {
# 過去ログindex読み込み
open(BAK,"+< $cf{datadir}/index2.log") or error("open err: index2.log");
eval "flock(BAK, 2);";
my @log = <BAK>;
# 現行ログindexから該当スレッド抜き出し
my @new;
open(DAT,"+< $cf{datadir}/index1.log") or error("open err: index1.log");
eval "flock(DAT,2);";
my $top = <DAT>;
while(<DAT>) {
chomp;
my ($no,$sub,$re,$nam,$d,$na2,$key,$upl) = split(/<>/);
if ($in{res} == $no) {
$re++;
unshift(@log,"$no<>$sub<>$re<>$nam<>$date<>$na2<>1<>$upl<>\n");
next;
}
push(@new,"$_\n");
}
# 現行ログindex更新
unshift(@new,$top);
seek(DAT,0,0);
print DAT @new;
truncate(DAT,tell(DAT));
close(DAT);
# 過去ログindex更新
seek(BAK,0,0);
print BAK @log;
truncate(BAK,tell(BAK));
close(BAK);
# --- ソートあり
} elsif ($in{sort} == 1) {
# indexファイル更新
my ($flg,$new,@new,@top);
open(DAT,"+< $cf{datadir}/index1.log") or error("open err: index1.log");
eval "flock(DAT,2);";
my $top = <DAT>;
while(<DAT>) {
chomp;
my ($no,$sub,$re,$nam,$da,$na2,$key,$upl) = split(/<>/);
if ($key == 2) {
push(@top,"$_\n");
next;
}
if ($in{res} == $no) {
$flg = 1;
$new = "$in{res}<>$sub<>$res<>$nam<>$date<>$name<>1<>$upl<>\n";
next;
}
push(@new,"$_\n");
}
if (!$flg) { error("該当のスレッドがindexファイルに見当たりません"); }
my ($no2,$host2,$time2) = split(/<>/,$top);
unshift(@new,$new);
unshift(@new,@top) if (@top > 0);
unshift(@new,"$no2<>$host<>$time<>\n");
seek(DAT,0,0);
print DAT @new;
truncate(DAT,tell(DAT));
close(DAT);
# --- ソートなし
} else {
# indexファイル更新
my ($flg,@new);
open(DAT,"+< $cf{datadir}/index1.log") or error("open err: index1.log");
eval "flock(DAT,2);";
my $top = <DAT>;
while(<DAT>) {
chomp;
my ($no,$sub,$re,$nam,$da,$na2,$key,$upl) = split(/<>/);
if ($in{res} == $no) {
$flg = 1;
$_ = "$in{res}<>$sub<>$res<>$nam<>$date<>$name<>1<>$upl<>";
}
push(@new,"$_\n");
}
if (!$flg) { error("該当のスレッドがindexファイルに見当たりません"); }
my ($no2,$host2,$time2) = split(/<>/,$top);
unshift(@new,"$no2<>$host<>$time<>\n");
seek(DAT,0,0);
print DAT @new;
truncate(DAT,tell(DAT));
close(DAT);
}
# メール送信
sendmail($name,$date,$host) if ($cf{mailing} == 2);
# 記事番を覚えておく
$read_no = $in{res};
}
# クッキー格納
set_cookie($in{name},$in{email},$in{url},$in{mlo});
# 完了メッセージ
my $msg = "ご投稿ありがとうございました。<br>\n";
if ($maxflag) {
$msg .= qq|ただし1スレッド当りの最大記事数を超えたため、<br>\n|;
$msg .= qq|このスレッドは<a href="$cf{bbs_cgi}?mode=past">過去ログ</a>へ移動しました。\n|;
}
message($msg,$read_no);
}
#-----------------------------------------------------------
# 記事編集
#-----------------------------------------------------------
sub edit_log {
# 投稿チェック
if ($cf{postonly} && $ENV{REQUEST_METHOD} ne 'POST') {
error("不正なリクエストです");
}
# チェック
error("パスワードが未入力です") if ($in{pwd} eq '');
# 汚染チェック
$in{art} =~ s/\D//g;
$in{no} =~ s/\D//g;
# --- 削除
if ($in{job} eq "dele") {
# スレッドより削除記事抽出
my ($flg,$last_nam,$last_dat,@new);
open(DAT,"+< $cf{datadir}/log/$in{art}.cgi") or error("open err: $in{art}.cgi");
eval "flock(DAT,2);";
my $top = <DAT>;
while(<DAT>) {
my ($no,$sub,$nam,$eml,$com,$dat,$ho,$pw,$url,$mlo,$myid,$tim,$upl1,$upl2,$upl3) = split(/<>/);
if ($in{no} == $no) {
$flg = 1;
# パス照合
if (decrypt($in{pwd},$pw) != 1) {
$flg = -1;
last;
}
# スレッドヘッダのレス個数を調整
my ($num,$sub2,$res,$key) = split(/<>/,$top);
$res--;
$top = "$num<>$sub2<>$res<>$key<>\n";
# 画像削除
my $n;
foreach my $upl ($upl1,$upl2,$upl3) {
$n++;
my ($ex) = (split(/,/,$upl))[0];
if (-e "$cf{upldir}/$tim-$n$ex") {
unlink("$cf{upldir}/$tim-$n$ex");
}
}
# スキップ
next;
}
push(@new,$_);
# 最終記事の投稿者と時間を覚えておく
$last_nam = $nam;
$last_dat = $dat;
}
# 不認証
error("認証できません") if ($flg <= 0);
# スレッド更新
unshift(@new,$top);
seek(DAT,0,0);
print DAT @new;
truncate(DAT,tell(DAT));
close(DAT);
# index展開
@new = ();
my (@sort,@top);
open(DAT,"+< $cf{datadir}/index1.log") or error("open err: index1.log");
eval "flock(DAT,2);";
my $top = <DAT>;
while(<DAT>) {
chomp;
my ($no,$sub,$res,$nam,$dat,$na2,$key,$upl) = split(/<>/);
if ($key == 2) {
push(@top,"$_\n");
next;
}
if ($in{art} == $no) {
# indexのレス個数を調整し、最終投稿者と時間を置換
$res--;
$na2 = $last_nam;
$dat = $last_dat;
$_ = "$no<>$sub<>$res<>$nam<>$dat<>$na2<>$key<>$upl<>";
}
push(@new,"$_\n");
# ソート用配列
$dat =~ s/\D//g;
push(@sort,$dat);
}
# 投稿順にソート
@new = @new[sort {$sort[$b] <=> $sort[$a]} 0 .. $#sort];
# index更新
unshift(@new,@top) if (@top > 0);
unshift(@new,$top);
seek(DAT,0,0);
print DAT @new;
truncate(DAT,tell(DAT));
close(DAT);
# 完了メッセージ
message("記事は正常に削除されました。");
# --- ロック
} elsif ($in{job} eq "lock") {
if ($in{no} != 0) { error("ロック処理は親記事のみです"); }
# スレッドより削除記事抽出
open(DAT,"+< $cf{datadir}/log/$in{art}.cgi") or error("open err: $in{art}.cgi");
eval "flock(DAT,2);";
my $top = <DAT>;
my @log = <DAT>;
my ($no,$sub,$res,$key) = split(/<>/,$top);
my $pw = (split(/<>/,$log[0]))[7];
# 照合
if (&decrypt($in{pwd},$pw) != 1) {
close(DAT);
error("パスワードが認証できません");
}
unshift(@log,"$no<>$sub<>$res<>0<>\n");
seek(DAT,0,0);
print DAT @log;
truncate(DAT,tell(DAT));
close(DAT);
# index展開
my ($flg,@log);
open(DAT,"+< $cf{datadir}/index1.log") or error("open err: index1.log");
eval "flock(DAT,2);";
my $top = <DAT>;
while(<DAT>) {
chomp;
my ($no,$sub,$res,$nam,$dat,$na2,$key,$upl) = split(/<>/);
if ($in{art} == $no) {
$flg++;
$_ = "$no<>$sub<>$res<>$nam<>$dat<>$na2<>0<>$upl<>";
}
push(@log,"$_\n");
}
if (!$flg) {
close(DAT);
error("該当記事が見当たりません");
}
unshift(@log,$top);
seek(DAT,0,0);
print DAT @log;
truncate(DAT,tell(DAT));
close(DAT);
# 完了メッセージ
message("スレッドをロックしました。");
# --- 編集
} else {
# 入力チェック
form_check() if ($in{job} eq 'edit2');
my ($flg,@log,@new);
open(DAT,"+< $cf{datadir}/log/$in{art}.cgi") or error("open err: $in{art}.cgi");
eval "flock(DAT,2);";
my $top = <DAT>;
while(<DAT>) {
chomp;
my ($no,$sub,$nam,$eml,$com,$dat,$hos,$pw,$url,$mlo,$myid,$tim,$upl1,$upl2,$upl3) = split(/<>/);
if ($in{no} == $no) {
$flg = 1;
# パスワード未設定
if ($pw eq '') { $flg = -1; last; }
# パスワード照合
if (!decrypt($in{pwd},$pw)) { $flg = -2; last; }
if ($in{job} eq 'edit') {
@log = ($sub,$nam,$eml,$com,$url,$mlo,$tim,$upl1,$upl2,$upl3);
}
# トリップ
my ($moto,$name);
unless ($in{name} =~ /◆/ && $in{name} eq $nam) {
($moto,$name) = trip_name($in{name});
} else {
$name = $in{name};
}
# 添付拡張子
my $ex1 = (split(/,/,$upl1))[0];
my $ex2 = (split(/,/,$upl2))[0];
my $ex3 = (split(/,/,$upl3))[0];
# 添付削除
if ($in{del1}) {
$upl1 = '';
unlink("$cf{upldir}/$tim-1$ex1");
}
if ($in{del2}) {
$upl2 = '';
unlink("$cf{upldir}/$tim-2$ex2");
}
if ($in{del3}) {
$upl3 = '';
unlink("$cf{upldir}/$tim-3$ex3");
}
# 親記事&添付アップ
if ($cf{image_upl} && ($in{upfile1} || $in{upfile2} || $in{upfile3})) {
if ($tim eq "") { error("この記事はアップロードできません"); }
my ($e1,$w1,$h1,$e2,$w2,$h2,$e3,$w3,$h3) = upload($tim);
if ($e1) {
$upl1 = "$e1,$w1,$h1";
if ($ex1 && $ex1 ne $e1) {
unlink("$cf{upldir}/$tim-1$ex1");
}
}
if ($e2) {
$upl2 = "$e2,$w2,$h2";
if ($ex2 && $ex2 ne $e2) {
unlink("$cf{upldir}/$tim-2$ex2");
}
}
if ($e3) {
$upl3 = "$e3,$w3,$h3";
if ($ex3 && $ex3 ne $e3) {
unlink("$cf{upldir}/$tim-3$ex3");
}
}
}
$_ = "$no<>$in{sub}<>$name<>$in{email}<>$in{comment}<>$dat<>$hos<>$pw<>$in{url}<>$in{mlo}<>$myid<>$tim<>$upl1<>$upl2<>$upl3<>";
}
push(@new,"$_\n");
}
error("認証できません") if ($flg <= 0);
# フォーム表示のとき
if ($in{job} eq 'edit') { edit_form(@log); }
# ヘッダ
my ($num,$sub2,$res2,$key) = split(/<>/,$top);
# 親記事の場合は題名を更新
if (!$in{no}) { $sub2 = $in{sub}; }
# 更新
unshift(@new,"$num<>$sub2<>$res2<>$key<>\n");
seek(DAT,0,0);
print DAT @new;
truncate(DAT,tell(DAT));
close(DAT);
# 最終投稿者名
my ($last_nam) = (split(/<>/,$new[$#new]))[2];
# index展開
my @data;
open(DAT,"+< $cf{datadir}/index1.log") or error("open err: index1.log");
eval "flock(DAT,2);";
my $top = <DAT> if (!$in{bakfile});
while(<DAT>) {
chomp;
my ($no,$sub,$res,$nam,$da,$na2,$key2,$upl) = split(/<>/);
if ($in{art} == $no) {
# 親記事修正のとき
if (!$in{no}) {
# 親ログ
my ($tim,$upl1,$upl2,$upl3) = (split(/<>/,$new[1]))[11..14];
my ($ex1) = split(/,/,$upl1);
my ($ex2) = split(/,/,$upl2);
my ($ex3) = split(/,/,$upl3);
if ($ex1 || $ex2 || $ex3) { $upl = $tim; } else { $upl = ''; }
my ($moto,$name);
unless ($in{name} =~ /◆/ && $in{name} eq $nam) {
($moto,$name) = trip_name($in{name});
} else {
$name = $in{name};
}
if ($res2 == 0) { $na2 = $name; }
$_ = "$no<>$in{sub}<>$res<>$name<>$da<>$na2<>$key<>$upl<>";
# レス記事修正のとき
} else {
$_ = "$no<>$sub<>$res<>$nam<>$da<>$last_nam<>$key<>$upl<>";
}
}
push(@data,"$_\n");
}
# index更新
unshift(@data,$top) if (!$in{bakfile});
seek(DAT,0,0);
print DAT @data;
truncate(DAT,tell(DAT));
close(DAT);
# 完了
message("記事を修正しました",$in{art});
}
}
#-----------------------------------------------------------
# メール送信
#-----------------------------------------------------------
sub sendmail {
my ($name,$date,$host) = @_;
# メールタイトル定義
require './lib/jacode.pl';
my $msub = mime_unstructured_header("BBS: $in{sub}");
# コメント内の改行復元
my $com = $in{comment};
$com =~ s/<br>/\n/g;
$com =~ s/</>/g;
$com =~ s/>/</g;
$com =~ s/"/"/g;
$com =~ s/&/&/g;
$com =~ s/'/'/g;
# メール本文を定義
my $mbody = <<EOM;
掲示板に投稿がありました。
投稿日:$date
ホスト:$host
件名 :$in{sub}
お名前:$name
E-mail:$in{email}
URL :$in{url}
$com
EOM
# JISコード変換
my $body;
for my $tmp ( split(/\n/,$mbody) ) {
jcode::convert(\$tmp,'jis','utf8');
$body .= "$tmp\n";
}
# メールアドレスがない場合は管理者メールに置き換え
my $email = $in{email} ? $in{email} : $cf{mailto};
# sendmailコマンド
my $scmd = "$cf{sendmail} -t -i";
if ($cf{sendm_f}) { $scmd .= " -f $email"; }
# 送信
open(MAIL,"| $scmd") or error("送信失敗");
print MAIL "To: $cf{mailto}\n";
print MAIL "From: $email\n";
print MAIL "Subject: $msub\n";
print MAIL "MIME-Version: 1.0\n";
print MAIL "Content-type: text/plain; charset=ISO-2022-JP\n";
print MAIL "Content-Transfer-Encoding: 7bit\n";
print MAIL "X-Mailer: $cf{version}\n\n";
print MAIL "$body\n";
close(MAIL);
}
#-----------------------------------------------------------
# トリップ機能
#-----------------------------------------------------------
sub trip_name {
my $name = shift;
$name =~ s/◆/◇/g;
if ($in{name} =~ /#/) {
my ($handle,$trip) = split(/#/,$name,2);
my $enc = crypt($trip,$cf{trip_key}) || crypt ($trip,'$1$' . $cf{trip_key});
$enc =~ s/^..//;
return ($name,"$handle◆$enc");
} else {
return ($name,$name);
}
}
#-----------------------------------------------------------
# 禁止ワードチェック
#-----------------------------------------------------------
sub no_wd {
my $flg;
foreach ( split(/,/,$cf{no_wd}) ) {
if (index("$in{name} $in{sub} $in{comment}", $_) >= 0) {
$flg = 1;
last;
}
}
if ($flg) { error("禁止ワードが含まれています"); }
}
#-----------------------------------------------------------
# 日本語チェック
#-----------------------------------------------------------
sub jp_wd {
if ($in{comment} !~ /(?:[\xC0-\xDF][\x80-\xBF]|[\xE0-\xEF][\x80-\xBF]{2}|[\xF0-\xF7][\x80-\xBF]{3})/x) {
error("メッセージに日本語が含まれていません");
}
}
#-----------------------------------------------------------
# URL個数チェック
#-----------------------------------------------------------
sub urlnum {
my $com = $in{comment};
my ($num) = ($com =~ s|(https?://)|$1|ig);
if ($num > $cf{urlnum}) {
error("コメント中のURLアドレスは最大$cf{urlnum}個までです");
}
}
#-----------------------------------------------------------
# フォーム入力チェック
#-----------------------------------------------------------
sub form_check {
# 改行カット
$in{sub} =~ s/<br>//g;
$in{name} =~ s/<br>//g;
$in{pwd} =~ s/<br>//g;
$in{captcha} =~ s/<br>//g;
$in{comment} =~ s/(<br>)+$//g;
# チェック
if ($cf{no_wd}) { no_wd(); }
if ($cf{jp_wd}) { jp_wd(); }
if ($cf{urlnum} > 0) { urlnum(); }
# 未入力の場合
$in{sub} ||= '無題';
if ($in{url} eq 'http://') { $in{url} = ''; }
# 投稿内容チェック
my $err;
if ($in{name} eq "") { $err .= "名前は記入必須です<br>"; }
if ($in{email} ne '' && $in{email} !~ /^[\w\.\-]+\@[\w\.\-]+\.[a-zA-Z]{2,6}$/) {
$err .= "E-mailの入力内容が不正です<br>";
}
if ($in{url} ne '' && $in{url} !~ /^https?:\/\/[\w-.!~*'();\/?:\@&=+\$,%#]+$/) {
$err .= "URL情報が不正です<br>";
}
if ($in{comment} eq "") { $err .= "コメントの内容がありません<br>"; }
elsif (count_str($in{comment}) > $cf{max_msg}) {
$err .= "コメントは$cf{max_msg}文字以内で記述してください<br>";
}
error($err) if ($err);
}
#-----------------------------------------------------------
# アクセス制限
#-----------------------------------------------------------
sub get_host {
# IP/ホスト取得
my $host = $ENV{REMOTE_HOST};
my $addr = $ENV{REMOTE_ADDR};
if ($cf{gethostbyaddr} && ($host eq "" || $host eq $addr)) {
$host = gethostbyaddr(pack("C4", split(/\./, $addr)), 2);
}
# IPチェック
my $flg;
foreach ( split(/\s+/,$cf{deny_addr}) ) {
s/\./\\\./g;
s/\*/\.\*/g;
if ($addr =~ /^$_/i) { $flg = 1; last; }
}
if ($flg) {
error("アクセスを許可されていません");
# ホストチェック
} elsif ($host) {
foreach ( split(/\s+/,$cf{deny_host}) ) {
s/\./\\\./g;
s/\*/\.\*/g;
if ($host =~ /$_$/i) { $flg = 1; last; }
}
if ($flg) {
error("アクセスを許可されていません");
}
}
if ($host eq "") { $host = $addr; }
return ($host,$addr);
}
#-----------------------------------------------------------
# 時間取得
#-----------------------------------------------------------
sub get_time {
# 時間取得
my $time = time;
my ($min,$hour,$mday,$mon,$year,$wday) = (localtime($time))[1..6];
my @wk = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
my $date = sprintf("%04d/%02d/%02d(%s) %02d:%02d",
$year+1900,$mon+1,$mday,$wk[$wday],$hour,$min);
return ($date,$time);
}
#-----------------------------------------------------------
# 完了画面
#-----------------------------------------------------------
sub message {
my ($msg,$read) = @_;
open(IN,"$cf{tmpldir}/mesg.html") or error("open err: mesg.html");
my $tmpl = join('',<IN>);
close(IN);
$tmpl =~ s/!bbs_cgi!/$cf{bbs_cgi}/g;
$tmpl =~ s/!message!/$msg/g;
$tmpl =~ s/!read!/$read/g;
$tmpl =~ s|!bbs_css!|$cf{cmnurl}/style.css|g;
$tmpl =~ s/!bbs_title!/$cf{bbs_title}/g;
print "Content-type: text/html; charset=utf-8\n\n";
print $tmpl;
exit;
}
#-----------------------------------------------------------
# 画像アップロード
#-----------------------------------------------------------
sub upload {
my $no = shift;
# サムネイル機能
require './lib/thumb.pl' if ($cf{thumbnail});
my @ret;
foreach my $i (1 .. 3) {
# mimeタイプ
my $mime = $cgi->param_mime("upfile$i");
# ファイル名
my $fname = $cgi->param_filename("upfile$i");
if ($fname =~ /(\.jpe?g|\.png|\.gif)$/i) {
my $ex = $1;
$ex =~ tr/A-Z/a-z/;
if ($ex eq '.jpeg') { $ex = '.jpg'; }
# 整合性チェック
unless *1 {
push(@ret,('','',''));
next;
}
# アップファイル定義
my $imgfile = "$cf{upldir}/$no-$i$ex";
# 書き込み
open(OUT,"+> $imgfile") or error("画像アップ失敗");
binmode(OUT);
print OUT $in{"upfile$i"};
close(OUT);
# パーミッション変更
chmod(0666,$imgfile);
# 画像サイズ取得
my ($w,$h);
if ($ex eq ".jpg") { ($w,$h) = j_size($imgfile); }
elsif ($ex eq ".gif") { ($w,$h) = g_size($imgfile); }
elsif ($ex eq ".png") { ($w,$h) = p_size($imgfile); }
# サムネイル作成
if ($cf{thumbnail}) {
($w,$h) = resize($w,$h);
my $thumb = "$cf{upldir}/$no-s-$i$ex";
make_thumb($imgfile,$thumb,$w,$h);
}
push(@ret,($ex,$w,$h));
} else {
push(@ret,('','',''));
}
}
# 返り値
return @ret;
}
#-----------------------------------------------------------
# JPEGサイズ認識
#-----------------------------------------------------------
sub j_size {
my $jpg = shift;
my ($h,$w,$t);
open(IMG,"$jpg");
binmode(IMG);
read(IMG,$t,2);
while (1) {
read(IMG, $t, 4);
my ($m,$c,$l) = unpack("a a n", $t);
if ($m ne "\xFF") {
$w = $h = 0;
last;
} elsif *2 {
read(IMG, $t, 5);
($h,$w) = unpack("xnn",$t);
last;
} else {
read(IMG,$t,($l - 2));
}
}
close(IMG);
return ($w,$h);
}
#-----------------------------------------------------------
# GIFサイズ認識
#-----------------------------------------------------------
sub g_size {
my $gif = shift;
my $data;
open(IMG,"$gif");
binmode(IMG);
sysread(IMG, $data, 10);
close(IMG);
if ($data =~ /^GIF/) { $data = substr($data, -4); }
my $w = unpack("v", substr($data,0,2));
my $h = unpack("v", substr($data,2,2));
return ($w,$h);
}
#-----------------------------------------------------------
# PNGサイズ認識
#-----------------------------------------------------------
sub p_size {
my $png = shift;
my $data;
open(IMG,"$png");
binmode(IMG);
read(IMG,$data,24);
close(IMG);
my $w = unpack("N", substr($data,16,20));
my $h = unpack("N", substr($data,20,24));
return ($w,$h);
}
#-----------------------------------------------------------
# crypt暗号
#-----------------------------------------------------------
sub encrypt {
my $in = shift;
my @wd = ('a'..'z', 'A'..'Z', 0..9, '.', '/');
srand;
my $salt = $wd[int(rand(@wd))] . $wd[int(rand(@wd))];
crypt($in,$salt) || crypt ($in,'$1$' . $salt);
}
#-----------------------------------------------------------
# crypt照合
#-----------------------------------------------------------
sub decrypt {
my ($in,$dec) = @_;
my $salt = $dec =~ /^\$1\$(.*)\$/ ? $1 : substr($dec, 0, 2);
if (crypt($in,$salt) eq $dec || crypt($in,'$1$' . $salt) eq $dec) {
return 1;
} else {
return 0;
}
}
#-----------------------------------------------------------
# 編集フォーム
#-----------------------------------------------------------
sub edit_form {
my ($sub,$nam,$eml,$com,$url,$mlo,$tim,$up1,$up2,$up3) = @_;
$url ||= 'http://';
my %up = (1 => $up1, 2 => $up2, 3 => $up3);
$com =~ s/<br>/\n/g;
# テンプレート読み込み
open(IN,"$cf{tmpldir}/edit.html") or error("open err: edit.html");
my $tmpl = join('',<IN>);
close(IN);
# 画像フォーム
if (!$cf{image_upl}) {
$tmpl =~ s|<!-- upfile -->.+?<!-- /upfile -->||s;
} else {
$tmpl =~ s/<!-- edit:([1-3]) -->/upf_edit($1,$tim,$up{$1})/ge;
}
# アイコン
my $smile;
my @smile = split(/\s+/, $cf{smile});
for (0 .. $#smile) {
$smile .= qq|<a href="javascript:face('{ico:$_}')"><img src="$cf{cmnurl}/$smile[$_]" class="icon"></a>|;
}
# email表示
my $op_mlo;
my @mlo = ('非表示','表示');
foreach (1,0) {
if ($mlo eq $_) {
$op_mlo .= qq|<option value="$_" selected>$mlo[$_]\n|;
} else {
$op_mlo .= qq|<option value="$_">$mlo[$_]\n|;
}
}
# 文字置換
$tmpl =~ s|!bbs_css!|$cf{cmnurl}/style.css|g;
$tmpl =~ s/!bbs_title!/$cf{bbs_title}/g;
$tmpl =~ s/!sub!/$sub/g;
$tmpl =~ s/!name!/$nam/g;
$tmpl =~ s/!email!/$eml/g;
$tmpl =~ s/!url!/$url/g;
$tmpl =~ s/!art!/$in{art}/g;
$tmpl =~ s/!no!/$in{no}/g;
$tmpl =~ s/!comment!/$com/g;
$tmpl =~ s/!pwd!/$in{pwd}/g;
$tmpl =~ s/!([a-z]+_cgi)!/$cf{$1}/g;
$tmpl =~ s|!ico:(\w+\.\w+)!|<img src="$cf{cmnurl}/$1" alt="">|g;
$tmpl =~ s/!smile!/$smile/g;
$tmpl =~ s/<!-- op_mlo -->/$op_mlo/g;
# 画面表示
print "Content-type: text/html; charset=utf-8\n\n";
print $tmpl;
exit;
}
#-----------------------------------------------------------
# アップファイル編集ボタン
#-----------------------------------------------------------
sub upf_edit {
my ($num,$tim,$upl) = @_;
my ($ex) = split(/,/,$upl);
# 拡張子がない場合
return if (!$ex);
my $btn = <<EOM;
<input type="checkbox" name="del$num" value="1">削除
[<a href="$cf{uplurl}/$tim-$num$ex" target="_blank">添付$num</a>]
EOM
return $btn;
}
#-----------------------------------------------------------
# 認証モード
#-----------------------------------------------------------
sub authent {
# セッションモジュール取り込み
require $cf{session_pl};
# セッション管理
session("$cf{datadir}/ses",$cf{bbs_cgi});
}
#-----------------------------------------------------------
# クッキー発行
#-----------------------------------------------------------
sub set_cookie {
my @data = @_;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,undef,undef) = gmtime(time + 60*24*60*60);
my @mon = qw|Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec|;
my @week = qw|Sun Mon Tue Wed Thu Fri Sat|;
# 時刻フォーマット
my $gmt = sprintf("%s, %02d-%s-%04d %02d:%02d:%02d GMT",
$week[$wday],$mday,$mon[$mon],$year+1900,$hour,$min,$sec);
# URLエンコード
my $cook;
foreach (@data) {
s/(\W)/sprintf("%%%02X", unpack("C", $1))/eg;
$cook .= "$_<>";
}
print "Set-Cookie: $cf{cookie_id}=$cook; expires=$gmt\n";
}
#-----------------------------------------------------------
# mimeエンコード
# [quote] http://www.din.or.jp/~ohzaki/perl.htm#JP_Base64
#-----------------------------------------------------------
sub mime_unstructured_header {
my $oldheader = shift;
jcode::convert(\$oldheader,'euc','utf8');
my ($header,@words,@wordstmp,$i);
my $crlf = $oldheader =~ /\n$/;
$oldheader =~ s/\s+$//;
@wordstmp = split /\s+/, $oldheader;
for ($i = 0; $i < $#wordstmp; $i++) {
if ($wordstmp[$i] !~ /^[\x21-\x7E]+$/ and
$wordstmp[$i + 1] !~ /^[\x21-\x7E]+$/) {
$wordstmp[$i + 1] = "$wordstmp[$i] $wordstmp[$i + 1]";
} else {
push(@words, $wordstmp[$i]);
}
}
push(@words, $wordstmp[-1]);
foreach my $word (@words) {
if ($word =~ /^[\x21-\x7E]+$/) {
$header =~ /(?:.*\n)*(.*)/;
if (length($1) + length($word) > 76) {
$header .= "\n $word";
} else {
$header .= $word;
}
} else {
$header = add_encoded_word($word, $header);
}
$header =~ /(?:.*\n)*(.*)/;
if (length($1) == 76) {
$header .= "\n ";
} else {
$header .= ' ';
}
}
$header =~ s/\n? $//mg;
$crlf ? "$header\n" : $header;
}
sub add_encoded_word {
my ($str, $line) = @_;
my $result;
my $ascii = '[\x00-\x7F]';
my $twoBytes = '[\x8E\xA1-\xFE][\xA1-\xFE]';
my $threeBytes = '\x8F[\xA1-\xFE][\xA1-\xFE]';
while (length($str)) {
my $target = $str;
$str = '';
if (length($line) + 22 +
($target =~ /^(?:$twoBytes|$threeBytes)/o) * 8 > 76) {
$line =~ s/[ \t\n\r]*$/\n/;
$result .= $line;
$line = ' ';
}
while (1) {
my $encoded = '=?ISO-2022-JP?B?' .
b64encode(jcode::jis($target,'euc','z')) . '?=';
if (length($encoded) + length($line) > 76) {
$target =~ s/($threeBytes|$twoBytes|$ascii)$//o;
$str = $1 . $str;
} else {
$line .= $encoded;
last;
}
}
}
$result . $line;
}
# [quote] http://www.tohoho-web.com/perl/encode.htm
sub b64encode {
my $buf = shift;
my ($mode,$tmp,$ret);
my $b64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
. "abcdefghijklmnopqrstuvwxyz"
. "0123456789+/";
$mode = length($buf) % 3;
if ($mode == 1) { $buf .= "\0\0"; }
if ($mode == 2) { $buf .= "\0"; }
$buf =~ s/(...)/{
$tmp = unpack("B*", $1);
$tmp =~ s|(......)|substr($b64, ord(pack("B*", "00$1")), 1)|eg;
$ret .= $tmp;
}/eg;
if ($mode == 1) { $ret =~ s/..$/==/; }
if ($mode == 2) { $ret =~ s/.$/=/; }
return $ret;
}
#-----------------------------------------------------------
# 文字数カウント for UTF-8
#-----------------------------------------------------------
sub count_str {
my ($str) = @_;
# UTF-8定義
my $byte1 = '[\x00-\x7f]';
my $byte2 = '[\xC0-\xDF][\x80-\xBF]';
my $byte3 = '[\xE0-\xEF][\x80-\xBF]{2}';
my $byte4 = '[\xF0-\xF7][\x80-\xBF]{3}';
my $i = 0;
while ($str =~ /($byte1|$byte2|$byte3|$byte4)/gx) {
$i++;
}
return $i;
}
KENTさんのpatio.cgi
以下は、KENTさんの次のURLで公開されているpatio.cgiです。KENTさんはフリーソフトだと言っていますが、著作権は放棄していないそうです。Bravo-Astroxが一部変更
https://www.kent-web.com/bbs/patio.html
KENTさんのjoyful.cgi
以下は、KENTさんがweb
https://www.kent-web.com/bbs/joyful.html
で公開しているJoyful Noteのjoyful.cgiです。[このプログラムはフリーソフトです。個人・法人に限らず利用者は自由に使用することができます(ただし、著作権は放棄していません)」と記載あり。
#!/usr/local/bin/perl
#┌─────────────────────────────────
#│ JOYFUL NOTE : joyful.cgi - 2021/07/24
#│ copyright (c) KentWeb, 1997-2021
#│ https://www.kent-web.com/
#└─────────────────────────────────
# モジュール宣言
use strict;
use CGI::Carp qw(fatalsToBrowser);
use lib "./lib";
use CGI::Minimal;
# 設定ファイル認識
require "./init.cgi";
my %cf = set_init();
# データ受理
CGI::Minimal::max_read_size($cf{maxdata});
my $cgi = CGI::Minimal->new;
error('容量オーバー') if ($cgi->truncated);
my %in = parse_form($cgi);
# アクセス制限
passwd(%in) if ($cf{enter_pwd} ne '');
# 処理分岐
if ($in{mode} eq 'find') { find_data(); }
if ($in{mode} eq 'note') { note_page(); }
if ($in{mode} eq 'past') { past_data(); }
if ($in{mode} eq 'view') { view_page(); }
bbs_list();
#-----------------------------------------------------------
# 記事表示部
#-----------------------------------------------------------
sub bbs_list {
# 返信フォーム
$in{res} =~ s/\D//g;
$in{read} =~ s/\D//g;
res_form($in{res}) if ($in{res} || $in{read});
# トピック表示
bbs_topic() if ($in{bbs} == 1);
# ページ数定義
my $pg = $in{pg} || 0;
# 記事展開
my ($i,@log,%res,%nam,%sub,%dat,%com,%url,%col,%ext,%imw,%imh);
open(IN,"$cf{datadir}/log.cgi") or error("open err: log.cgi");
my $top = <IN>;
while (<IN>) {
my ($no,$reno,$date,$name,$eml,$sub,$com,$url,$host,$pw,$col,$ext,$w,$h,$chk) = split(/<>/);
++$i if (!$reno);
next if ($i < $pg + 1);
next if ($i > $pg + $cf{max_thread});
# 親記事
if (!$reno) {
push(@log,$no);
# レス記事
} else {
$res{$reno} .= "$no,";
}
# リンク
$name = qq|<a href="mailto:$eml">$name</a>| if ($eml);
$url &&= qq|<a href="$url" target="_blank"><img src="$cf{cmnurl}/home.png" alt="Home" class="icon"></a>|;
$com = auto_link($com) if ($cf{auto_link});
# ハッシュ化
$nam{$no} = $name;
$sub{$no} = $sub;
$dat{$no} = $date;
$com{$no} = $com;
$col{$no} = $col;
$url{$no} = $url;
if ($ext) {
if ($cf{img_check} && $chk eq '0') {
$ext{$no} = "hide";
} else {
$ext{$no} = $ext;
$imw{$no} = $w;
$imh{$no} = $h;
}
}
}
close(IN);
# 繰越ボタン作成
my $page_btn = make_pgbtn($i,$pg,'',$cf{max_thread});
# クッキー取得
my @cook = get_cookie();
$cook[2] ||= 'http://';
# 色選択ボタン
my @col = split(/\s+/,$cf{colors});
my $color;
foreach (0 .. $#col) {
if ($_ == $cook[3]) {
$color .= qq|<input type="radio" name="color" value="$_" checked>|;
} else {
$color .= qq|<input type="radio" name="color" value="$_">|;
}
$color .= qq|<span style="color:$col[$_]">■</span>\n|;
}
# テンプレート読込
open(IN,"$cf{tmpldir}/bbs.html") or error("open err: bbs.html");
my $tmpl = join('',<IN>);
close(IN);
$tmpl =~ s/!bbs_title!/$cf{bbs_title}/g;
$tmpl =~ s|!icon:(\w+\.\w+)!|<img src="$cf{cmnurl}/$1" alt="$1" class="icon">|g;
$tmpl =~ s|!bbs_css!|$cf{cmnurl}/bbs.css|g;
$tmpl =~ s|!bbs_js!|$cf{cmnurl}/bbs.js|g;
open(IN,"$cf{tmpldir}/res.html") or error("open err: res.html");
my $resloop = join('',<IN>);
close(IN);
$resloop =~ s|!icon:(\w+\.\w+)!|<img src="$cf{cmnurl}/$1" alt="$1" class="icon">|g;
# テンプレート分割
my ($head,$loop,$foot) = $tmpl =~ m|(.+)<!-- loop -->(.+?)<!-- /loop -->(.+)|s
? ($1,$2,$3)
: error("テンプレート不正");
# 画像認証作成
my ($str_plain,$str_crypt);
if ($cf{use_captcha} > 0) {
require $cf{captcha_pl};
($str_plain,$str_crypt) = cap::make($cf{captcha_key},$cf{cap_len});
} else {
$head =~ s|<!-- captcha -->.+?<!-- /captcha -->||s;
}
# 文字置換
for ($head,$foot) {
s/!([a-z]+_cgi)!/$cf{$1}/g;
s/!homepage!/$cf{homepage}/g;
s/!page_btn!/$page_btn/g;
s/!name!/$cook[0]/;
s/!email!/$cook[1]/;
s/!url!/$cook[2]/;
s/!str_crypt!/$str_crypt/g;
s/!color!/$color/g;
s/!sub!//g;
s/!reno!//g;
}
# ヘッダ表示
print "Content-type: text/html; charset=utf-8\n\n";
print $head;
# 記事表示
for (@log) {
# レス
my $res;
foreach my $r ( split(/,/, $res{$_}) ) {
# 添付
$com{$r} = qq|<span style="color:$col[$col{$r}]">$com{$r}</span>|;
if (defined($ext{$r})) {
$com{$r} = att_file($r,$com{$r},$ext{$r},$imw{$r},$imh{$r});
}
my $tmp = $resloop;
$tmp =~ s/!sub!/$sub{$r}/g;
$tmp =~ s/!name!/$nam{$r}/g;
$tmp =~ s/!url!/$url{$r}/g;
$tmp =~ s/!date!/$dat{$r}/g;
$tmp =~ s/!num!/$r/g;
$tmp =~ s/!comment!/$com{$r}/g;
$res .= $tmp;
}
# 添付
$com{$_} = qq|<span style="color:$col[$col{$_}]">$com{$_}</span>|;
if (defined($ext{$_})) {
$com{$_} = att_file($_,$com{$_},$ext{$_},$imw{$_},$imh{$_});
}
my $tmp = $loop;
$tmp =~ s/!sub!/$sub{$_}/g;
$tmp =~ s/!name!/$nam{$_}/g;
$tmp =~ s/!url!/$url{$_}/g;
$tmp =~ s/!date!/$dat{$_}/g;
$tmp =~ s/!num!/$_/g;
$tmp =~ s/!comment!/$com{$_}/g;
$tmp =~ s/!bbs_cgi!/$cf{bbs_cgi}/g;
$tmp =~ s|<!-- res -->|<div class="ta-r">$res</div>|g if ($res);
print $tmp;
}
# フッタ
footer($foot);
}
#-----------------------------------------------------------
# 返信フォーム
#-----------------------------------------------------------
sub res_form {
my $resnum = $in{res} ? $in{res} : $in{read};
# my $bbs = $in{bbs} == 1 ? 1 : 0;
my ($flg,$resub,@res,%nam,%sub,%dat,%com,%url,%ext,%chk,%col,%imw,%imh);
open(IN,"$cf{datadir}/log.cgi");
my $top = <IN>;
while (<IN>) {
my ($no,$reno,$date,$name,$eml,$sub,$com,$url,$host,$pw,$col,$ext,$w,$h,$chk) = split(/<>/);
if ($resnum == $no) {
$flg = 1;
# タイトル名
if ($sub =~ /^Re:/) {
$resub = $sub;
} else {
$resub = "Re: $sub";
}
} elsif ($resnum == $reno) {
push(@res,$no);
} else {
next;
}
# リンク
$name = qq|<a href="mailto:$eml">$name</a>| if ($eml);
$url &&= qq|<a href="$url" target="_blank"><img src="$cf{cmnurl}/home.png" class="icon" alt="Home"></a>|;
$com = auto_link($com) if ($cf{auto_link});
$nam{$no} = $name;
$sub{$no} = $sub;
$dat{$no} = $date;
$com{$no} = $com;
$col{$no} = $col;
$url{$no} = $url;
$chk{$no} = $chk;
if ($ext) {
if ($cf{img_check} && $chk eq '0') {
$ext{$no} = "hide";
} else {
$ext{$no} = $ext;
$imw{$no} = $w;
$imh{$no} = $h;
}
}
}
close(IN);
if (!$flg) { error("不正な返信要求です"); }
# クッキー取得
my @cook = get_cookie();
$cook[2] ||= 'http://';
# 色選択ボタン
my @col = split(/\s+/,$cf{colors});
my $color;
foreach (0 .. $#col) {
if ($_ == $cook[3]) {
$color .= qq|<input type="radio" name="color" value="$_" checked>|;
} else {
$color .= qq|<input type="radio" name="color" value="$_">|;
}
$color .= qq|<span style="color:$col[$_]">■</span>\n|;
}
# テンプレート読込
my $file = $in{read} ? 'topic2.html' : 'bbs.html';
open(IN,"$cf{tmpldir}/$file") or error("open err: $file");
my $tmpl = join('',<IN>);
close(IN);
$tmpl =~ s|!icon:(\w+\.\w+)!|<img src="$cf{cmnurl}/$1" alt="$1" class="icon">|g;
$tmpl =~ s|!bbs_css!|$cf{cmnurl}/bbs.css|g;
$tmpl =~ s|!bbs_js!|$cf{cmnurl}/bbs.js|g;
$tmpl =~ s/!bbs!/$in{bbs} eq '' ? 0 : $in{bbs}/eg;
$tmpl =~ s/!pg!/$in{pg} eq '' ? 0 : $in{pg}/eg;
open(IN,"$cf{tmpldir}/res.html") or error("open err: res.html");
my $resloop = join('',<IN>);
close(IN);
$resloop =~ s|!icon:(\w+\.\w+)!|<img src="$cf{cmnurl}/$1" alt="$1" class="icon">|g;
# 過去ログ
# $tmpl =~ s/<!-- past -->.+<!-- past -->//s if ($cf{pastkey} == 0);
# テンプレート分割
my ($head,$loop,$foot) = $tmpl =~ m|(.+)<!-- loop -->(.+)<!-- /loop -->(.+)|s
? ($1,$2,$3)
: error("テンプレート不正");
# 画像認証作成
my ($str_plain,$str_crypt);
if ($cf{use_captcha} > 0) {
require $cf{captcha_pl};
($str_plain,$str_crypt) = cap::make($cf{captcha_key},$cf{cap_len});
} else {
$head =~ s|<!-- captcha -->.+?<!-- /captcha -->||s;
}
# 文字置換
for ($head, $foot) {
s/!bbs_title!/$cf{bbs_title}/g;
s/!([a-z]+_cgi)!/$cf{$1}/g;
s/!homepage!/$cf{homepage}/g;
s/!name!/$cook[0]/;
s/!email!/$cook[1]/;
s/!url!/$cook[2]/;
s/!str_crypt!/$str_crypt/g;
s/!color!/$color/g;
s/!sub!/$resub/g;
s/!reno!/$resnum/g;
s/!counter!//g;
s/!page_btn!//g;
}
# ヘッダ表示
print "Content-type: text/html; charset=utf-8\n\n";
print $head;
# レス
my $res;
foreach my $r (@res) {
# 添付
$com{$r} = qq|<span style="color:$col[$col{$r}]">$com{$r}</span>|;
if (defined($ext{$r})) {
$com{$r} = att_file($r,$com{$r},$ext{$r},$imw{$r},$imh{$r});
}
# 文字置換
my $tmp = $resloop;
$tmp =~ s/!sub!/$sub{$r}/g;
$tmp =~ s/!name!/$nam{$r}/g;
$tmp =~ s/!date!/$dat{$r}/g;
$tmp =~ s/!url!/$url{$r}/g;
$tmp =~ s/!num!/$r/g;
$tmp =~ s|!comment!|$com{$r}|g;
$res .= $tmp;
}
# 添付
$com{$resnum} = qq|<span style="color:$col[$col{$resnum}]">$com{$resnum}</span>|;
if (defined($ext{$resnum})) {
$com{$resnum} = att_file($resnum,$com{$resnum},$ext{$resnum},$imw{$resnum},$imh{$resnum});
}
# 文字置換
$loop =~ s/!sub!/$sub{$resnum}/g;
$loop =~ s/!name!/$nam{$resnum}/g;
$loop =~ s/!date!/$dat{$resnum}/g;
$loop =~ s/!url!/$url{$resnum}/g;
$loop =~ s/!num!/$resnum/g;
$loop =~ s/!comment!/$com{$resnum}/g;
$loop =~ s/!bbs_cgi!/$cf{bbs_cgi}/g;
$loop =~ s|<!-- res -->|<div class="ta-r">$res</div>|g if ($res);
print $loop;
# フッタ
footer($foot);
}
#-----------------------------------------------------------
# ワード検索
#-----------------------------------------------------------
sub find_data {
# 条件/表示形式
$in{cond} =~ s/\D//g;
my $bbs = $in{bbs} == 1 ? 1 : 0;
# 検索条件プルダウン
my %op = (1 => 'AND', 0 => 'OR');
my $op_cond;
foreach (1,0) {
if ($in{cond} eq $_) {
$op_cond .= qq|<option value="$_" selected>$op{$_}</option>\n|;
} else {
$op_cond .= qq|<option value="$_">$op{$_}</option>\n|;
}
}
# 検索実行
my ($hit,@log) = search("$cf{datadir}/log.cgi") if ($in{word} ne '');
# テンプレート
open(IN,"$cf{tmpldir}/find.html") or error("open err: find.html");
my $tmpl = join('',<IN>);
close(IN);
$tmpl =~ s/!bbs_title!/$cf{bbs_title}/g;
$tmpl =~ s|!icon:(\w+\.\w+)!|<img src="$cf{cmnurl}/$1" alt="$1" class="icon">|g;
$tmpl =~ s|!bbs_css!|$cf{cmnurl}/bbs.css|g;
$tmpl =~ s|!bbs_js!|$cf{cmnurl}/bbs.js|g;
# 分割
my ($head,$loop,$foot) = $tmpl =~ m|(.+)<!-- loop -->(.+)<!-- /loop -->(.+)|s
? ($1,$2,$3)
: error("テンプレート不正");
# 文字置換え
for ($head, $foot) {
s/!bbs_cgi!/$cf{bbs_cgi}/g;
s/<!-- op_cond -->/$op_cond/;
s/!word!/$in{word}/;
s/!bbs!/$bbs/g;
}
# ヘッダ部
print "Content-type: text/html; charset=utf-8\n\n";
print $head;
# ループ部
foreach my $log (@log) {
my ($no,$reno,$date,$name,$eml,$sub,$com,$url,$host,$pw,$col,$ext,$w,$h,$chk) = split(/<>/,$log);
$name = qq|<a href="mailto:$eml">$name</a>| if ($eml);
$com = auto_link($com) if ($cf{auto_link});
$url = qq|<a href="$url" target="_blank"><img src="$cf{cmnurl}/home.png" class="icon" alt="Home"></a>| if ($url);
if ($ext) {
if ($cf{img_check} && $chk eq '0') {
$ext = "hide";
}
$com = att_file($no,$com,$ext,$w,$h);
}
my $tmp = $loop;
$tmp =~ s/!num!/$no/g;
$tmp =~ s/!sub!/$sub/g;
$tmp =~ s/!date!/$date/g;
$tmp =~ s/!name!/$name/g;
$tmp =~ s/!home!/$url/g;
$tmp =~ s/!comment!/$com/g;
print $tmp;
}
# フッタ
footer($foot);
}
#-----------------------------------------------------------
# 検索実行
#-----------------------------------------------------------
sub search {
my ($file,$list,$stat) = @_;
# キーワードを配列化
$in{word} =~ s/ / /g;
my @wd = split(/\s+/,$in{word});
# UTF-8定義
my $byte1 = '[\x00-\x7f]';
my $byte2 = '[\xC0-\xDF][\x80-\xBF]';
my $byte3 = '[\xE0-\xEF][\x80-\xBF]{2}';
my $byte4 = '[\xF0-\xF7][\x80-\xBF]{3}';
# 検索処理
my ($i,@log);
open(IN,"$file") or error("open err: $file");
my $top = <IN> if (!$stat);
while (<IN>) {
my ($no,$reno,$date,$nam,$eml,$sub,$com,$url,$hos,$pw,$col,$ext,$w,$h,$chk) = split(/<>/);
my $flg;
foreach my $wd (@wd) {
if ("$nam $eml $sub $com $url" =~ /^(?:$byte1|$byte2|$byte3|$byte4)*?\Q$wd\E/i) {
$flg++;
if ($in{cond} == 0) { last; }
} else {
if ($in{cond} == 1) { $flg = 0; last; }
}
}
next if (!$flg);
$i++;
if ($list > 0) {
next if ($i < $in{pg} + 1);
next if ($i > $in{pg} + $list);
}
push(@log,$_);
}
close(IN);
# 検索結果
return ($i,@log);
}
#-----------------------------------------------------------
# 留意事項表示
#-----------------------------------------------------------
sub note_page {
# 許可拡張子(表示用)
my $ext = ext_file();
open(IN,"$cf{tmpldir}/note.html") or error("open err: note.html");
my $tmpl = join('',<IN>);
close(IN);
$tmpl =~ s/!bbs_title!/$cf{bbs_title}/g;
$tmpl =~ s/!file!/$ext/g;
$tmpl =~ s/!maxdata!/$cf{maxdata}バイト/g;
$tmpl =~ s/!max_w!/$cf{max_img_w}/g;
$tmpl =~ s/!max_h!/$cf{max_img_h}/g;
$tmpl =~ s|!bbs_css!|$cf{cmnurl}/bbs.css|g;
$tmpl =~ s|!bbs_js!|$cf{cmnurl}/bbs.js|g;
print "Content-type: text/html; charset=utf-8\n\n";
print $tmpl;
exit;
}
#-----------------------------------------------------------
# アルバム機能
#-----------------------------------------------------------
sub view_page {
# ページ数/表示形式
my $pg = $in{pg} || 0;
my $bbs = $in{bbs} == 1 ? 1 : 0;
# 画像サイズ再定義
$cf{max_img_w} = $cf{alb_img_w};
$cf{max_img_h} = $cf{alb_img_h};
# テンプレート認識
open(IN,"$cf{tmpldir}/view.html") or error("open err: view.html");
my $tmpl = join('',<IN>);
close(IN);
$tmpl =~ s/!bbs_title!/$cf{bbs_title}/g;
$tmpl =~ s|!bbs_css!|$cf{cmnurl}/bbs.css|g;
$tmpl =~ s|!bbs_js!|$cf{cmnurl}/bbs.js|g;
$tmpl =~ s|!cmnurl!|$cf{cmnurl}|g;
# テンプレート分割
my ($head,$loop,$foot) = $tmpl =~ m|(.+)<!-- loop -->(.+?)<!-- /loop -->(.+)|s
? ($1,$2,$3)
: error("テンプレート不正");
# データ読み込み
my ($i,@img);
open(IN,"$cf{datadir}/log.cgi");
my $top = <IN>;
while (<IN>) {
my ($no,$reno,$date,$name,$eml,$sub,$com,$url,$host,$pw,$col,$ex,$w,$h,$chk) = split(/<>/);
next if ($cf{img_check} && $chk eq '0');
next if ($ex !~ /(jpg|png|gif)$/);
$i++;
next if ($i < $pg + 1);
next if ($i > $pg + $cf{max_albums});
# 画像データ収集
push(@img,"$no\t$sub\t$ex\t$w\t$h");
}
close(IN);
# 繰越ボタン
my $page_btn = make_pgbtn($i,$pg,'&mode=view',$cf{max_albums});
# 文字置換
for ($head, $foot) {
s/!([a-z]+_cgi)!/$cf{$1}/g;
s/!page_btn!/$page_btn/g;
s/!bbs!/$bbs/g;
}
# 画面展開
print "Content-type: text/html; charset=utf-8\n\n";
print $head;
for (@img) {
my ($no,$sub,$ex,$w,$h) = split(/\t/);
($w,$h) = resize($w,$h);
my $tmp = $loop;
$tmp =~ s|!image!|<img src="$cf{imgurl}/$no$ex" alt="$sub" title="$sub" width="$w" height="$h">|;
print $tmp;
}
# フッタ
footer($foot);
}
#-----------------------------------------------------------
# 過去ログ画面
#-----------------------------------------------------------
sub past_data {
# 過去ログ番号
open(IN,"$cf{nofile}") or error("open err: $cf{nofile}");
my $pastnum = <IN>;
close(IN);
my $pastnum = sprintf("%04d", $pastnum);
$in{pno} =~ s/\D//g;
$in{pno} ||= $pastnum;
# プルダウンタグ作成
my $op_pno;
for ( my $i = $pastnum; $i > 0; $i-- ) {
$i = sprintf("%04d", $i);
if ($in{pno} == $i) {
$op_pno .= qq|<option value="$i" selected>$i</option>\n|;
} else {
$op_pno .= qq|<option value="$i">$i</option>\n|;
}
}
# ページ数
my $pg = $in{pg} || 0;
# 初期化
my ($hit,$page_btn,$hit,@log,%res);
# 対象ログ定義
my $file = "$cf{pastdir}/" . sprintf("%04d", $in{pno}) . ".cgi";
# ワード検索
if ($in{find} && $in{word} ne '') {
# 検索
($hit,@log) = search($file,$in{list},'past');
# 結果
$page_btn = "検索結果:<b>$hit</b>件 " . pgbtn_old($hit,$in{pno},$pg,$in{list},'find');
# ログ一覧
} else {
my $pg_max = $cf{max_thread} * 2;
# 過去ログオープン
my $i = 0;
open(IN,"$file") or error("open err: $file");
while(<IN>) {
my ($no,$reno,$date,$nam,$eml,$sub,$com,$url,$hos,$pw,$col,$ext,$w,$h,$chk) = split(/<>/);
++$i if ($reno eq '');
next if ($i < $pg + 1);
next if ($i > $pg + $pg_max);
if ($reno) {
$res{$reno} .= "$no<>$reno<>$date<>$nam<>$eml<>$sub<>$com<>$url<>$col\0";
next;
}
push(@log,$_);
}
close(IN);
# 繰越ボタン作成
$page_btn = pgbtn_old($i,$in{pno},$pg,$pg_max);
}
# プルダウン作成(検索条件)
my %op = make_op();
# テンプレート読み込み
open(IN,"$cf{tmpldir}/past.html") or error("open err: past.html");
my $tmpl = join('',<IN>);
close(IN);
$tmpl =~ s|!icon:(\w+\.\w+)!|<img src="$cf{cmnurl}/$1" alt="$1" class="icon">|g;
$tmpl =~ s/!bbs_title!/$cf{bbs_title}/g;
$tmpl =~ s|!bbs_css!|$cf{cmnurl}/bbs.css|g;
$tmpl =~ s|!bbs_js!|$cf{cmnurl}/bbs.js|g;
open(IN,"$cf{tmpldir}/res.html") or error("open err: res.html");
my $restmpl = join('', <IN>);
close(IN);
$restmpl =~ s|!icon:(\w+\.\w+)!|<img src="$cf{cmnurl}/$1" alt="$1" class="icon">|g;
# テンプレート分割
my ($head,$loop,$foot) = $tmpl =~ m|(.+)<!-- loop -->(.+)<!-- /loop -->(.+)|s
? ($1,$2,$3)
: error("テンプレート不正");
if ($in{change}) { $in{word} = ''; }
my @col = split(/\s+/,$cf{colors});
# 文字置換
for ($head, $foot) {
s/!past_num!/$in{pno}/g;
s/!bbs_url!//g;
s/!([a-z]+_cgi)!/$cf{$1}/g;
s/<!-- op_pno -->/$op_pno/g;
s/<!-- op_(\w+) -->/$op{$1}/g;
s/!word!/$in{word}/g;
s/!page_btn!/$page_btn/g;
}
# 画面表示
print "Content-type: text/html; charset=utf-8\n\n";
print $head;
foreach (@log) {
my ($no,$reno,$date,$nam,$eml,$sub,$com,$url,$hos,$pw,$col,$ext,$w,$h,$chk) = split(/<>/);
$nam = qq|<a href="mailto:$eml">$nam</a>| if ($eml);
$com = auto_link($com) if ($cf{auto_link});
$url = qq|<a href="$url" target="_blank"><img src="$cf{cmnurl}/home.png" class="icon" alt="Home"></a>| if ($url);
# レス
my $res;
foreach my $log ( split(/\0/,$res{$no}) ) {
my ($no,$reno,$date,$nam,$eml,$sub,$com,$url,$col) = split(/<>/, $log);
$nam = qq|<a href="mailto:$eml">$nam</a>| if ($eml);
$com = auto_link($com) if ($cf{auto_link});
$url = qq|<a href="$url" target="_blank"><img src="$cf{cmnurl}/home.png" class="icon" alt="Home"></a>| if ($url);
my $tmp = $restmpl;
$tmp =~ s/!sub!/$sub/g;
$tmp =~ s/!name!/$nam/g;
$tmp =~ s/!date!/$date/g;
$tmp =~ s/!url!/$url/g;
$tmp =~ s/!num!/$no/g;
$tmp =~ s/!comment!/<span style="color:$col[$col]">$com<\/span>/g;
$res .= $tmp;
}
my $tmp = $loop;
$tmp =~ s/!num!/$no/g;
$tmp =~ s/!sub!/$sub/g;
$tmp =~ s/!date!/$date/g;
$tmp =~ s/!name!/$nam/g;
$tmp =~ s/!url!/$url/g;
$tmp =~ s/!comment!/$com/g;
$tmp =~ s/<!-- res -->/<blockquote>$res<\/blockquote>/g if ($res);
print $tmp;
}
# フッタ
footer($foot);
}
#-----------------------------------------------------------
# トピックス画面
#-----------------------------------------------------------
sub bbs_topic {
# クッキー取得
my @cook = get_cookie();
$cook[2] ||= 'http://';
# 色選択ボタン
my @col = split(/\s+/,$cf{colors});
my $color;
foreach (0 .. $#col) {
if ($_ == $cook[3]) {
$color .= qq|<input type="radio" name="color" value="$_" checked>|;
} else {
$color .= qq|<input type="radio" name="color" value="$_">|;
}
$color .= qq|<span style="color:$col[$_]">■</span>\n|;
}
# ページ数
my $pg = $in{pg} || 0;
# データ認識
my ($i,@log,%res,%last);
open(IN,"$cf{datadir}/log.cgi");
while(<IN>) {
my ($no,$reno,$date,$name,$eml,$sub,$com,$url,$host,$pw,$col,$ext,$w,$h,$chk) = split(/<>/);
if (!$reno) { $i++; }
next if ($i < $pg + 1);
next if ($i > $pg + $cf{max_topics});
if ($reno) { $res{$reno}++; $last{$reno} = "$date<br>$name"; }
else { $last{$no} = "$date<br>$name"; }
push(@log,$_) if (!$reno);
}
close(IN);
# 繰越ボタン作成
my $pg_btn = make_pgbtn($i,$pg,'&bbs=1',$cf{max_topics});
# テンプレート読み込み
open(IN,"$cf{tmpldir}/topic.html") or error("open err: topic.html");
my $tmpl = join('',<IN>);
close(IN);
$tmpl =~ s|!bbs_css!|$cf{cmnurl}/bbs.css|g;
$tmpl =~ s|!bbs_js!|$cf{cmnurl}/bbs.js|g;
# 画像認証作成
my ($str_plain,$str_crypt);
if ($cf{use_captcha} > 0) {
require $cf{captcha_pl};
($str_plain,$str_crypt) = cap::make($cf{captcha_key},$cf{cap_len});
} else {
$tmpl =~ s|<!-- captcha -->.+?<!-- /captcha -->||s;
}
# 文字置換え
$tmpl =~ s/!bbs_title!/$cf{bbs_title}/g;
$tmpl =~ s/!([a-z]+_cgi)!/$cf{$1}/g;
$tmpl =~ s/!page_btn!/$pg_btn/g;
$tmpl =~ s/!homepage!/$cf{homepage}/g;
$tmpl =~ s/!color!/$color/g;
$tmpl =~ s/!sub!//g;
$tmpl =~ s/!name!/$cook[0]/;
$tmpl =~ s/!email!/$cook[1]/;
$tmpl =~ s/!url!/$cook[2]/;
$tmpl =~ s/!str_crypt!/$str_crypt/g;
$tmpl =~ s/\?mode=(view|find)/?mode=$1&bbs=1/g;
# 分解
my ($head,$loop,$foot) = $tmpl =~ m|(.+)<!-- loop -->(.+?)<!-- /loop -->(.+)|s
? ($1,$2,$3)
: error("テンプレート不正");
# ヘッダ表示
print "Content-type: text/html; charset=utf-8\n\n";
print $head;
# 親記事展開
foreach (@log) {
my ($no,$reno,$date,$name,$eml,$sub,$com,$url,$host,$pw,$col,$ext,$w,$h,$chk) = split(/<>/);
if ($res{$no} eq '') { $res{$no} = 0; }
my $tmp = $loop;
$tmp =~ s/!topi-num!/$no/g;
$tmp =~ s|!topi-ttl!|<a href="$cf{bbs_cgi}?read=$no&bbs=1&pg=$pg">$sub</a>|g;
$tmp =~ s/!topi-nam!/$name/g;
$tmp =~ s/!topi-res!/$res{$no}/g;
$tmp =~ s/!topi-last!/$last{$no}/g;
print $tmp;
}
# フッタ
footer($foot);
}
#-----------------------------------------------------------
# URLエンコード
#-----------------------------------------------------------
sub url_enc {
local($_) = @_;
s/(\W)/'%' . unpack('H2', $1)/eg;
s/\s/+/g;
$_;
}
#-----------------------------------------------------------
# ペイジャー作成 [ 過去ログ ]
#-----------------------------------------------------------
sub pgbtn_old {
my ($i,$pno,$pg,$list,$stat) = @_;
# ページ繰越定義
my $next = $pg + $list;
my $back = $pg - $list;
my $link;
if ($stat eq 'find') {
my $wd = url_enc($in{word});
$link = "$cf{bbs_cgi}?mode=$in{mode}&pno=$pno&find=1&word=$wd&list=$list";
} else {
$link = "$cf{bbs_cgi}?mode=$in{mode}&pno=$pno";
}
# ページ繰越ボタン作成
my @pg;
if ($back >= 0 || $next < $i) {
my $flg;
my ($w,$x,$y,$z) = (0,1,0,$i);
while ($z > 0) {
if ($pg == $y) {
$flg++;
push(@pg,qq!<span class="page active">$x</span>!);
} else {
push(@pg,qq!<a href="$link&pg=$y" class="page gradient">$x</a>!);
}
$x++;
$y += $list;
$i -= $list;
if ($flg) { $w++; }
last if ($w >= 5 && @pg >= 10);
}
}
while( @pg >= 11 ) { shift(@pg); }
my $ret = join('', @pg);
if ($back >= 0) {
$ret = qq!<a href="$link&pg=$back" class="page gradient">«</a>\n! . $ret;
}
if ($next < $i) {
$ret .= qq!<a href="$link&pg=$next" class="page gradient">»</a>\n!;
}
# 結果を返す
return $ret ? qq|<div class="ta-c"><div class="pagination">$ret</div></div>| : '';
}
#-----------------------------------------------------------
# プルダウン作成 [ 検索条件 ]
#-----------------------------------------------------------
sub make_op {
my %op;
my %cond = (1 => 'AND', 0 => 'OR');
foreach (1,0) {
if ($in{cond} eq $_) {
$op{cond} .= qq|<option value="$_" selected>$cond{$_}</option>\n|;
} else {
$op{cond} .= qq|<option value="$_">$cond{$_}</option>\n|;
}
}
for ( my $i = 10; $i <= 30; $i += 5 ) {
if ($in{list} == $i) {
$op{list} .= qq|<option value="$i" selected>$i件</option>\n|;
} else {
$op{list} .= qq|<option value="$i">$i件</option>\n|;
}
}
return %op;
}
#-----------------------------------------------------------
# 自動リンク
#-----------------------------------------------------------
sub auto_link {
my $text = shift;
$text =~ s/(s?https?:\/\/([\w-.!~*'();\/?:\@=+\$,%#]|&)+)/<a href="$1" target="_blank">$1<\/a>/g;
return $text;
}
#-----------------------------------------------------------
# フッター
#-----------------------------------------------------------
sub footer {
my $foot = shift;
# 著作権表記(削除・改変禁止)
my $copy = <<EOM;
<p style="margin-top:2.5em;text-align:center;font-family:Verdana,Helvetica,Arial;font-size:10px;">
- <a href="https://www.kent-web.com/" target="_top">JoyfulNote</a> -
</p>
EOM
if ($foot =~ /(.+)(<\/body[^>]*>.*)/si) {
print "$1$copy$2\n";
} else {
print "$foot$copy\n";
print "</body></html>\n";
}
exit;
}
#-----------------------------------------------------------
# ペイジャー作成
#-----------------------------------------------------------
sub make_pgbtn {
my ($i,$pg,$stat,$max) = @_;
# ページ繰越定義
$max ||= 5;
my $next = $pg + $max;
my $back = $pg - $max;
# ページ繰越ボタン作成
my @pg;
if ($back >= 0 || $next < $i) {
my $flg;
my ($w,$x,$y,$z) = (0,1,0,$i);
while ($z > 0) {
if ($pg == $y) {
$flg++;
push(@pg,qq!<span class="page active">$x</span>!);
} else {
push(@pg,qq!<a href="$cf{bbs_cgi}?pg=$y$stat" class="page gradient">$x</a>!);
}
$x++;
$y += $max;
$z -= $max;
if ($flg) { $w++; }
last if ($w >= 5 && @pg >= 10);
}
}
while( @pg >= 11 ) { shift(@pg); }
my $ret = join('', @pg);
if ($back >= 0) {
$ret = qq!<a href="$cf{bbs_cgi}?pg=$back$stat" class="page gradient">«</a>\n! . $ret;
}
if ($next < $i) {
$ret .= qq!<a href="$cf{bbs_cgi}?pg=$next$stat" class="page gradient">»</a>\n!;
}
# 結果を返す
return $ret ? qq|<div class="pagination">$ret</div>| : '';
}
#-----------------------------------------------------------
# クッキー取得
#-----------------------------------------------------------
sub get_cookie {
# クッキー取得
my $cook = $ENV{HTTP_COOKIE};
# 該当IDを取り出す
my %cook;
foreach ( split(/;/, $cook) ) {
my ($key,$val) = split(/=/);
$key =~ s/\s//g;
$cook{$key} = $val;
}
# URLデコード
my @cook;
foreach ( split(/<>/,$cook{$cf{cookie_id}}) ) {
s/%([0-9A-Fa-f][0-9A-Fa-f])/pack("H2", $1)/eg;
s/[&"'<>]//g;
push(@cook,$_);
}
return @cook;
}
#-----------------------------------------------------------
# 添付リンク
#-----------------------------------------------------------
sub att_file {
my ($no,$com,$ex,$w,$h) = @_;
# 未公開
if ($ex eq 'hide') {
$com .= qq|<p>[添付]: 認証待ち</p>|;
# 画像のとき
} elsif ($ex =~ /(jpg|png|gif)$/) {
my $op;
if (-f "$cf{imgdir}/$no-s$ex") {
$op = qq|src="$cf{imgurl}/$no-s$ex"|;
} else {
($w,$h) = resize($w,$h);
$op = qq|src="$cf{imgurl}/$no$ex" width="$w" height="$h"|;
}
# 画像はコメントの下
if ($cf{image_position} == 1) {
$com .= qq|<p><a href="$cf{imgurl}/$no$ex" target="_blank"><img $op alt="$no"></a></p>|;
# 画像はコメントの左(廻り込み)
} else {
$com = qq|<a href="$cf{imgurl}/$no$ex" target="_blank"><img $op align="left" alt="$no"></a>$com<br clear="all">|;
}
# 画像以外のとき
} else {
my $size = -s "$cf{imgdir}/$no$ex" || 0;
$com .= qq|<p>[<a href="$cf{imgurl}/$no$ex" target="_blank">添付</a>]: $size bytes</p>|;
}
return $com;
}
#-----------------------------------------------------------
# 取り扱いファイル
#-----------------------------------------------------------
sub ext_file {
my $ext;
foreach ( keys %cf ) {
next if ($_ !~ /^ok_(\w+)/);
my $file = $1;
next if (!$cf{$_});
$file =~ tr/a-z/A-Z/;
$ext .= "$file, ";
}
$ext =~ s/, $//;
return $ext;
}
#-----------------------------------------------------------
# 画像表示
#-----------------------------------------------------------
sub image {
my ($no,$ex,$w,$h) = @_;
my $image;
if (-f "$cf{imgdir}/$no-s$ex") {
$image = qq|<img src="$cf{imgurl}/$no-s$ex" alt="$no">|;
} else {
($w,$h) = resize($w,$h);
$image = qq|<img src="$cf{imgurl}/$no$ex" width="$w" height="$h" alt="$no">|;
}
return qq|<a href="$cf{imgurl}/$no$ex" target="_blank">$image</a>\n|;
}
GoogleのLaMDA騒動
Beingのチャット
BingでもChatによる質問が出来るようになったので、早速、3/25の投稿記事「イーロンマスク氏のBMIデバイス」でchatGPTにしたのと同じ質問をしてみた。最初は回答が得られなく別の質問はないかと言われたが、短くし再度質問したところ回答が得られた。Bingは質問を要約し「BMIデバイス 悪用防止」で検索をかけた。回答で参考としたネット記事に私の3/25の記事が上がっているのには驚いた。私のようなものでもblogに駄文を投稿することで一種の社会貢献ができるのだという充実感と、GAFAMによるWEBデータの独占の弊害を感じます。きっと、将来は国による規制がかかると思われますが、ロシア、中国などでは公正な国による規制はかからないと思われるので心配です。画像は、wikipediaのGPTの記事。Softmax,Linear,Dropout等画像認識で出てきた単語が使われている。
以下は、Bingの回答です。
イーロン・マスク氏のニューラリンク社は、脳に電極や半導体チップを埋め込むBMI(Brain Machine Interface)技術の開発を進めています 。今年中には、健康な人間にもBMIデバイスを埋め込む手術を行おうとしているという報道があります。BMIデバイスは、脳とコンピュータや義肢などを直接つなぐことで、思念で操作したり、AIとリンクしたりすることが可能になるとされています 。 しかし、この技術には数々の課題やリスクがあります。例えば、個人のプライバシーや自由意志の侵害、デバイスのハッキングや悪用、脳への副作用や感染症などです。これらの問題を防ぐ方法は、現時点では明確にはなっていませんが、以下のような取り組みが必要だと考えられます。
・ BMIデバイスの安全性や効果性を確認するための厳格な臨床試験や倫理審査の実施
・ BMIデバイスの使用者や被験者の同意や保護を重視するための法的・社会的規範の策定
・ BMIデバイスのデータやアクセス権を管理するためのセキュリティ対策や監視システムの構築
・ BMIデバイスの普及や影響に関する社会的な議論や教育の促進
このように、BMIデバイスは人間の能力を向上させる可能性がありますが、同時に様々な危険性も伴います。そのため、技術開発だけでなく、社会的な対話や規制も重要です。
詳細情報: