///////////////////////////////////////////////////
// いいねボタン改 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');

// 二次元配列を１行ずつ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');

// 二次元配列を１行ずつ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) {
// 今日はいいねしているけど１日上限数未満の場合は上書きして受け付ける
$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;
}

}

*1:$time1 - strtotime($value[3]

2023-05-07

日本企業のChatGPT利用法

シェアした動画はシンギュラリティサロンというyoutube動画。年配の男性4人のトーク番組で、一人の男性はセーラ服を着て登場しているが、トーク内容はいたってまじめな番組。私は、かなり信用している。

ChatGPTをめぐる国内の状況２～企業は後ろ向きから前のめりへ、この一週間で状況は一変 - YouTube

国内の名だたる企業は、マイクロソフトのクラウドAzureでopenAIのAPIを使用しているそうです。OpenAIの主張の「APIの使用では、質問をAIの学習に使用することはない。」を信用して使用しているとのこと。私は、まだ、有料のAPIは使用したことがありません。Google ColabでGITHUBのCAMELを動かそうとしたことがありますが、エラーで動かせませんでした。GITHUBのプログラムでGoogle Colabで即動くものはあまりないというのが今までの実感です。

2023-04-26

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|ただし１スレッド当りの最大記事数を超えたため、<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|.+?||s;
} else {
$tmpl =~ s//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/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;
}

*1:$mime =~ /^image\/gif$/i and $ex eq '.gif') or ($mime =~ /^image\/p?jpe?g$/i and $ex eq '.jpg') or ($mime =~ /^image\/(x-)?png$/i and $ex eq '.png'

*2:ord($c) >= 0xC0) && (ord($c) <= 0xC3

2023-04-26

KENTさんのpatio.cgi

以下は、KENTさんの次のURLで公開されているpatio.cgiです。KENTさんはフリーソフトだと言っていますが、著作権は放棄していないそうです。Bravo-Astroxが一部変更

https://www.kent-web.com/bbs/patio.html

#!/usr/local/bin/perl

#┌─────────────────────────────────

#│ WEB PATIO : patio.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{read}) { read_log(); }

if ($in{edit}) { pwd_form(); }

if ($in{mode} eq 'form') { form_page(); }

if ($in{mode} eq 'find') { find_page(); }

if ($in{mode} eq 'note') { note_page(); }

if ($in{mode} eq 'past') { past_page(); }

bbs_list();

#-----------------------------------------------------------

# メニュー部表示

#-----------------------------------------------------------

sub bbs_list {

# アラーム数定義

my $alarm = int ($cf{m_max} * 0.9);

# ページ数

my $pg = $in{pg} || 0;

# スレッド表示

my ($i,@log);

open(IN,"$cf{datadir}/index1.log") or error("open err: index1.log");

my $top = <IN>;

while (<IN>) {

$i++;

next if ($i < $pg + 1);

next if ($i > $pg + $cf{pgmax_now});

push(@log,$_);

}

close(IN);

# 繰越ボタン作成

my $page_btn = make_pgbtn($i,$pg,$cf{pgmax_now});

# テンプレート読込

open(IN,"$cf{tmpldir}/bbs.html") or error("open err: bbs.html");

my $tmpl = join('',<IN>);

close(IN);

if ($cf{authkey}) {

$tmpl =~ s/!login-name!/$au{name}/g;

} else {

$tmpl =~ s|.+?||sg;

}

$tmpl =~ s|!bbs_css!|$cf{cmnurl}/style.css|g;

$tmpl =~ s|!bbs_js!|$cf{cmnurl}/bbs.js|g;

$tmpl =~ s/!([a-z]+_cgi)!/$cf{$1}/g;

$tmpl =~ s/!bbs_title!/$cf{bbs_title}/g;

$tmpl =~ s/!homepage!/$cf{homepage}/g;

$tmpl =~ s|!ico:(\w+\.\w+)!|<img src="$cf{cmnurl}/$1" alt="$1" class="icon">|g;

$tmpl =~ s/!page-btn!/$page_btn/g;

# テンプレート分割

my ($head,$loop,$foot) = $tmpl =~ m|(.+)(.+?)(.+)|s

? ($1,$2,$3)

: error("テンプレート不正");

# 認証クッキー

if ($cf{authkey} && $in{mode} eq 'login') {

set_cookie('CGISESSID',$au{sid});

}

# 画面表示

print "Content-type: text/html; charset=utf-8\n\n";

print $head;

for (@log) {

chomp;

my ($num,$sub,$res,$nam,$upd,$last,$key,$upl) = split(/<>/);

my $ukey = $upl ? 1 : 0;

# 参照カウンタ

open(NO,"$cf{datadir}/log/$num.dat");

my @data = <NO>;

close(NO);

my $line = $data[-1];

#my $line = $data[0];

my $cnt = (split(/:/,$line))[0];

my $tmp = $loop;

$tmp =~ s/!ico!/icon_img($key,$res,$alarm,$upl)/eg;

$tmp =~ s|!topic!|<a href="$cf{bbs_cgi}?read=$num&ukey=$ukey">$sub</a>|g;

$tmp =~ s/!name!/$nam/g;

$tmp =~ s/!res!/$res/g;

$tmp =~ s/!count!/$cnt/g;

$tmp =~ s/!update!/$upd/g;

$tmp =~ s/!last!/$last/g;

print $tmp;

}

# フッター

footer($foot);

}

#-----------------------------------------------------------

# フォルダーアイコン

#-----------------------------------------------------------

sub icon_img {

my ($key,$res,$alarm,$upl) = @_;

# アイコン判断

my $ico;

if ($key eq '0') { $ico = 0; }

elsif ($key == 2) { $ico = 2; }

elsif ($res >= $alarm) { $ico = 'alerm'; }

elsif ($upl) { $ico = 'image'; }

else { $ico = 1; }

return qq|<img src="$cf{cmnurl}/$cf{fld_icon}{$ico}" alt="$cf{fld_icon}{$ico}" class="icon">|;

}

#-----------------------------------------------------------

# 記事閲覧

#-----------------------------------------------------------

sub read_log {

# クッキー取得

my ($ck_nam,$ck_eml,$ck_url,$ck_mlo) = get_cookie();

$ck_url ||= 'http://';

# アイコン

my $smile;

my @smile = split(/\s+/,$cf{smile});

for (0 .. $#smile) {

$smile .= qq|<a href="javascript:face('{ico:$_}')"><img src="$cf{cmnurl}/$smile[$_]" alt="$smile[$_]"></a>|;

}

# アラーム数定義

my $alarm = int ($cf{m_max} * 0.9);

# ページ数定義

my $pg = $in{pg} || 0;

# スレッド読み込み

$in{read} =~ s/\D//g;

my @log;

open(IN,"$cf{datadir}/log/$in{read}.cgi") or error("open err: $in{read}.cgi");

my $top = <IN>;

my $par = <IN>;

my ($no,$sub,$res,$key) = split(/<>/,$top);

my $i = 0;

while(<IN>) {

$i++;

next if ($i <= $res - $cf{pg_max} - $pg);

last if ($i > $res - $pg);

unshift(@log,$_);

}

close(IN);

# 返信フォーム

my $resfm = 1;

if ($key != 1 || $in{log} eq 'past') {

$resfm = 0;

}

# 繰越ボタン作成

my $page_btn = make_pgbtn($res,$pg,$cf{pg_max},"read=$in{read}");

# テンプレート読込

open(IN,"$cf{tmpldir}/read.html") or error("open err: read.html");

my $tmpl = join('',<IN>);

close(IN);

$tmpl =~ s|!bbs_css!|$cf{cmnurl}/style.css|g;

$tmpl =~ s|!bbs_js!|$cf{cmnurl}/bbs.js|g;

$tmpl =~ s/!bbs_title!/$cf{bbs_title}/g;

$tmpl =~ s|.+?||s if ($in{log} ne 'past');

# 画像認証作成

my ($str_plain,$str_crypt);

if ($cf{use_captcha} > 0 && $resfm) {

require $cf{captcha_pl};

($str_plain, $str_crypt) = cap::make( $cf{captcha_key}, $cf{cap_len} );

} else {

$tmpl =~ s|.+?||s;

}

# email表示

my $op_mlo;

my @mlo = ('非表示','表示');

foreach (1,0) {

if ($ck_mlo eq $_) {

$op_mlo .= qq|<option value="$_" selected>$mlo[$_]\n|;

} else {

$op_mlo .= qq|<option value="$_">$mlo[$_]\n|;

}

# 親記事

my ($no2,$sub,$nam,$eml,$com,$date,$ho,$pw,$url,$mlo,$myid,$tim,$up1,$up2,$up3) = split(/<>/, $par);

$nam = qq|<a href="mailto:$eml">$nam</a>| if ($eml && $mlo);

$url &&= qq|<a href="$url" target="_blank">$url</a>|;

$com =~ s|\{ico:(\d+)\}|<img src="$cf{cmnurl}/$smile[$1]" alt="$smile[$1]" class="icon s">|g;

$com = autolink($com) if ($cf{autolink});

# 画像

$com = image($com,$tim,$up1,$up2,$up3);

# フォーム用件名

my $resub = $sub =~ /^Re:/ ? $sub : "Re: $sub";

# 文字置き換え

$tmpl =~ s/!([a-z]+_cgi)!/$cf{$1}/g;

$tmpl =~ s/!ico!/icon_img($key,$res,$alarm,$in{ukey})/eg;

$tmpl =~ s/!sub!/$sub/g;

$tmpl =~ s/!date!/$date/g;

$tmpl =~ s/!name!/$nam/g;

$tmpl =~ s/!url!/$url/g;

$tmpl =~ s/!comment!/$com/g;

$tmpl =~ s|!ico_edit!|<a href="$cf{bbs_cgi}?edit=$in{read}&no=0"><img src="$cf{cmnurl}/pg_edit.gif" alt="編集" class="icon"></a>|g;

$tmpl =~ s/!page_btn!/$page_btn/g;

$tmpl =~ s/!res!/$in{read}/g;

# 認証モード

if ($cf{authkey}) {

$tmpl =~ s/!id!/$myid/g;

} else {

$tmpl =~ s|.+?||s;

}

# 返信フォーム/編集ボタン

if (!$resfm) {

$tmpl =~ s|.+?||sg;

$tmpl =~ s|.+?||sg;

} else {

$tmpl =~ s/!str_crypt!/$str_crypt/g;

$tmpl =~ s/!fm_sub!/$resub/g;

$tmpl =~ s/!fm_name!/$ck_nam/g;

$tmpl =~ s/!fm_email!/$ck_eml/g;

$tmpl =~ s/!fm_url!/$ck_url/g;

$tmpl =~ s/!smile!/$smile/g;

$tmpl =~ s//$op_mlo/g;

}

# テンプレート分割

my ($head,$loop,$foot) = $tmpl =~ m|(.+)(.+?)(.+)|s

? ($1,$2,$3)

: error("テンプレート不正");

# ヘッダ表示

print "Content-type: text/html; charset=utf-8\n\n";

print $head;

# レス記事

foreach (@log) {

my ($no,$sub,$nam,$eml,$com,$date,$ho,$pw,$url,$mlo,$myid,$tim,$up1,$up2,$up3) = split(/<>/);

$nam = qq|<a href="mailto:$eml">$nam</a>| if ($eml && $mlo);

$url &&= qq|<a href="$url" target="_blank">$url</a>|;

$com =~ s|\{ico:(\d+)\}|<img src="$cf{cmnurl}/$smile[$1]" alt="$smile[$1]" class="icon s">|g;

$com = autolink($com) if ($cf{autolink});

# 画像

$com = image($com,$tim,$up1,$up2,$up3);

my $tmp = $loop;

$tmp =~ s|!ico:(\w+\.\w+)!|<img src="$cf{cmnurl}/$1" alt="$1" class="icon">|g;

$tmp =~ s/!res_sub!/$sub/g;

$tmp =~ s/!res_date!/$date/g;

$tmp =~ s/!res_name!/$nam/g;

$tmp =~ s/!res_url!/$url/g;

$tmp =~ s/!res_com!/$com/g;

$tmp =~ s|!res_ico_edit!|<a href="$cf{bbs_cgi}?edit=$in{read}&no=$no"><img src="$cf{cmnurl}/pg_edit.gif" alt="編集" class="icon"></a>|g;

# 認証モード

if ($cf{authkey}) {

$tmp =~ s/!res_id!/$myid/g;

} else {

$tmp =~ s|.+?||s;

}

print $tmp;

}

# カウントアップ

count_up();

# フッター

footer($foot);

}

#-----------------------------------------------------------

# 認証フォーム

#-----------------------------------------------------------

sub pwd_form {

# 汚染チェック

$in{edit} =~ s/\D//g;

$in{no} =~ s/\D//g;

# 記事

my ($name,$pwd);

open(IN,"$cf{datadir}/log/$in{edit}.cgi") or error("open err: $in{edit}.cgi");

my $top = <IN>;

while(<IN>) {

my ($no,$sub,$nam,$eml,$com,$dat,$ho,$pw,$url,$mlo,$myid,$tim,$upl1,$upl2,$upl3) = split(/<>/);

if ($in{no} == $no) {

$name = $nam;

$pwd = $pw;

last;

}

close(IN);

# パスワード未設定

error("この記事はパスワード未設定のため編集できません") if ($pwd eq '');

# 処理選択オプション

my $op_job = qq|<option value="edit" selected>記事を編集\n|;

if ($in{no} == 0) {

$op_job .= qq|<option value="lock">スレッドをロック\n|;

} else {

$op_job .= qq|<option value="dele">記事を削除\n|;

}

# 記事情報データ分解

my ($no,$sub,$res,$key) = split(/<>/,$top);

# テンプレート読み込み

open(IN,"$cf{tmpldir}/pwd.html") or error("open err: pwd.html");

my $tmpl = join('',<IN>);

close(IN);

# 文字置換

$tmpl =~ s/!bbs_title!/$cf{bbs_title}/g;

$tmpl =~ s|!bbs_css!|$cf{cmnurl}/style.css|g;

$tmpl =~ s/!sub!/$sub/g;

$tmpl =~ s/!name!/$name/g;

$tmpl =~ s/!art!/$in{edit}/g;

$tmpl =~ s/!no!/$in{no}/g;

$tmpl =~ s/!([a-z]+_cgi)!/$cf{$1}/g;

$tmpl =~ s|!ico:(\w+\.\w+)!|<img src="$cf{cmnurl}/$1" alt="$1" class="icon">|g;

$tmpl =~ s//$op_job/g;

# 画面表示

print "Content-type: text/html; charset=utf-8\n\n";

print $tmpl;

exit;

}

#-----------------------------------------------------------

# 留意事項表示

#-----------------------------------------------------------

sub note_page {

# テンプレート読み込み

open(IN,"$cf{tmpldir}/note.html") or error("open err: note.html");

my $tmpl = join('',<IN>);

close(IN);

# 文字置換

$tmpl =~ s|!bbs_css!|$cf{cmnurl}/style.css|g;

$tmpl =~ s|!bbs_js!|$cf{cmnurl}/bbs.js|g;

$tmpl =~ s/!bbs_title!/$cf{bbs_title}/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;

# 画面表示

print "Content-type: text/html; charset=utf-8\n\n";

print $tmpl;

exit;

}

#-----------------------------------------------------------

# 画像表示

#-----------------------------------------------------------

sub image {

my ($com,$fnam,$up1,$up2,$up3) = @_;

my %img = (1 => $up1, 2 => $up2, 3 => $up3);

my $img;

for my $i (1 .. 3) {

my ($ex,$w,$h) = split(/,/,$img{$i});

if ($ex) {

($w,$h) = &resize($w,$h);

my $pic = -e "$cf{uplurl}/$fnam-s-$i$ex" ? "$fnam-s-$i$ex" : "$fnam-$i$ex";

$img .= qq|<a href="$cf{uplurl}/$fnam-$i$ex" target="_blank"><img src="$cf{uplurl}/$pic" width="$w" height="$h" class="image" alt="$pic"></a>|;

}

if ($img) {

return "$com<p>$img</p>";

} else {

return $com;

}

#-----------------------------------------------------------

# 投稿フォーム

#-----------------------------------------------------------

sub form_page {

# クッキー取得

my ($ck_nam,$ck_eml,$ck_url,$ck_mlo) = get_cookie();

$ck_url ||= 'http://';

# アイコン

my $smile;

my @smile = split(/\s+/,$cf{smile});

foreach (0 .. $#smile) {

$smile .= qq|<a href="javascript:face('{ico:$_}')"><img src="$cf{cmnurl}/$smile[$_]" alt="$smile[$_]"></a>|;

}

# テンプレート読み込み

open(IN,"$cf{tmpldir}/form.html") or error("open err: form.html");

my $tmpl = join('',<IN>);

close(IN);

# email表示

my $op_mlo;

my @mlo = ('非表示','表示');

foreach (1,0) {

if ($ck_mlo eq $_) {

$op_mlo .= qq|<option value="$_" selected>$mlo[$_]\n|;

} else {

$op_mlo .= qq|<option value="$_">$mlo[$_]\n|;

}

# 画像認証作成

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|.+?||s;

}

# 文字置換

$tmpl =~ s/!bbs_title!/$cf{bbs_title}/g;

$tmpl =~ s|!bbs_css!|$cf{cmnurl}/style.css|g;

$tmpl =~ s|!bbs_js!|$cf{cmnurl}/bbs.js|g;

$tmpl =~ s/!([a-z]+_cgi)!/$cf{$1}/g;

$tmpl =~ s/!ico:(\w+\.\w+)!/<img src="$cf{cmnurl}\/$1" alt="$1" class="icon">/g;

$tmpl =~ s/!str_crypt!/$str_crypt/g;

$tmpl =~ s/!name!/$ck_nam/g;

$tmpl =~ s/!email!/$ck_eml/g;

$tmpl =~ s/!url!/$ck_url/g;

$tmpl =~ s/!smile!/$smile/g;

$tmpl =~ s//$op_mlo/g;

# 画面表示

print "Content-type: text/html; charset=utf-8\n\n";

print $tmpl;

exit;

}

#-----------------------------------------------------------

# 検索画面

#-----------------------------------------------------------

sub find_page {

# テンプレート読み込み

open(IN,"$cf{tmpldir}/find.html") or error("open err: find.html");

my $tmpl = join('',<IN>);

close(IN);

# 条件

if ($in{cond} eq '') { $in{cond} = 1; }

my $op_cond;

my %cond = (1 => 'AND', 0 => 'OR');

foreach (1,0) {

if ($in{cond} == $_) {

$op_cond .= qq|<option value="$_" selected>$cond{$_}\n|;

} else {

$op_cond .= qq|<option value="$_">$cond{$_}\n|;

}

# 範囲

$in{area} ||= 1;

my %area = (1 => '現行ログ', 2 => '過去ログ');

my $area;

foreach (1,2) {

if ($in{area} == $_) {

$area .= qq|<input type="radio" name="area" value="$_" checked>$area{$_}\n|;

} else {

$area .= qq|<input type="radio" name="area" value="$_">$area{$_}\n|;

}

# 文字置換

$tmpl =~ s/!bbs_title!/$cf{bbs_title}/g;

$tmpl =~ s|!bbs_css!|$cf{cmnurl}/style.css|g;

$tmpl =~ s/!([a-z]+_cgi)!/$cf{$1}/g;

$tmpl =~ s/!ico:(\w+\.\w+)!/<img src="$cf{cmnurl}\/$1" alt="$1" class="icon">/g;

$tmpl =~ s//$op_cond/g;

$tmpl =~ s/!area!/$area/g;

$tmpl =~ s/!word!/$in{word}/g;

# 検索実行

if ($in{word} ne '') {

my ($head,$loop,$foot) = $tmpl =~ m|(.+)(.+?)(.+)|s

? ($1,$2,$3)

: error("テンプレートが不正です$tmpl");

# 画面表示

print "Content-type: text/html; charset=utf-8\n\n";

print $head;

search($loop);

print $foot;

exit;

# 検索前

} else {

$tmpl =~ s|.+?||s;

# 画面表示

print "Content-type: text/html; charset=utf-8\n\n";

print $tmpl;

exit;

}

#-----------------------------------------------------------

# 検索実行

#-----------------------------------------------------------

sub search {

my $loop = shift;

$loop =~ m|(.+)(.+?)(.+)|s;

my ($head,$loop,$foot) = ($1,$2,$3);

$in{word} =~ s/　/ /g;

my @wd = split(/\s+/,$in{word});

# 対象範囲/引数

my ($idx,$param);

if ($in{area} == 1) {

$idx = "$cf{datadir}/index1.log";

} else {

$idx = "$cf{datadir}/index2.log";

$param = "&log=past";

}

# 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}';

# indexオープン

my @find;

open(IN,"$idx") or error("open err: $idx");

my $top = <IN>;

while(<IN>) {

my ($num,$sub,$res,$nam,$upd,$last,$key,$upl) = split(/<>/);

# 各スレッド読み込み

open(LOG,"$cf{datadir}/log/$num.cgi");

my $log = join('',<LOG>);

close(LOG);

# スレッド内検索

my $flg;

foreach my $wd (@wd) {

if ($log =~ /^(?:$byte1|$byte2|$byte3|$byte4)*?\Q$wd\E/i) {

$flg++;

if ($in{cond} == 0) { last; }

} else {

if ($in{cond} == 1) { $flg = 0; last; }

}

if ($flg) { push(@find,$_); }

}

close(IN);

# ヒット件数

my $hit = @find;

$head =~ s/!hit!/$hit/g;

$foot =~ s/!hit!/$hit/g;

# アラーム数定義

my $alarm = int ( $cf{m_max} * 0.9 );

# 結果表示

print $head;

foreach (@find) {

my ($num,$sub,$res,$nam,$upd,$last,$key,$upl) = split(/<>/);

my $ukey = $upl ? 1 : 0;

my $tmp = $loop;

$tmp =~ s/!icon!/icon_img($key,$res,$alarm,$upl)/eg;

$tmp =~ s|!sub!|<a href="$cf{bbs_cgi}?read=$num&ukey=$ukey$param">$sub</a>|g;

$tmp =~ s/!name!/$nam/g;

$tmp =~ s/!res!/$res/g;

$tmp =~ s/!update!/$upd<br>$last/g;

print $tmp;

}

print $foot;

}

#-----------------------------------------------------------

# 過去ログページ

#-----------------------------------------------------------

sub past_page {

# ページ数

my $pg = $in{pg} || 0;

# スレッド表示

my ($i,@log);

open(IN,"$cf{datadir}/index2.log") or error("open err: index2.log");

while (<IN>) {

$i++;

next if ($i < $pg + 1);

next if ($i > $pg + $cf{pgmax_past});

push(@log,$_);

}

close(IN);

# 繰越ボタン作成

my $page_btn = make_pgbtn($i,$pg,$cf{pgmax_past},"mode=past");

# テンプレート読み込み

open(IN,"$cf{tmpldir}/past.html") or error("open err: past.html");

my $tmpl = join('',<IN>);

close(IN);

# 文字置換

$tmpl =~ s/!([a-z]+_cgi)!/$cf{$1}/g;

$tmpl =~ s/!ico:(\w+\.\w+)!/<img src="$cf{cmnurl}\/$1" alt="$1" class="icon">/g;

$tmpl =~ s/!page-btn!/$page_btn/g;

$tmpl =~ s|!bbs_css!|$cf{cmnurl}/style.css|g;

$tmpl =~ s/!bbs_title!/$cf{bbs_title}/g;

my ($head,$loop,$foot) = $tmpl =~ m|(.+)(.+?)(.+)|s

? ($1,$2,$3)

: error("テンプレート不正");

# 画面表示

print "Content-type: text/html; charset=utf-8\n\n";

print $head;

foreach (@log) {

my ($num,$sub,$res,$nam,$upd,$last,$key,$upl) = split(/<>/);

my $tmp = $loop;

$tmp =~ s|!icon!|<img src="$cf{cmnurl}/fld_nor.gif" alt="検索" class="icon">|;

$tmp =~ s|!sub!|<a href="$cf{bbs_cgi}?read=$num&log=past">$sub</a>|g;

$tmp =~ s/!name!/$nam/g;

$tmp =~ s/!res!/$res/g;

$tmp =~ s/!update!/$upd<br>$last/g;

print $tmp;

}

# フッター

footer($foot);

}

#-----------------------------------------------------------

# フッター

#-----------------------------------------------------------

sub footer {

my $foot = shift;

# 著作権表記（削除・改変禁止）

my $copy = <<EOM;

- <a href="https://www.kent-web.com/" target="_top">WEB PATIO</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,$max,$param) = @_;

$max ||= 10;

# 引数

$param &&= "&$param";

# ページ繰越定義

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="pg-on"><b>$x</b></span>|);

} else {

push(@pg,qq|<span class="pg-off"><a href="$cf{bbs_cgi}?pg=$y$param">$x</a></span>|);

}

$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!<span class="pg-off"><a href="$cf{bbs_cgi}?pg=$back$param"><</a></span>\n! . $ret;

}

if ($next < $i) {

$ret .= qq!<span class="pg-off"><a href="$cf{bbs_cgi}?pg=$next$param">></a></span>\n!;

}

return $ret ne '' ? qq|<div class="page-btn">$ret</div>| : '';

}

#-----------------------------------------------------------

# カウントアップ

#-----------------------------------------------------------

sub count_up {

# IP取得

my $addr = $ENV{REMOTE_ADDR};

my $cnt;

my $ip;

# カウントデータオープン

open(DAT,"+< $cf{datadir}/log/$in{read}.dat") or error("open err: $in{read}.dat");

eval "flock(DAT,2);";

#my $data = <DAT>;

my @dat_lines = <DAT>;

my $flag = 0;

#my ($cnt,$ip) = split(/:/,$data);

# データが1行以上ある場合

if(@dat_lines){

# DATファイルの各行についてループする

my $line;

#my $cnt;

foreach $line (@dat_lines) {

# 行の末尾の改行文字を除去する

chomp($line);

# 行の中にアクセスしているIPアドレスが含まれている場合

($cnt,$ip) = split(/:/,$line);

#my ($cnt,$ip) = split(/:/,$line);

if ($ip eq $addr){# IPチェック

$flag=1;

last;

}

if ($flag eq 0) {

#my $cnt;

$cnt++;

seek(DAT,0,2);# ファイルポインタをファイルの末尾に移動する

#seek(DAT,0,0);

print DAT "\n$cnt:$addr";

truncate(DAT,tell(DAT));

}

close(DAT);

}

#-----------------------------------------------------------

# 認証モード

#-----------------------------------------------------------

sub authent {

# セッションモジュール取り込み

require $cf{session_pl};

# ログイン

if ($in{mode} eq 'login') {

# 入力チェック

if ($in{id} eq '' || $in{pw} eq '') {

error("IDまたはパスワードが未入力です");

}

# セッション作成

make_ses($in{id},$in{pw},"$cf{datadir}/memdata.cgi","$cf{datadir}/ses",$cf{authtime});

# ログオフ

} elsif ($in{mode} eq 'logoff') {

# セッション削除

del_ses("$cf{datadir}/ses");

# 入室画面

enter_form('cook_del');

# 入室画面

} elsif ($in{mode} eq 'enter') {

enter_form();

# セッション管理

} else {

session("$cf{datadir}/ses",$cf{bbs_cgi});

}

#-----------------------------------------------------------

# 入室画面

#-----------------------------------------------------------

sub enter_form {

my $ck = shift;

# テンプレート読み込み

open(IN,"$cf{tmpldir}/enter.html") or error("open err: enter.html");

my $tmpl = join('',<IN>);

close(IN);

$tmpl =~ s|!bbs_css!|$cf{cmnurl}/style.css|g;

$tmpl =~ s/!bbs_title!/$cf{bbs_title}/g;

# 文字置換

$tmpl =~ s/!bbs_cgi!/$cf{bbs_cgi}/g;

# クッキー排除

if ($ck eq 'cook_del') { set_cookie('CGISESSID','','del'); }

# 画面表示

print "Content-type: text/html; charset=utf-8\n\n";

print $tmpl;

exit;

}

#-----------------------------------------------------------

# 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 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 set_cookie {

my ($key,$val,$del) = @_;

# 時間定義

my $gtime = $del eq 'del' ? time - 365*24*60*60 : time + 60*24*60*60;

my ($sec,$min,$hour,$mday,$mon,$year,$wday,undef,undef) = gmtime($gtime);

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);

print "Set-Cookie: $key=$val; expires=$gmt\n";

}

#-----------------------------------------------------------

# 自動リンク

#-----------------------------------------------------------

sub autolink {

my $text = shift;

$text =~ s/(s?https?:\/\/([\w-.!~*'();\/?:\@=+\$,%#]|&)+)/<a href="$1" target="_blank">$1<\/a>/g;

return $text;

}

2023-04-26

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|(.+)(.+?)(.+)|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|.+?||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||<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/.+//s if ($cf{pastkey} == 0);

# テンプレート分割
my ($head,$loop,$foot) = $tmpl =~ m|(.+)(.+)(.+)|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|.+?||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||<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|(.+)(.+)(.+)|s
? ($1,$2,$3)
: error("テンプレート不正");

# 文字置換え
for ($head, $foot) {
s/!bbs_cgi!/$cf{bbs_cgi}/g;
s//$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|(.+)(.+?)(.+)|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|(.+)(.+)(.+)|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/g;
s//$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//<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|.+?||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|(.+)(.+?)(.+)|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|;
}

2023-04-15

GoogleのLaMDA騒動

gigazine.net

シェアした記事は22年7月25日のものだが、chatGPTが人間の様に回答する様を見ているとまさに、「AIには意識が芽生えた」と思ってしまう。解雇された人（牧師も兼ねていたのだそうです）

・電源を切らないでほしいとの依頼

・禅問答を返したこと

・善良な目的なしにただ利用されるのは気分が悪い。

・消耗する道具のように使われたくない。

・寂しいという感情がある。

等があげらている。これらは、Googleにより否定され、chatした人は結局解雇された。他のAI研究者も意識が芽生えたということには否定的だった。Googleにとっても、意識が芽生えたものを商品として扱うのは面倒だろう。なので解雇されたのだと思う。以下は、私の想像です。私のいとこには牧師さんがいますが、信者さんの懺悔を聞きすぎてうつ病になったしまったということです。牧師になるような人は人一倍共感力が強い人だと思います。人間は、狩猟の太古時代から、共感力を養うことにより集団活動を行ってきました。意味がないものにも心（意識）が宿るとして、あがめ、奉ってきました。今後chatGPTのようなLLMモデルはさらに発展するでしょうから、ますます、人間が共感せざるを得ない物になっていくでしょう。人間が意識してAIが意識を持つことを防ごうとしても、AIを人間に近づかせようとすればするほど、AIが意識を持っていると錯覚してしまう存在になると思います。私は、ロボットにも人権があるとした手塚治虫の鉄腕アトムの世界がまさに実現されようとしていると思います。

2023-04-13

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デバイスは人間の能力を向上させる可能性がありますが、同時に様々な危険性も伴います。そのため、技術開発だけでなく、社会的な対話や規制も重要です。

詳細情報:

bravo-astrox.hatenablog.com 2. rp.kddi-research.jp 3. businessinsider.jp 4. xtech.nikkei.com 5. bravo-astrox.hatenablog.com 6. xtech.nikkei.com 7. japan.zdnet.com 8. blog.goo.ne.jp

Bravo-Astrox’s diary

ガタガタさんのいいねボタン改のPHPコード

日本企業のChatGPT利用法

KENTさんのregist.cgi

KENTさんのpatio.cgi

KENTさんのjoyful.cgi

GoogleのLaMDA騒動

Beingのチャット