#!/usr/bin/perl
#┌─────────────────────────────────
#│ YY-BOARD v4.8 (2003/01/10)
#│ Copyright(C) Kent Web 2003
#│ webmaster@kent-web.com
#│ http://www.kent-web.com/
#└─────────────────────────────────
$ver = 'YYBBS v4.8';
#┌─────────────────────────────────
#│ [注意事項]
#│ 1. このスクリプトはフリーソフトです。このスクリプトを使用した
#│ いかなる損害に対して作者は一切の責任を負いません。
#│ 2. 設置に関する質問はサポート掲示板にお願いいたします。
#│ 直接メールによる質問は一切お受けいたしておりません。
#│ 3. 添付の home.gif は L.O.V.E の mayuRin さんによる画像です。
#└─────────────────────────────────
#
# 【ファイル構成】
#
# public_html (ホームディレクトリ)
# |
# +-- yybbs / yybbs.cgi [701]
# | bbslog.txt [600]
# | dic.txt [600]
# | history.txt [600]
# | pastidx.dat [600]
# |
# +---- $lockdir [701] / $lockname [600]
#
$spt_ver = 'YY_BOARD/4.8 Poison_des_Yeux/1.35';
# ==== 改造者によるドキュメント =====================================
# このスクリプトは、KENTさん(webmaster@kent-web.com)が著作権を持つ
# 「YY-BOARD v4.8」をもとに、もりば(rinrin@funifuni.net)が改造を行っ
# たものです。
# 「YY-BOARD v4.8」に添付の home.gif は使用していません。
# ちなみにタブ幅は 4 です。
# ===================================================================
#
# ==== ver.1.14.2 以降に関する特記事項 ==============================
# 特定文字列置換処理スクリプトは、Bee-X さん
# (http://www2s.biglobe.ne.jp/~bee-x/)によって作られました。
# このバージョンでは、その一部を修正して使用しています。
# ===================================================================
#
# ==== ver.1.32 以降に関する特記事項 ================================
# rename関数による排他処理スクリプトは、大崎博基さんによるPerlメモ
# (http://www.din.or.jp/~ohzaki/perl.htm)に記載の「排他制御(ファイル
# ロック)をする」を参考にしました。
# ===================================================================
# ログフォーマット
# 一行目
# 最新レス番<>最新レスの投稿者host<>最新レス投稿時刻<>親記事数<>
# 二行目以降
# レス番 ($no)<>親記事レス番 ($reno)<>ユーザ削除フラグ ($udel)<>削除キー ($pw)<>投稿時刻 ($times)<>投稿者 ($name)<>本文 ($com)<>タイトル ($sub)<>E-mail ($mail)<>URL ($url)<>最終更新時刻 ($mod_times)<>User-Agent ($env)<>投稿者host ($host)<>オプション ($opt)<>アイコン ($icon)<>
# オプション ($opt) 書式
# 1 (hoge) タグ有効フラグ ($tag) preモードフラグ ($pre) URLtoAnchorフラグ ($anc)
#============#
# 設定項目 #
#============#
#------------#
# 基本設定 #
#------------#
# タイトル名を指定
$title = 'よろづ書込処v4';
# 管理者用マスタパスワード (英数字で8文字以内)
$pass = 'hogehoge';
# 文字コード
$doccode = 'UTF-8'; # charset, accept-charset
# ファイルロック形式 (0=no,1=symlink関数,2=mkdir関数,3=rename関数,4=flock関数)
$lockkey = 3;
# ロックファイル名
# → rename関数を使う場合はあらかじめファイルを作成しなければならない
# → flock関数を使う場合は必要ない。
$lockfile = 'lock/yybbs.lock';
# スクリプトのファイル名
$script = 'yybbs.cgi';
# ログファイル名
$logfile = 'bbslog.txt';
# 改造履歴ファイル名
$hisfile = 'history.txt';
# ユーザ削除記事のタイトルとコメント
$del_sub = '兄チャマ!';
$del_com = 'この記事はよつ……じゃなかった、怪盗クローバーが頂いたデス!';
# ページトップに表示するスレッド数
$top_log = 3;
# 記事タイトルの最大バイト数
$sub_len = 78;
# クッキーの賞味期限(日)
$ck_exp = 90;
# メールアドレスの入力確認 (0=no 1=yes)
$in_mail = 0;
#--------------------------#
# アクセス・投稿制限設定 #
#--------------------------#
# 緊急避難用全投稿停止
$AllStop = 0;
# 偽フォーム排除用基準URL
# →空文字列の場合はチェックしない。
$base_url = '';
# 重複投稿をチェックする (0=no 1=yes)
$dbl_post = 0;
# 同一ホストからの連続投稿制限時間(秒)
$wait = 0;
# アクセス制限を行なう (0=no 1=yes)
$denykey = 0;
if ($denykey) {
# 規制対象(ホスト名、IPアドレスを記述)
@deny = (
'',
'',
);
}
#----------------#
# 過去ログ設定 #
#----------------#
# 過去ログ生成 (0=no 1=yes)
$pastkey = 0;
# 過去ログ情報ファイル名
$idxfile = 'pastidx.dat';
if ($pastkey) {
# 過去ログディレクトリパス
$pastdir = '../bbs/';
# 最大保持スレッド数
$max = 50;
# 一回で過去ログに送るスレッド数
$pastctn = 20;
}
#----------------------#
# 特定文字列置換機能 #
#----------------------#
# 置換機能を使用する (0=no 1=yes)
$substkey = 1;
if ($substkey) {
# 置換辞書ファイル名
$dicfile = 'dic.txt';
# 置換許可文字(記号)の指定
# 指定しない場合は空文字列
# 記号(!"#$%&'()=~|@`[{;+:*]},<.>/?\_)を
# 指定する場合は、「\」を追加する事。
# 例:「!」を指定する場合は「\!」と記述
# thx! Bee-X さん (http://www2s.biglobe.ne.jp/~bee-x/)
$sst_sign = '!';
}
#--------------------#
# アイコン表示機能 #
#--------------------#
# アイコンを使用する (0=no 1=yes)
$iconkey = 1;
if ($iconkey) {
# アイコン画像ディレクトリパス
$icodir = 'image/';
# アイコン全体定義
# valueは「アイコングループ」配列のリファレンス
%icons = (
'ukagaka' => \@ukagaka,
'snow' => \@snow,
'wind' => \@wind,
'hajimete' => \@hajimete,
'one2' => \@one2,
'hani' => \@hani,
'mizuiro' => \@mizuiro,
# 'mizuiro2' => \@mizuiro2,
'kiminozo' => \@kiminozo,
'muvluv' => \@muvluv,
'tukihime' => \@tukihime,
'ga' => \@ga,
'mahoraba' => \@mahoraba,
'pani' => \@pani,
'maria' => \@maria,
'maria2' => \@maria2,
'yumeria' => \@yumeria,
);
# アイコングループ定義(各要素は無名配列)
# 0:アイコングループ定義[サブディレクトリ名,ラベル(,拡張子,width,height)]
# 1-:アイコン定義[ファイル名,ラベル(,拡張子,width,height)]
# アイコン定義で拡張子等を省略した場合は、アイコングループ定義の値を適用。
# アイコングループ定義で省略した場合は、png,100,100
# 別記の他は(C)Expensive Noise(http://mint.cutegirl.jp/)256色アイコン
@ukagaka = ( ['ukagaka','伺か。'],
['ic_niseharuna','さくら'],['ic_unyu1','うにゅう'],['ic_unyu2','うにゅう(刮目)'],
['ic_nekoko','ねここ'],
);
@snow = ( ['snow','SNOW'],
['ic_sn_sumino','澄乃'],['ic_sn_shigure','しぐれ'],['ic_sn_asahi','旭'],
['ic_sn_ohka','桜花'],['ic_sn_meiko','芽依子様'],['ic_sn_hohsen','鳳仙'],
);
@wind = ( ['wind','Wind'],
['ic_minamo','みなも'],['ic_hinata','ひなた'],['ic_wakaba','わかば'],
['ic_nozomi','望'],['ic_hikari','彩'],['ic_kasumi','紫光院様'],
);
@hajimete = ( ['hajimete','はじめての'],
['ic_shiori','しおり'],['ic_saori','さおり'],['ic_h_yuuna','ゆうな'],['ic_h_maina','まいな'],
);
@one2 = ( ['one2','ONE2 ~永遠の約束~','gif'],
# (C)NEXTON(http://www.tactics.ne.jp/)TacticsNET/BaseSon/雛太屋特設コーナー顔チップアイコン
['k_nao','奈穂'],['k_nao2','奈穂(ミニ)'],
['k_ayame','綾芽'],['k_ayame2','綾芽(ミニ)'],
['k_kuon','久遠'],['k_kuon2','久遠(ミニ)'],
['k_haruka','遥先生'],['k_noa','乃逢'],['k_kokone','心音'],
);
@hani = ( ['hani','月は東に日は西に','gif'],
# (C)オーガスト(http://august-soft.com/)『月は東に日は西に ~Operation Sanctuary~』画像素材
['hani_c0101','美琴さん', '','94','126'],
['hani_c0102','お喜びな美琴さん', '','94','126'],
['hani_c0103','てれてれな美琴さん', '','94','125'],
['hani_c0104','しょんぼりな美琴さん', '','80','118'],
['hani_c0201','保奈美さん', '','73','119'],
['hani_c0202','お喜びな保奈美さん', '','72','119'],
['hani_c0203','てれてれな保奈美さん', '','73','119'],
['hani_c0204','ご機嫌斜めな保奈美さん','','90','119'],
['hani_c0301','ちひろさん', '','58','119'],
['hani_c0302','お喜びなちひろさん', '','71','128'],
['hani_c0303','てれてれなちひろさん', '','58','119'],
['hani_c0304','落ちこみのちひろさん', '','105','127'],
['hani_c0401','茉理さん', '','100','119'],
['hani_c0402','お喜びな茉理さん', '','103','125'],
['hani_c0403','てれてれな茉理さん', '','124','120'],
['hani_c0404','お怒りの茉理さん', '','124','131'],
['hani_c0501','結先生', '','59','106'],
['hani_c0502','お喜びな結先生', '','72','110'],
['hani_c0503','てれてれな結先生', '','59','106'],
['hani_c0504','お困りな結先生', '','79','118'],
['hani_c0601','恭子先生', '','77','133'],
['hani_c0602','お喜びな恭子先生', '','83','133'],
['hani_c0603','てれてれな恭子先生', '','78','133'],
['hani_c0604','ご機嫌斜めな恭子先生', '','70','133'],
['hani_c0701','委員長', '','61','118'],
['hani_c0702','お喜びな委員長', '','61','118'],
['hani_c0703','てれてれな委員長', '','60','118'],
['hani_c0704','お怒りの委員長', '','61','118'],
['hani_c0801','弘司', '','76','130'],
['hani_c0802','お喜びな弘司', '','89','132'],
['hani_c0803','呆れてる弘司', '','76','130'],
['hani_c0901','理事長', '','77','126'],
['hani_c0902','眼鏡キラーンな理事長', '','64','126'],
['hani_c1001','英理さん', '','81','120'],
['hani_c1002','お喜びな英理さん', '','81','120'],
['hani_c1101','親父殿', '','72','119'],
['hani_c1102','お喜びな親父殿', '','73','119'],
['hani_c1201','フカセン', '','66','127'],
);
@mizuiro = ( ['mizuiro','みずいろ','gif'],
# (C)ねこねこソフト(http://www.din.or.jp/~nekoneko/)フリー素材
['mizu_yuki','雪希'],['mizu_hiyori','日和'],['mizu_shinpon','新ぽん'],
['mizu_kiyoka','清香'],['mizu_yshindo','やかまさん'],['mizu_oshindoh','おとなさん'],
['mizu_asami','先輩'],['mizu_fuyuka','冬佳'],
);
@mizuiro2 = ( ['mizuiro2','みずいろ2'],
['ic_yukimaru6sai','雪希'],['ic_hiyori','日和'],['ic_kiyoka','清香'],
['ic_oshindoh','おとなさん'],['ic_yshindoh','やかまさん'],['ic_asami','麻美'],
['ic_hiyori2','νひよりん'],['ic_hiyori3','まじかる☆ひよりん'],
['ic_kiyokamama','清香ママ'],
);
@kiminozo = ( ['kiminozo','君が望む永遠'],
['ic_haruka','遙'],['ic_mitsuki','水月'],['ic_akane','茜'],
['ic_daikuji','あゆ'],['ic_mayumayu','まゆ'],
);
@muvluv = ( ['muvluv','マブラヴ'],
['ic_sumika','純夏'],['ic_meiya','冥夜'],['ic_kei','慧'],['ic_chizuru','千鶴'],
['ic_miki','壬姫'],['ic_akane','茜'],['ic_mikoto','尊人'],['ic_mikoto2','美琴'],
['ic_kasumi','霞'],['ic_tsukuyomi','月詠'],['ic_takeru','武'],
);
@tukihime = ( ['tukihime','月姫'],
['ic_arc','アルクェイド'],['ic_ciel','シエル'],['ic_akiha','秋葉'],
['ic_hisui','翡翠'],['ic_kohaku','琥珀'],['ic_sacchin','さっちん'],
['ic_ren','レン'],['ic_akira','晶'],['ic_hanepin','羽ピン'],
['ic_souka','蒼香'],['ic_nanako','ななこ'],['ic_sion','シオン'],
);
@ga = ( ['ga','ギャラクシーエンジェル'],
['ic_mille','ミルフィーユ'],['ic_ranfa','蘭花'],['ic_mint','ミント'],
['ic_vanilla','ヴァニラ'],['ic_forte','フォルテ'],['ic_nomad','ノーマッド'],
);
@mahoraba = ( ['mahoraba','まほらば'],
['ic_kozue','梢ちゃん'],['ic_saki','早紀ちゃん'],['ic_nanako','魚子ちゃん'],
['ic_natsume','棗ちゃん……かも'],['ic_tamami','珠実ちゃん'],['ic_megumi','桃乃さん'],
['ic_asami','朝美ちゃん'],['ic_sayoko','沙夜子さん'],['ic_sore','それ'],
);
@pani = ( ['pani','ぱにぽに'],
['ic_mesousa','メソウサ'],['ic_kami','神'],['ic_panda','パンダ村長'],['ic_roboko','ロボ子'],
);
@maria = ( ['maria','マリア様がみてる'],
['ic_mm_yumi2','祐巳さん'],['ic_mm_sachiko2','祥子さま'],['ic_mm_yohko2','蓉子さま'],
['ic_mm_yoshino2','由乃さん'],['ic_mm_rei2','令さま'],['ic_mm_eriko2','江利子さま'],
['ic_mm_noriko2','乃梨子ちゃん'],['ic_mm_shimako2','志摩子さん'],['ic_mm_sei2','聖さま'],
['ic_mm_shizuka2','静さま'],['ic_mm_tsutako2','蔦子さん'],['ic_mm_tohko2','瞳子ちゃん'],
['ic_mm_minako2','三奈子さま'],['ic_mm_mami2','真美さん'],['ic_mm_syohko2','笙子ちゃん'],
);
@maria2 = ( ['maria2','マリア様がみてる2'],
['ic2_mm_yumi','祐巳さん'],['ic2_mm_sachiko','祥子さま'],['ic2_mm_yohko','蓉子さま'],
['ic2_mm_yoshino','由乃さん'],['ic2_mm_rei','令さま'],['ic2_mm_eriko','江利子さま'],
['ic2_mm_noriko','乃梨子ちゃん'],['ic2_mm_shimako','志摩子さん'],['ic2_mm_sei','聖さま'],
['ic2_mm_tsutako','蔦子さん'],['ic2_mm_tohko','瞳子ちゃん'],['ic2_mm_kanako','可南子ちゃん'],
);
@yumeria = ( ['yumeria','ゆめりあ'],
['ic_yr_mone','もね'],['ic_yr_miduki','みづき'],['ic_yr_neneko','ねねこ'],
['ic_yr_kuyoh','九葉'],['ic_yr_nanase','七瀬さん'],
);
}
#---(ここまで「アイコン表示機能」設定)---#
#-------------#
# XHTML要素 #
#-------------#
# 許可する要素の候補
# ===== Modularization of XHTML? ===== http://www.w3.org/TR/xhtml-modularization/
# 5. XHTML Abstract Modules
# 5.2. Core Modules
# 5.2.2. Text Module
## Inline Structural
@inlstruct = ('br','span',);
## Inline Phrasal
@inlphras = ('abbr','acronym','cite','code','dfn','em','kbd','q','samp','strong','var',);
# 5.2.3. Hypertext Module
@hypertext = ('a',);
# 5.4. Text Extension Modules
# 5.4.1. Presentation Module
## Inline Presentational
@inlpres = ('b','i','tt',);
@inlpresdepre = ('big','small','sub','sup',);
# 5.4.2. Edit Module
@edit = ('ins','del',);
# 5.4.3. Bi-directional Text Module
@bdo = ('bdo',);
# 5.7. Image Module
@image = ('img',);
# ===== Ruby Annotation Module ===== http://www.w3.org/TR/ruby
@ruby = ('ruby','rbc','rtc','rb','rt','rp',);
# 許可する要素
%eles = (
'inlstruct' => '0',
'inlphras' => '1',
'hypertext' => '1',
'inlpres' => '1',
'edit' => '1',
'bdo' => '0',
'image' => '0',
'ruby' => '0',
);
#---(ここまで「XHTML要素」設定)---#
#----------------#
# 文字実体参照 #
#----------------#
@entity = (
# Basic Latin
'quot','amp','apos','lt','gt',
# Latin-1 Supplement
'nbsp','iexcl','cent','pound','curren','yen','brvbar','sect','uml','copy',
'ordf','laquo','not','shy','reg','macr','deg','plusmn','sup2','sup3',
'acute','micro','para','middot','cedil','sup1','ordm','raquo','frac14','frac12',
'frac34','iquest','Agrave','Aacute','Acirc','Atilde','Auml','Aring','AElig','Ccedil',
'Egrave','Eacute','Ecirc','Euml','Igrave','Iacute','Icirc','Iuml','ETH','Ntilde',
'Ograve','Oacute','Ocirc','Otilde','Ouml','times','Oslash','Ugrave','Uacute','Ucirc',
'Uuml','Yacute','THORN','szlig','agrave','aacute','acirc','atilde','auml','aring',
'aelig','ccedil','egrave','eacute','ecirc','euml','igrave','iacute','icirc','iuml',
'eth','ntilde','ograve','oacute','ocirc','otilde','ouml','divide','oslash','ugrave',
'uacute','ucirc','uuml','yacute','thorn','yuml',
# Latin Extended-A
'OElig','oelig','Scaron','scaron','Yuml',
# Latin Extended-B
'fnof',
# Spacing Modifier Letters
'circ','tilde',
# Greek
'Alpha','Beta','Gamma','Delta','Epsilon','Zeta','Eta','Theta','Iota','Kappa',
'Lambda','Mu','Nu','Xi','Omicron','Pi','Rho','Sigma','Tau','Upsilon',
'Phi','Chi','Psi','Omega',
'alpha','beta','gamma','delta','epsilon','zeta','eta','theta','iota','kappa',
'lambda','mu','nu','xi','omicron','pi','rho','sigmaf','sigma','tau','upsilon',
'phi','chi','psi','omega','thetasym','upsih','piv',
# General Punctuation
'ensp','emsp','thinsp','zwnj','zwj','lrm','rlm','ndash','mdash','lsquo',
'rsquo','sbquo','ldquo','rdquo','bdquo','dagger','Dagger','bull','hellip','permil',
'prime','Prime','lsaquo','rsaquo','oline','frasl',
# Currency Symbols
'euro',
# Letterlike Symbols
'image','weierp','real','trade','alefsym',
# Arrows
'larr','uarr','rarr','darr','harr','crarr','lArr','uArr','rArr','dArr',
'hArr',
# Mathematical Operators
'forall','part','exist','empty','nabla','isin','notin','ni','prod','sum',
'minus','lowast','radic','prop','infin','ang','and','or','cap','cup',
'int','there4','sim','cong','asymp','ne','equiv','le','ge','sub',
'sup','nsub','sube','supe','oplus','otimes','perp','sdot',
# Miscellaneous Technical
'lceil','rceil','lfloor','rfloor','lang','rang',
# Geometric Shapes
'loz',
# Miscellaneous Symbols
'spades','clubs','hearts','diams',
);
#------------------------------#
# 汎用メッセージ出力用定型文 #
#------------------------------#
# ステータスコード
%respcode = (
# コード メッセージ付,日本語,詳細文
'200' => ['200 OK','200 了承',
'要求は成功しました。',],
'400' => ['400 Bad Request','400 悪い要求',
'要求は正しくない形をした文法のために奉仕者によって理解されることができませんでした。依頼人は修正することなく要求を繰り返すべきではありません。',],
'403' => ['403 Forbidden','403 御禁制',
'奉仕者は要求を理解しました。しかしそれを完了することを拒絶しています。認証は役に立たないでしょう。また、要求は繰り返されるべきではありません。',],
'404' => ['404 Not Found','404 無提供',
'奉仕者は要求の統一的資源識別名と調和する何かを提供しませんでした。',],
'405' => ['405 Method Not Allowed','405 許されない方法',
'要求行に指定された方法は、要求の統一的資源識別名によって結びつけられた資源のためには許されません。',],
'413' => ['413 Request Entity Too Large','413 大き過ぎる要求実体',
'奉仕者が意図している、あるいは処理する事ができるより要求実体が大きい為に、奉仕者は要求を処理する事を拒絶しています。',],
'500' => ['500 Internal Server Error','500 内部の奉仕者の誤り',
'奉仕者は予期しない状態に遭遇し、それは奉仕者が要求を完了するのを妨げました。',],
'503' => ['503 Service Unavailable','503 奉仕は利用できない',
'奉仕者は現在、奉仕者の一時的過負荷あるいは保守のために要求を扱うことができません。',],
);
# 応答メッセージ
%respmsg = (
# メッセージ名 ステータスコード,見出し,内容
# 正常終了
'endofnew' => ['200','投稿完了',
'新規投稿は正常に完了しました。',],
'endofres' => ['200','返信投稿完了',
'指定されたスレッドへの返信は正常に完了しました。',],
'endofedt' => ['200','修正投稿完了',
'指定された記事の修正は正常に完了しました。',],
'endofdel' => ['200','削除完了',
'指定された記事の削除は正常に完了しました。',],
# 管理都合系
'allstop' => ['503','投稿等機能停止中',
'現在「新規投稿」「返信投稿」「記事修正」「記事削除」各機能を一時的に停止しています。再開をお待ちください。',],
'testok' => ['200','セクション通過',
'ここまでは来ている模様です。',],
# 不正アクセス系
'notpost' => ['405','不正なアクセス',
'ログ書き込みを伴なうアクセスでの Method は POST 限定です。',],
'badmode' => ['400','謎のパラメータ (mode)',
'未知の mode パラメータが設定されているような気がします。',],
'badclass' => ['400','謎のパラメータ (class)',
'未知の class パラメータが設定されているような気がします。',],
'badnum' => ['400','謎のパラメータ (sub)',
'未知のサブパラメータが設定されているような気がします。',],
'badoutput' => ['400','謎のパラメータ (output)',
'未知の output パラメータが設定されているような気がします。',],
'badref' => ['403','不正なフォーム',
'不正なフォームからの投稿のような気がします。',],
'refshost' => ['403','アクセス拒否',
'このホストからのアクセスは規制されています。',],
'rejpost' => ['403','投稿拒否',
'あなたからの投稿を拒絶します。心当たりがない場合はご連絡ください。',],
# 不正入力系・非存在
'noresnum' => ['404','記事非存在',
'指定された記事は存在しません。',],
'nothrnum' => ['404','スレッド非存在',
'指定された記事を含むスレッドは存在しません。',],
# 不正入力系・不能
'cannotres' => ['403','返信不能',
'指定された記事はユーザによって削除されました。',],
'cannotedt' => ['403','修正不能',
'指定された記事にはパスワードが設定されていません。',],
'cannotdel' => ['403','削除不能',
'指定された記事にはパスワードが設定されていません。',],
'bigpost' => ['413','大きすぎ‥‥',
'貴方のモノはとても大きいので、私には受け入れる事ができません。',],
# 不正入力系・管理
'badadmin' => ['403','管理パスワード不一致',
'入力されたパスワードは管理パスワードと一致しません。あなたは誰ですか?',],
# 処理エラー系
'lockbusy' => ['500','排他処理中',
'只今混雑しています。しばらくお待ちください。',],
'fileopen' => ['500','ファイルオープンエラー(入力)',
'ファイルを入力用として開く事ができませんでした。',],
'filewrite' => ['500','ファイルオープンエラー(出力)',
'ファイルを出力用として開く事ができませんでした。',],
'fileseek' => ['500','ファイルシークエラー',
'ファイルポインタを設定できませんでした。',],
'fileprint' => ['500','ファイル書き込みエラー',
'ファイルにデータを書き込めませんでした。',],
'filetc' => ['500','ファイルサイズ更新エラー',
'ファイルファイルサイズを設定できませんでした。',],
'logopen' => ['500','ログファイルオープンエラー(入力)',
'ログファイルを入力用として開く事ができませんでした。',],
'logwrite' => ['500','ログファイルオープンエラー(出力)',
'ログファイルを出力用として開く事ができませんでした。',],
'hisopen' => ['500','更新履歴ファイルオープンエラー(入力)',
'更新履歴ファイルを入力用として開く事ができませんでした。',],
'hiswrite' => ['500','更新履歴ファイルオープンエラー(出力)',
'更新履歴ファイルを出力用として開く事ができませんでした。',],
'dicopen' => ['500','置換辞書ファイルオープンエラー(入力)',
'置換辞書ファイルを入力用として開く事ができませんでした。',],
'dicwrite' => ['500','置換辞書ファイルオープンエラー(出力)',
'置換辞書ファイルを出力用として開く事ができませんでした。',],
'pstopen' => ['500','過去ログファイルオープンエラー(入力)',
'過去ログファイルを入力用として開く事ができませんでした。',],
'pstwrite' => ['500','過去ログファイルオープンエラー(出力)',
'過去ログファイルを出力用として開く事ができませんでした。',],
'psxopen' => ['500','過去ログ情報ファイルオープンエラー(入力)',
'過去ログ情報ファイルを入力用として開く事ができませんでした。',],
'psxwrite' => ['500','過去ログ情報ファイルオープンエラー(出力)',
'過去ログ情報ファイルを出力用として開く事ができませんでした。',],
);
#---(ここまで「定型文」設定)---#
#================#
# 設定ここまで #
#================#
#==============#
# メイン処理 #
#==============#
($host,$addr) = &get_host;
$media = &decode;
$media and $horx = &media_param($media);
#$denykey and &axs_check;
$denykey and &deny_check;
DO_MAIN: {
undef %ep;
if ($mode eq 'regist') { ®ist; }
local ($no,$reno,$udel,$pw,$times,$name,$com,
$sub,$mail,$url,$mod_times,$env,$host,$opt,$icon);
if ($mode eq 'view') {
if ($class eq 'all') { $class = 'last'; $num = 'all'; }
if ($class eq 'list') { &subj_list; }
if ($class eq 'last') { &threads_view; }
if ($class eq 'no') { &res_view; }
if ($class eq 'howto') { &howto; }
if ($class eq 'history') { &history; }
if ($class eq 'find') { &find; }
if ($class eq 'dic' and $substkey) { &subst_dic; }
if ($class eq 'image' and $iconkey) { &ico_image; }
if ($class eq 'past') { &past; }
&resp('name' => 'badclass','info' => "mode=$mode, class=$class");
}
if ($mode eq 'form') {
local ($form_title,$sub_default,$pwdnote,$com,$row,$class_value,$resto_value);
local ($com_default_clear) = 0;
# 全投稿停止
$AllStop and &resp('name' => 'allstop');
if ($class eq 'new') { &new_form; }
# 対象記事を確認
local ($r,$d,$p,$c) = &cnctd_res($num);
$d or &resp('name' => 'noresnum','info' => "No.$num");
if ($class eq 'res') { &res_form; }
if ($class eq 'edt') { &edt_form; }
if ($class eq 'del') { &del_form; }
&resp('name' => 'badclass','info' => "mode=$mode, class=$class");
}
if ($mode eq 'admin') {
if ($in{'pass'} eq '') { &admin_gate; }
if (!$post_flag) { &resp('name' => 'notpost'); }
if ($in{'pass'} ne $pass) { &resp('name' => 'badadmin'); }
if ($class eq 'admin_delete') { &admin_delete; }
&admin;
}
if ($mode eq 'check') { ✓ }
&resp('name' => 'badmode','info' => "mode=$mode, class=$class");
}
&footer_menu;
&footer;
exit;
#======================#
# メイン処理ここまで #
#======================#
#----------------#
# 記事一覧表示 #
#----------------#
# 引数 0:なし
# 戻り値:なし
sub subj_list {
my ($top,@lines) = ();
my ($bloc_obj,$net_ttl,$now_no) = ();
$bloc_obj .= "
全ての記事のタイトルを一覧表示しています。各記事タイトルのリンクから、その記事の全文を表示させることができます。親記事の左にある [ALL] のリンクから、子記事も含めたスレッド全体を表示させる事ができます。
\n";
# ログを読み込み
if ($lockkey == 4) {
# flock
($top,@lines) = &file_read($logfile);
}
else {
if ($lockkey) {
$lockflag = &lock() or &resp('name' => 'lockbusy');
}
open(IN,"$logfile") or &resp('name' => 'fileopen','info' => "$logfile");
($top,@lines) = ;
close(IN);
&unlock($lockflag) if ($lockflag);
}
# スレッド繰り返し回数
my $i = (split(/<>/,$top))[3];
# 記事繰り返しカウント
my $n = 0;
my $flag = 0;
$bloc_obj .= "\n";
# スレッドループ
while ($i) {
($no,$reno,$udel,$pw,$times,$name,$com,
$sub,$mail,$url,$mod_times,$env,$host,$opt,$icon) = split(/<>/,$lines[$n]) or last;
{ # 表題整形ブロック
# ユーザー削除済み
$udel and $net_ttl = "No.$no - ユーザ削除済み", last;
# 題名の長さ
if (length($sub) > $sub_len) {
$sub = substr($sub,0,$sub_len);
$sub .= "...";
}
# オプション処理
my ($tag) = &read_opt($opt);
if ($tag) {
# 文字実体参照処理
($name,$sub) = &do_entref($name,$sub);
}
# @処理
($name,$sub) = &do_atmark($name,$sub);
# 日付処理
my $date = &time_fmt($times,3);
$date = "${\time_fmt($mod_times,3)} 修正" if ($mod_times);
$sub = " - $sub" if ($sub);
$net_ttl = qq^No.$no$sub ($name:$date)^;
}
$n or $now_no = $no;
# 現在の親記事番号
if ($now_no != $reno) {
$now_no = $no;
# スレッド終了
$bloc_obj .= "\t
", $flag = 0 if ($flag);
$bloc_obj .= "\n" if ($n);
# 親記事
$bloc_obj .= qq^[ALL] $net_ttl
^;
}
else {
# スレッド開始
$bloc_obj .= "\n\t\n", $flag = 1 if (!$flag);
# 子記事
$bloc_obj .= "\t- $net_ttl
\n";
}
} continue { ++$n; }
$bloc_obj .= "\t
\n" if ($flag);
$bloc_obj .= "\n";
# ヘッダを出力
&header('title' => "$title - 記事一覧",'lm' => 1);
print $bloc_obj;
last DO_MAIN;
}
#-----------------------#
# 最新n件・全記事展開 #
#-----------------------#
# 引数 0:なし
# 戻り値:なし
sub threads_view {
local ($top,@lines) = (); # サブルーチンでも使用するので local
my $lm = ''; # Last-Modified 応答ヘッダを出力するか
if (!$num) { $num = $top_log; $lm = 1; }
if ($num =~ /^[0-9]+$/o) {
&header('title' => "$title - 最近のスレッド $num 件",'lm' => $lm);
print qq^最近のスレッド $num 件を表示しています。全ての記事は「記事一覧」から読むことができます。
\n^;
}
elsif ($num eq 'all') {
&header('title' => "$title - 全ての記事");
print "全ての記事を表示しています。
\n";
}
else { &resp('name' => 'badnum','info' => "mode=$mode, class=$class:$num"); }
# ログを読み込み
if ($lockkey == 4) {
# flock
($top,@lines) = &file_read($logfile);
}
else {
if ($lockkey) {
$lockflag = &lock() or &resp('name' => 'lockbusy');
}
open(IN,"$logfile") or &resp('name' => 'fileopen','info' => "$logfile");
($top,@lines) = ;
close(IN);
&unlock($lockflag) if ($lockflag);
}
# スレッド繰り返し回数
my $i = ($num ne 'all') ? $num : (split(/<>/,$top))[3];
# 記事繰り返しカウント
my $n = 0;
# スレッドループ
for (1..$i) {
($no,$reno,$udel,$pw,$times,$name,$com,
$sub,$mail,$url,$mod_times,$env,$host,$opt,$icon) = split(/<>/,$lines[$n++]);
# メニュー
&footer_menu;
print "
\n";
# 親記事開始
print "\n";
# 親記事レス番を定義
$d = $no;
# 記事の書式
print ${\res_fmt()};
# 子記事ループ
do {
($no,$reno,$udel,$pw,$times,$name,$com,
$sub,$mail,$url,$mod_times,$env,$host,$opt,$icon) = split(/<>/,$lines[$n++]);
if ($reno) {
# 子記事
print "
\n";
# 親記事レス番を定義
$d = $reno;
# 記事の書式
print ${\res_fmt()};
print "
\n";
}
else { $n--; }
} while ($reno);
# 親記事終了
print "
\n";
}
if ($num ne 'all') {
# 次ページは無い
print qq(
\n);
print qq(これ以前の記事は「記事一覧」からご覧ください。
\n);
}
last DO_MAIN;
}
#------------------#
# レス表示モード #
#------------------#
# 引数 0:なし
# 戻り値:なし
sub res_view {
($r,$d,$p,$c) = &cnctd_res($num);
if ($thread) {
$d or &resp('name' => 'nothrnum','info' => "No.$num");
&header('title' => "$title - スレッド No.$d");
print "スレッド No.$d を表示しています。
各記事の(右)上部にある「返信」のリンクからその記事に返信することができます。また、「修正」「削除」のリンクからその記事を修正、削除することができます(要パスワード)。
\n";
if ($thread == 2) {
print "class=no:$d,thread
という書式は非推奨となりました。将来のバージョンではサポートされません。スレッド No.$d を表示するためには、class=no:${d}t
としてください。
\n";
}
&cnctd_view($p,$c);
}
else {
$d or &resp('name' => 'noresnum','info' => "No.$num");
&header('title' => "$title - 記事 No.$num");
print "記事 No.$num を表示しています。
記事の(右)上部にある「スレッド表示」のリンクからスレッド全体を表示させることができます。また、「返信」のリンクからこの記事に返信することが、「修正」「削除」のリンクからこの記事を修正、削除(要パスワード)することができます。
\n";
&cnctd_view($r);
}
last DO_MAIN;
}
#--------------------------#
# 指定記事・スレッド出力 #
#--------------------------#
# 引数 0:開始記事出現位置
# 引数 1:出力記事数(0オリジン)
# 戻り値:なし
sub cnctd_view {
my ($a,$b) = @_;
print "
\n";
# 記事表示
$flag = 0;
for ($a..$a+$b) {
($no,$reno,$udel,$pw,$times,$name,$com,
$sub,$mail,$url,$mod_times,$env,$host,$opt,$icon) = split(/<>/,$lines[$_]);
# 親記事
if (!$reno) { print "\n"; $flag = 1; }
# 子記事
else { print "
\n"; }
# 記事の書式
print ${\res_fmt()};
print "
\n" if ($reno);
}
print "
\n" if ($flag);
}
#--------------------#
# 記事フォーマット #
#--------------------#
# 引数 0:記事操作メニュー制御(0:表示, 1:非表示)
# 戻り値:整形された記事
sub res_fmt {
my $no_edit_menu = $_[0];
my ($date,$mod_date,$img,$bloc_obj) = ();
# 記事見出しレベル
my $hn = $reno ? '3' : '2';
if ($udel) {
$bloc_obj .= "No.$no: $del_sub\n";
# 記事操作メニュー
$bloc_obj .= qq^
スレッド表示
\n^ if (!$thread);
$bloc_obj .= "$del_com
\n";
}
else {
# オプション処理
($tag,$pre,$anc) = &read_opt($opt);
if ($tag) {
# マークアップ処理
$com = &do_tag($com,$pre);
# 文字実体参照処理
($name,$sub,$com) = &do_entref($name,$sub,$com);
# 数値文字参照処理
$com = &do_numref($com);
}
# URL自動リンク
$com = &do_anchor($com) if ($anc);
# @処理
($name,$sub,$com,$url,$env) = &do_atmark($name,$sub,$com,$url,$env);
# 題名の長さ
if (length($sub) > $sub_len) {
$sub = substr($sub,0,$sub_len);
$sub .= "...";
}
$name = "Name: $name\n";
$date = "Date: ${\time_fmt($times,1)}\n";
$mod_date = "Last-Modified: ${\time_fmt($mod_times,1)}\n" if ($mod_times);
if ($com) { $com =~ s|
|
|g; }
if ($mail) { $mail = qq^E-mail: ${\do_mail($mail)}\n^; }
if ($url) { $url = qq^URL: ${\do_anchor($url)}\n^; }
if ($env) { $env = qq^User-Agent: $env\n^; }
# アイコン処理
if ($iconkey and $icon and $icon !~ /[\n]/) {
my ($icogrp,$icoid) = split(' ',$icon);
# アイコンへのパス
my $imgsrc = "$icodir$icogrp/$icons{$icogrp}[$icoid][0]";
# # アイコンの代替文字列
# my $imgalt = "【$icons{$icogrp}[0][1]】$icons{$icogrp}[$icoid][1]";
# アイコンの説明
my $imgtitle = "【$icons{$icogrp}[0][1]】$icons{$icogrp}[$icoid][1]";
# アイコンの拡張子
my $imgpstx = $icons{$icogrp}[$icoid][2] || $icons{$icogrp}[0][2] || 'png';
# アイコンのwidth
my $imgw = $icons{$icogrp}[$icoid][3] || $icons{$icogrp}[0][3] || '100';
# アイコンのheight
my $imgh = $icons{$icogrp}[$icoid][4] || $icons{$icogrp}[0][4] || '100';
# アイコン定義 アイコングループ定義 デフォルト
$img = qq^\n^;
}
# 記事削除フォームではメニューなし
if ($no_edit_menu) {
# 記事タイトル
$bloc_obj .= "No.$no: $sub\n";
}
# 通常記事
else {
# 記事タイトル
$bloc_obj .= qq^No.$no: $sub\n^;
# 記事操作メニュー
$bloc_obj .= qq^^;
$bloc_obj .= qq^スレッド表示//^ if (!$thread);
$bloc_obj .= qq^返信^;
if ($pw) {
$bloc_obj .= "/";
$bloc_obj .= qq^/修正^;
$bloc_obj .= qq^/削除^;
}
$bloc_obj .= "
\n";
}
$bloc_obj .= qq^\n^;
if ($pre)
{ $bloc_obj .= "$com
\n"; }
else { $bloc_obj .= "\n$img$com\n
\n"; }
if ($mail or $url or $env)
{ $bloc_obj .= qq^\n^;}
}
return $bloc_obj;
}
#------------------------#
# 関連記事ピックアップ #
#------------------------#
# 引数 0:レス番号
# 戻り値:(該当記事出現位置 $r,関連親記事のレス番号 $d,関連親記事出現位置 $p,関連子記事数 $c)
sub cnctd_res {
my $n = $_[0];
my ($r,$d,$p,$c) = (0,0,0,0);
my ($no,$reno) = ();
# ログを読み込み
if ($lockkey == 4) {
# flock
($top,@lines) = &file_read($logfile);
}
else {
if ($lockkey) {
$lockflag = &lock() or &resp('name' => 'lockbusy');
}
open(IN,"$logfile") or &resp('name' => 'fileopen','info' => "$logfile");
($top,@lines) = ;
close(IN);
&unlock($lockflag) if ($lockflag);
}
# 親記事ピックアップ
foreach (@lines) {
($no,$reno) = split(/<>/);
if ($n == $no) { $d = $reno || $no; last; }
$r++;
}
# 関連記事ピックアップ
$flag = 0;
foreach (@lines) {
($no,$reno) = split(/<>/);
if ($flag) {
if ($reno == $d) { $c++; next; }
last;
}
if ($no == $d) { $flag = 1; next; }
$p++;
}
return ($r,$d,$p,$c);
}
#--------------------#
# 新規投稿フォーム #
#--------------------#
# 引数 0:なし
# 戻り値:なし
sub new_form {
my $stat = '';
# フォーム個別化
# エラー回復
if (%ep) {
($name,$sub,$com,$mail,$url,$icon,$opt,$pwd)
= ($ep{'name'},$ep{'sub'},$ep{'com'},$ep{'mail'},$ep{'url'},$ep{'icon'},$ep{'opt'},$ep{'pwd'},);
$sub_default = $sub;
$stat = '400 Bad Request';
}
else {
$com_default_clear = 1; # フォーカスを得た時に「コメント」入力欄をクリア
$sub_default = '';
$com = '(お気楽に。てきとーに。)';
# クッキーを取得
($name,$mail,$url,$pwd,$icon) = &get_cookie;
($name,$mail,$url) = &do_atmark($name,$mail,$url);
}
$form_title = '新規投稿';
$pwdnote = '(記事の修正・削除時に使用。英数字で8文字以内)';
$row = 18;
$class_value = "$class";
$resto_value = '';
&header('title' => "$title - $form_title",'status' => $stat);
print $ep{'msg'};
print "雑記への突っ込み、ぽあぞんでずゅーに対する御意見御感想御提言など、年中無休でお待ちしています。
\n";
print ${\form_fmt()};
last DO_MAIN;
}
#--------------------#
# 返信投稿フォーム #
#--------------------#
# 引数 0:なし
# 戻り値:なし
sub res_form {
my $stat = '';
# 返信可能を確認
&confirm_flag($r,$class)
or &resp('name' => 'cannotres','info' => "No.$num");
# エラー回復
if (%ep) {
($name,$sub,$com,$mail,$url,$icon,$opt,$pwd)
= ($ep{'name'},$ep{'sub'},$ep{'com'},$ep{'mail'},$ep{'url'},$ep{'icon'},$ep{'opt'},$ep{'pwd'},);
$stat = '400 Bad Request';
}
else {
# レス対象記事呼び出し
($no,$reno,$udel,$pw,$times,$name,$com,
$sub,$mail,$url,$mod_times,$env,$host,$opt,$icon) = split(/<>/,$lines[$r]);
# textarea の中身は #PCDATA
($sub,$com) = &do_atmark($sub,$com);
# 引用符をつける
$row = $com =~ s/
/\n> /g;
$com = "> $com";
# タイトル名を定義
if ($sub and $sub !~ /^Re\:/) { $sub = "Re\: $sub"; }
# クッキーを取得
($name,$mail,$url,$pwd,$icon) = &get_cookie;
($name,$mail,$url) = &do_atmark($name,$mail,$url);
}
# フォーム個別化
$form_title = '返信投稿';
$sub_default = $sub;
$pwdnote = '(記事の修正・削除時に使用。英数字で8文字以内)';
$row += 18;
$class_value = "$class:$d";
$resto_value = $num;
&header('title' => "$title - No.$num に返信",'status' => $stat);
print $ep{'msg'};
print qq(記事 No.$num(スレッド No.$d)への返信投稿フォームです(関連スレッド)。
\n);
print ${\form_fmt()};
# 関連スレ出力
print qq(関連スレッド
\n);
&cnctd_view($p,$c);
last DO_MAIN;
}
#--------------------#
# 記事修正フォーム #
#--------------------#
# 引数 0:なし
# 戻り値:なし
sub edt_form {
my $stat = '';
# 修正可能を確認
&confirm_flag($r,$class)
or &resp('name' => 'cannotedt','info' => "No.$num");
# エラー回復
if (%ep) {
($name,$sub,$com,$mail,$url,$icon,$opt,$pwd)
= ($ep{'name'},$ep{'sub'},$ep{'com'},$ep{'mail'},$ep{'url'},$ep{'icon'},$ep{'opt'},$ep{'pwd'},);
$stat = '400 Bad Request';
}
else {
# 該当記事呼び出し
($no,$reno,$udel,$pw,$times,$name,$com,
$sub,$mail,$url,$mod_times,$env,$host,$opt,$icon) = split(/<>/,$lines[$r]);
# textarea の中身は #PCDATA
($tag,$pre,$anc) = &read_opt($opt);
($name,$sub,$com,$mail,$url) = &do_atmark($name,$sub,$com,$mail,$url);
$row = $com =~ s/
/\n/g;
}
# フォーム個別化
$form_title = '記事修正';
$sub_default = $sub;
$pwdnote = '(設定したパスワードを入力してください)';
$row += 5;
$class_value = "$class:$num";
$resto_value = '';
&header('title' => "$title - No.$num を修正",'status' => $stat);
print $ep{'msg'};
print qq(記事 No.$num の修正フォームです(関連スレッド)。
\n);
print ${\form_fmt()};
# 関連スレ出力
print qq(関連スレッド
\n);
&cnctd_view($p,$c);
last DO_MAIN;
}
#--------------------#
# 記事削除フォーム #
#--------------------#
# 引数 0:なし
# 戻り値:なし
sub del_form {
my $stat = '';
# 削除可能を確認
&confirm_flag($r,$class)
or &resp('name' => 'cannotdel','info' => "No.$num");
# エラー回復
$stat = '400 Bad Request' if (%ep);
# 該当記事呼び出し
($no,$reno,$udel,$pw,$times,$name,$com,
$sub,$mail,$url,$mod_times,$env,$host,$opt,$icon) = split(/<>/,$lines[$r]);
&header('title' => "$title - No.$num を削除",'status' => $stat);
print <<"EOM";
$ep{'msg'}
記事 No.$num の削除フォームです(関連スレッド)。
関連スレッド
EOM
# 関連スレ出力
&cnctd_view($p,$c);
last DO_MAIN;
}
#--------------#
# フラグ確認 #
#--------------#
# 引数 0:対象記事出現位置
# 引数 1:確認内容(res|edt|del)
# 戻り値:真偽値
sub confirm_flag {
my ($m,$e) = @_;
# 該当記事読み込み
my ($no,$reno,$udel,$pw) = split(/<>/,$lines[$m]);
# 返信可能確認
if ($e eq 'res') {
if ($mode eq 'form') {
$udel or return 1; # 削除済みでなければ返信フォーム表示可能
return 0;
}
if ($mode eq 'regist') {
$reno or return 1; # 子記事でなければ返信投稿可能
return 0;
}
return undef;
}
# 修正・削除可能確認
if ($e eq 'edt' or $e eq 'del') {
$pw and return 1; # パスワードが設定されている記事は修正・削除可能
return 0;
}
return 0;
}
#------------------------#
# フォームフォーマット #
#------------------------#
# 引数 0:なし
# 戻り値:整形されたフォーム
sub form_fmt {
my $agent = $ENV{'HTTP_USER_AGENT'};
my $form_obj = '';
# フォーム幅調整
if ($agent =~ /Opera|Gecko/i)
{ $nam_wid = 25; $sub_wid = 60; $com_wid = 70; $url_wid = 55; }
elsif ($agent =~ /MSIE 3/i)
{ $nam_wid = 30; $sub_wid = 40; $com_wid = 65; $url_wid = 48; }
elsif ($agent =~ /MSIE/i)
{ $nam_wid = 25; $sub_wid = 50; $com_wid = 55; $url_wid = 45; }
elsif ($agent =~ /Mozilla\/4/i)
{ $nam_wid = 15; $sub_wid = 25; $com_wid = 40; $url_wid = 30; }
else
{ $nam_wid = 15; $sub_wid = 50; $com_wid = 50; $url_wid = 35; }
$form_obj .= qq(「ハンドル」と「コメント」は必須項目です。「コメント」では一部のタグ等が解釈されます。入力したままを表示させるにはオプションの「タグ無効」をチェックしてください。);
$form_obj .= qq(また、「コメント」では $sst_sign対象文字列と書くと自動的に置換されます。) if ($substkey);
$form_obj .= "
\n";
$form_obj .= qq(\n);
return $form_obj;
}
#----------------#
# 記事投稿処理 #
#----------------#
# 引数 0:なし
# 戻り値:なし
sub regist {
my ($no2,$reno2,$udel2,$pw2,$times2,$name2,$com2);
my ($no,$reno,$times,$mod_times) = ();
my $user_del = 0;
my @form_error = ();
# 全投稿停止
$AllStop and &resp('name' => 'allstop');
# classを確認
$flag = 0;
foreach ('new','res','edt','del') {
if ($class eq $_) { $flag = 1; last; }
}
$flag or &resp('name' => 'badclass','info' => "mode=$mode, class=$class");
# post限定
$post_flag or &resp('name' => 'notpost');
# フォーム入力チェック(記事削除時以外)
if ($class ne 'del') {
# 必須項目確認
if ($in{'name'} eq '') { push(@form_error,'「ハンドル」が未入力です。'); }
if ($in{'com'} eq '') { push(@form_error,'「コメント」が未入力です。'); }
# メールアドレスチェック
if ($in_mail) {
if ($in{'mail'} eq '') { push(@form_error,'「メールアドレス」が未入力です。'); }
}
# オプションを定義
unless (defined($in{'tag'})) { $in{'tag'} = '1'; }
unless (defined($in{'pre'})) { $in{'pre'} = '0'; }
unless (defined($in{'anc'})) { $in{'anc'} = '0'; }
# オプションチェック
if ($in{'tag'} and $in{'anc'}) {
push(@form_error,'「URLをリンクにする」オプションは「タグ無効」チェック時のみ有効です。');
}
# 記事修正時はパスワード入力チェック
if ($class eq 'edt' and $in{'pwd'} eq '')
{ push(@form_error,'パスワードが入力されていません。'); }
# パスワードを暗号化
$ango = &encrypt($in{'pwd'}) unless ($in{'pwd'} eq '');
# 置換処理
$in{'com'} = &substitute($in{'com'}) if ($substkey);
}
# 記事削除
else {
# パスワード入力チェック
if ($in{'pwd'} eq '') { push(@form_error,'パスワードが入力されていません。'); }
# ユーザ削除フラグを設定
$user_del = 1;
}
# 時間を取得
$in{'times'} = time;
# ログを開く
if ($class eq 'new') {
# 新規投稿時以外は cnctd_res サブルーチンでログを開く
if ($lockkey == 4) {
# flock
($top,@lines) = &file_read($logfile);
}
else {
if ($lockkey) {
$lockflag = &lock() or &resp('name' => 'lockbusy');
}
open(IN,"$logfile") or &resp('name' => 'fileopen','info' => "$logfile");
($top,@lines) = ;
close(IN);
&unlock($lockflag) if ($lockflag);
}
}
else {
($r,$d,$p,$c) = &cnctd_res($num);
# 返信・修正・削除可能を確認
$d or &resp('name' => 'noresnum','info' => "No.$num");
&confirm_flag($r,$class)
or &resp('name' => 'badnum','info' => "mode=$mode, class=$class:$num");
}
my ($no0,$ip0,$times0) = split(/<>/, $top);
# 新規・返信投稿
if ($class eq 'new' or $class eq 'res') {
# 連続投稿チェック
if ($wait and $addr eq $ip0 and $wait > $in{'times'} - $times0)
{ push(@form_error,'連続投稿はもうしばらく時間をおいて下さい。'); }
# 重複チェック
if ($dbl_post) {
$flag = 0;
foreach (@lines) {
($no2,$reno2,$udel2,$pw2,$times2,$name2,$com2) = split(/<>/);
if ($in{'com'} eq $com2 and $in{'name'} eq $name2) { $flag = 1; last; }
}
if ($flag) { push(@form_error,'重複投稿のため処理を中断しました。'); }
}
# 記事情報設定
$no = ++$no0;
$reno = $num;
$times0 = $times = $in{'times'};
$mod_times = '';
}
# 記事修正・削除
else {
($no2,$reno2,$udel2,$pw2,$times2) = split(/<>/,$lines[$r]);
# パスワード照合
&decrypt($in{'pwd'},$pw2) or push(@form_error,'パスワードが違います。');
# 記事情報設定
$no = $num;
$reno = $reno2;
$times = $times2;
$mod_times = $in{'times'};
}
# エラー検出
@form_error and &form_error(@form_error), return undef;
my @new = (); # 投稿が挿入されるより前の部分
my @tmp = (); # 投稿が挿入されるより後ろの部分
LOG_CTRL: {
# 新規投稿
if ($class eq 'new') {
@tmp = @lines;
last LOG_CTRL;
}
# 返信投稿
if ($class eq 'res') {
@new = @lines[0..$p+$c];
@tmp = @lines[$p+$c+1..$#lines];
last LOG_CTRL;
}
# 記事修正・削除
if ($class eq 'edt' or $class eq 'del') {
@new = @lines[0..$r-1];
@tmp = @lines[$r+1..$#lines];
last LOG_CTRL;
}
}
push(@new,"$no<>$reno<>$user_del<>$ango<>$times<>$in{'name'}<>$in{'com'}<>$in{'sub'}<>$in{'mail'}<>$in{'url'}<>$mod_times<>$in{'agent'}<>$host<>1$in{'tag'}$in{'pre'}$in{'anc'}<>$in{'icon'}<>\n");
push(@new,@tmp);
# 親記事数カウント
my $pcnt = 0;
foreach (@new) {
($no2,$reno2) = split(/<>/);
if (!$reno2) { $pcnt++; }
}
# 過去ログ作成
if ($pastkey and $pcnt > $max) {
@new = &pastlog(@new);
$pcnt -= $pastctn;
}
# 情報ヘッダ付与
unshift(@new,"$no0<>$addr<>$times0<>$pcnt<>\n");
# ログ更新
if ($lockkey == 4) {
# flock
&file_write($logfile,@new);
}
else {
if ($lockkey) {
$lockflag = &lock() or &resp('name' => 'lockbusy');
}
open(OUT,"> $logfile") or &resp('name' => 'filewrite','info' => "$logfile");
print OUT @new or &resp('name' => 'fileprint','info' => "$logfile");
close(OUT);
&unlock($lockflag) if ($lockflag);
}
# 投稿終了
POST_END: {
if ($class eq 'del') {
&resp('name' => 'endofdel','info' => "No.$num",'return' => 1);
last POST_END;
}
# クッキーを発行(記事削除時以外)
&set_cookie("$in{'name'}","$in{'mail'}","$in{'url'}","$in{'pwd'}","$in{'icon'}");
if ($class eq 'new') {
&resp('name' => 'endofnew','return' => 1);
last POST_END;
}
if ($class eq 'res') {
&resp('name' => 'endofres','info' => "No.$num",'return' => 1);
last POST_END;
}
if ($class eq 'edt') {
&resp('name' => 'endofedt','info' => "No.$num",'return' => 1);
last POST_END;
}
}
# 関連スレッドを出力
($r,$d,$p,$c) = &cnctd_res($no);
&cnctd_view($p,$c);
last DO_MAIN;
}
#--------------------------#
# フォームエラー回復処理 #
#--------------------------#
# 引数 :エラーメッセージのリスト
# 戻り値:なし
sub form_error {
my $msg = '';
# 入力内容を収集
my ($name,$sub,$com,$mail,$url,$icon,$opt,$pwd,@msg)
= ($in{'name'},$in{'sub'},$in{'com'},$in{'mail'},$in{'url'},$in{'icon'},$in{'opt'},$in{'pwd'},@_);
# decode 済みの内容を復元
$com =~ s/
/\n/go;
($name,$sub,$com,$mail,$url) = &do_atmark($name,$sub,$com,$mail,$url);
# エラーメッセージの整形
foreach (@msg) {
$msg .= "$_\n";
}
$msg = qq(\n);
%ep = ('name' => $name,'sub' => $sub,'com' => $com,'mail' => $mail,
'url' => $url,'icon' => $icon,'opt' => $opt,'pwd' => $pwd,'msg' => $msg);
# パラメータの再設定
$mode = 'form';
$num = $in{'resto'} || $num;
&unlock($lockflag) if ($lockflag);
return undef;
}
#--------------------#
# 特定文字列置換処理 #
#--------------------#
# 引数 0:コメント文字列
# 戻り値:特定文字列を置換したコメント文字列
# 辞書書式
# 置換前文字列 ($rep_bef),置換後文字列 ($rep_aft),[URL ($rep_url)],$/
# $sst_sign = 置換許可文字(記号)
sub substitute {
my $comtext = $_[0];
# 辞書ファイルを開く
open(DIC,"$dicfile") or &resp('name' => 'dicopen','info' => "$dicfile");
while () {
my ($rep_bef,$rep_aft,$rep_url) = split(/,/);
if ($rep_url) {
$comtext =~ s{$sst_sign$rep_bef}{<a href="$rep_url">$rep_aft</a>}g;
}
else {
$comtext =~ s{$sst_sign$rep_bef}{$rep_aft}g;
}
}
close(DIC);
return $comtext;
}
# thx! Bee-X さん (http://www2s.biglobe.ne.jp/~bee-x/)
#----------------#
# デコード処理 #
#----------------#
# 引数 0:なし
# 戻り値:出力メディアタイプ(html|xml)
sub decode {
my ($buffer,$name,$value);
@DEL = ();
$thread = 0;
$post_flag = 0;
# POST リクエストの処理
if ($ENV{'REQUEST_METHOD'} eq 'POST') { # 大文字
$post_flag = 1;
if ($ENV{'CONTENT_LENGTH'} > 51200) { &resp('name' => 'bigpost'); }
read(STDIN,$buffer,$ENV{'CONTENT_LENGTH'});
}
# GET リクエストの処理
else {
$buffer = $ENV{'QUERY_STRING'};
}
my @pairs = split(/[&;]/,$buffer);
# UA取得
push(@pairs,"agent=${\url_enc($ENV{'HTTP_USER_AGENT'})}");
# 正当な "=" が含まれる可能性も考慮して一旦URLエンコードする。
foreach (@pairs) {
# パラメータ展開
EXP_PARAM: {
# $_ eq 'NAME=VALUE'
if (/=/) {
($name,$value) = split(/=/);
last EXP_PARAM;
}
# $_ eq 'VALUE'
$value = $_;
# パラメータ名の補完
if ($_ eq 'view' or $_ eq 'form') { $name = 'mode'; }
else { $name = 'class'; }
}
# デコード
($value) = &url_dec($value);
# タグ区切り子等処理
$value =~ s/&/&/go;
$value =~ s/</go;
$value =~ s/>/>/go;
PNAME: {
# 改行等処理
if ($name eq 'com') {
# 「コメント」では br 要素に変換
$value =~ s/\x0D\x0A/
/go; # CRLF
$value =~ s/\x0D/
/go; # CR
$value =~ s/\x0A/
/go; # LF
last PNAME;
}
# その他では1文字のスペース
$value =~ s/[\s]+/ /go;
if ($name eq 'class') {
# サブパラメータ展開
if ($value =~ /:/o) {
($value,$num) = split(/:/,$value);
}
else {
# レス・スレッド表示サブパラメータ名の補完
if ($value =~ /^(t?[1-9][0-9]*t?)$/o) {
$value = 'no'; $num = $1;
}
}
# レス・スレッド表示
if ($value eq 'no') {
# スレッド表示
if ($num =~ /^([1-9][0-9]*)t$/o or $num =~ /^t([1-9][0-9]*)$/o) {
$num = $1; $thread = 1; last PNAME;
}
if ($num =~ /^([1-9][0-9]*),thread$/o) {
$num = $1; $thread = 2; last PNAME;
}
}
last PNAME;
}
# 出力メディアタイプ補完
if ($name eq 'o' or $name eq 'output') {
$name = 'output';
if ($value eq 'h') { $value = 'html'; }
if ($value eq 'x') { $value = 'xml'; }
if ($value eq 'xhtml') { $value = 'xml'; }
last PNAME;
}
# 一括削除用
if ($name eq 'del') { push(@DEL,$value); last PNAME; }
} # end of PNAME BLOCK
$in{$name} = $value;
}
$mode = $in{'mode'};
$class = $in{'class'};
$page = $in{'page'};
# パラメータ対の補完
# mode省略時はview
if (!$mode) { $mode = 'view'; }
# mode=viewでclass省略時はlast
if (!$class and $mode eq 'view') { $class = 'last'; }
return $in{'output'};
}
#------------------------#
# ヘッダと共通メニュー #
#------------------------#
# 引数 status:ステータスメッセージ
# title :title 要素
# h1 :h1 要素 (省略可能・省略時は title に同じ)
# lm :(0|1) Last-Modified ヘッダを出力するか
# media :(html|xml) 出力メディア設定
# 戻り値:なし
sub header {
my %hl = ('status' => '200 OK','title' => $title,'h1' => '','lm' => 0,'media' => $media,@_);
$hl{'h1'} = $hl{'h1'} || $hl{'title'};
print "Status: $hl{'status'}\n";
if ($hl{'lm'}) {
my $mtime = gmtime((stat("$logfile"))[9]);
print "Last-Modified: $mtime GMT\n";
}
print "Content-Language: ja\n";
print "Cache-Control: no-cache\n";
# 出力メディア振り分け
my $x_flag = 0;
MEDIATYPE: {
if ($hl{'media'} eq 'html') { $x_flag = 0; last MEDIATYPE; }
if ($hl{'media'} eq 'xml') { $x_flag = 1; last MEDIATYPE; }
$x_flag = &accept_media();
}
# application/xhtml+xml
if ($x_flag) {
print "Content-Style-Type: text/css\n";
print "Content-Script-Type: text/javascript\n";
print "Content-Type: application/xhtml+xml; charset=$doccode\n\n";
print <<"EOM";
EOM
}
# text/html
else {
print "Pragma: no-cache\n";
print "Content-Type: text/html; charset=$doccode\n\n";
print <<"EOM";
EOM
}
print <<"EOM";
$hl{'title'}
EOM
if ($mode eq 'form') {
print <<"EOM";
EOM
}
else { print "\n\n"; }
print <<"EOM";
$hl{'h1'}
トップ
雑記
雑記索引
予定帳
書庫
掲示板
新規投稿
について
サイトマップ
EOM
$head_flag = 1;
}
#----------------------#
# ページ下部メニュー #
#----------------------#
sub footer_menu {
print qq(
\n\n);
}
#----------------#
# ページフッタ #
#----------------#
# 引数 0:なし
# 戻り値:なし
sub footer {
$spt_date = &time_fmt((stat($script))[9],1);
print <<"EOM";
©KENT
©Expensive Noise
©NEXTON
©オーガスト
©ねこねこソフト
もりば <rinrin@funifuni.net>
Script: $spt_ver
Script-Updated: $spt_date
EOM
}
#------------#
# 留意事項 #
#------------#
# 引数 0:なし
# 戻り値:なし
sub howto {
&header('title' => "$title - 掲示板利用上のこまごま");
$sub_len_utf8 = $sub_len/3;
print <<"EOM";
掲示板トップでは最近のスレッド $top_log 件が表示されます。これ以前の記事は「記事一覧」から読むことができます。
「記事一覧」では全ての記事のタイトルが一覧表示されます。各記事タイトルのリンクから、その記事の全文を表示させることができます。親記事の左にある [ALL] のリンクから、子記事も含めたスレッド全体を表示させる事ができます。また、各記事の(右)上部にある「スレッド表示」のリンクからもスレッド全体を表示させる事ができます。
既存の記事に返信することができます。各記事の(右)上部にある「返信」のリンクをたどると返信モードになります。
記事の投稿時に「パスワード」(英数字で8文字以内)を設定した場合、その記事はパスワードによって修正・削除することができます。修正モードあるいは削除モードに入るには、記事の(右)上部にある「修正」あるいは「削除」のリンクをたどってください。
この掲示板はクッキー対応です。ブラウザがクッキー対応で、クッキーを受け入れる設定の場合、記事を投稿すると「ハンドル」「メールアドレス」「URL」
EOM
$iconkey and print "「アイコン」";
print <<"EOM";
「パスワード」の入力値は $ck_exp 日間保存されます。
記事を投稿する上での必須入力項目は「ハンドル」と「コメント」です。その他の入力は任意です。
「タイトル」は $sub_len バイト(日本語だと $sub_len_utf8 文字くらい)までしか表示されません。
EOM
$iconkey and
print qq^「アイコン」で選択した画像が記事とともに表示されます(ただし、「preモード」では表示されません)。「アイコン一覧」で各画像を確認する事ができます。
\n^;
$substkey and
print qq^「コメント」では「置換辞書」に登録されている語句は簡易に入力する事ができます。!置換対象語句 と入力すると 置換後語句 に変換されます。
\n^;
print qq^「記事検索」から投稿記事の検索ができます。
\n^;
$pastkey and
print qq^スレッドの保持数は最大 $max 件です。それを超えると古い順に $pastctn 件が「過去ログ」に送られます。
\n^;
print <<"EOM";
-
「タグ無効」オプションがチェックされていない場合は XHTML 要素や文字参照を使うことができます。
-
「コメント」では XHTML 1.0/XHTML 1.1 要素の一部が使用できます。使用可能な要素は以下の通りです(ただし、「preモード」では括弧内の要素は使用出来ません)。また、文字実体参照、数値文字参照も使用できます。
EOM
$eles{'inlstruct'} and
print "- インライン構造要素:
",join(', ',@inlstruct),"
\n";
$eles{'inlphras'} and
print "- インラインフレーズ要素:
",join(', ',@inlphras),"
\n";
$eles{'inlpres'} and
print "- インライン表現要素:
",join(', ',@inlpres)," (",join(', ',@inlpresdepre),")
\n";
$eles{'hypertext'} and
print "- ハイパーテキストリンク:
",join(', ',@hypertext),"
\n";
$eles{'edit'} and
print "- 編集要素:
(",join(', ',@edit),")
\n";
$eles{'bdo'} and
print "- 双方向アルゴリズムの上書き:
",join(', ',@bdo),"
\n";
$eles{'image'} and
print "- 画像:
",join(', ',@image),"
\n";
$eles{'ruby'} and
print "- ルビ注釈:
",join(', ',@ruby),"
\n";
print <<"EOM";
「ハンドル」と「タイトル」では文字実体参照のみ使用することができます。数値文字参照は使用できません。
有意な文字実体についてはXHTML における文字参照を参照ください(手前味噌)。
数値文字参照における有意な参照範囲は、
- 十進では 9-10, 13, 32-126, 160-55295, 57344-65533, 65536-1114111
- 十六進では 0x9-0xA, 0xD, 0x20-0x7E, 0xA0-0xD7FF, 0xE000-0xFFFD, 0x10000-0x10FFFF
です。
オプションについて:
「タグ無効」にチェックを入れると、タグや文字参照などは解釈されずに「コメント」に入力したとおりに画面に表示されます。<font size=7>ほげ</font> とか & とか書いてもそのまま表示されます。
「URLをリンクにする」にチェックを入れると、コメント中のURL(http, ftpスキームのみ)を自動的にリンクにします(判定は「ものぐさ」です)。このオプションは「タグ無効」オプションチェック時のみ有効です。
「preモード」にチェックを入れると、コメント本文が pre 要素の内容となります。多くのブラウザは等幅フォントで、空白文字等を省略せずに表示してくれるでしょう。
EOM
$iconkey and print "また、「preモード」ではアイコンが表示されません。";
print <<"EOM";
パラメータについて:GET リクエストで CGI に渡すことができるパラメータは以下の通りです。パラメータの区切り子は ;
(セミコロン)か &
です。全てのパラメータとパラメータ値は、大文字小文字を区別します。
mode=[view | form]
mode
パラメータは基本となる動作を指定します。パラメータ名 mode=
は省略可能です。デフォルト値は view
です。具体的なリソースを class
パラメータで指定します。
view
記事とか使い方とか置換辞書とか色々表示します。class
パラメータは省略可能です。指定できる class
パラメータの値は次の通りです。
class=[last | list | all | no | howto
EOM
$iconkey and print " | image";
$substkey and print " | dic";
print <<"EOM";
| find | past | history]
パラメータ名 class=
は省略可能です。デフォルト値は last
です。
last[:number | :all]
最近のスレッド $top_log 件を表示します。:
(コロン)に続けて number (自然数)を指定すると最近のスレッド number 件を表示します。all
を指定した場合は全てのスレッドを表示します(class=all
と同じです)。
list
「記事一覧」を表示します。
all
全てのスレッドを表示します(class=last:all
と同じです)。
no:xx[,thread | t]
記事 No.xx を表示します。no
と xx
(レス番号)は :
(コロン)で区切ります。,
(コンマ)に続けて thread
、あるいは t
のみ、を指定した場合は No.xx を含むスレッドを表示します。no:
は省略可能です。
この記法は非推奨となりました。次の記法を使用してください。
no:xx[t]
記事 No.xx を表示します。no
と xx
(レス番号)は :
(コロン)で区切ります。xx
に続けて t
を指定した場合は No.xx を含むスレッドを表示します。no:
は省略可能です。
howto
「使い方」を表示します。
EOM
$iconkey and
print qq^image
「アイコン一覧」を表示します。
\n^;
$substkey and
print qq^dic
「置換辞書」を表示します。
\n^;
print <<"EOM";
find[;q [;c][;n]]
「検索モード」に入ります。また、q
パラメータを一緒に指定することによって直接検索する事もできます。c
パラメータ、n
パラメータの指定は任意です。
q=hoge1[(SP | %20 | +) hoge2][...]
hoge1[, hoge2][, ...] を対象文字列として検索します。複数の文字列を検索する場合は ASCII Space か %20
、あるいは +
で区切ります。ただし、日本語(に限らないんだけど)の文字を使う場合は $doccode で符号化されている必要があります。というわけで普通に「検索モード」から検索する事をおすすめします。
c=[AND | OR]
q
パラメータで複数の文字列を指定した場合の検索条件を指定します。AND
の場合は全ての文字列を含む記事を探します(AND 検索)。OR
の場合はいずれかの文字列を含む記事を探します(OR 検索)。デフォルト値は AND
です。
n=[number]
1ページに表示する検索結果の件数を指定します。デフォルト値は 5、最小値は 1、最大値は 50 です。number が 1 より小さい場合は 5 件を、50 より大きい場合は 50 件を表示します。
past
「過去ログ」を表示します。
history[:version | :all]
「最近の改造履歴」を表示します。:
(コロン)に続けて version (バージョン番号)を指定するとそのバージョンの履歴のみを表示します。all
を指定した場合は全ての履歴を表示します。
form
各種フォームを表示します。class
パラメータが必須です。指定可能な class
パラメータの値は次の通りです。
class=(new | res | edt | del)
パラメータ名 class=
は省略可能です。
new
「新規投稿フォーム」を表示します。
res:xx
記事 No.xx への「返信フォーム」を表示します。res
と xx
(レス番号)は :
(コロン)で区切ります。
edt:xx
記事 No.xx の「修正フォーム」を表示します。edt
と xx
(レス番号)は :
(コロン)で区切ります。
del:xx
記事 No.xx の「削除フォーム」を表示します。del
と xx
(レス番号)は :
(コロン)で区切ります。
output=[html | xml | xhtml]
o=[h | x]
Accept HTTP 要求ヘッダを無視して、指定したメディアタイプで出力します。パラメータ名とパラメータ値は略記が可能です(省略はできません)。それぞれのパラメータ値に対応するメディアタイプは次の通りです。
html
または h
: text/html
xml
, xhtml
または x
: application/xhtml+xml
output
パラメータは常に指定可能です。無指定の場合の出力メディアタイプは Accept 要求ヘッダによって判断されます。
いくつか、最小形式と完全形式でパラメータを例示します。
last:10
← mode=view;class=last:10
(最新から 10 件のスレッドを表示します)
51t
← mode=view;class=no:51t
(記事 No.51 を含むスレッドを表示します)
find;q=hoge+hage;c=OR
(hoge あるいは hage を含む記事を検索します。結果は5件ずつ表示されます)
history:1.14.3
← mode=view;class=history:1.14.3
(ver.1.14.3 の改造履歴を表示します)
form;new
← mode=form;class=new
(新規投稿フォームを表示します)
form;res:51
← mode=form;class=res:51
(記事 No.51 への返信フォームを表示します)
form;edt:51;o=h
← mode=form;class=edt:51;output=html
(記事 No.51 の修正フォームを表示します。メディアタイプは text/html です)
もちろんこんなの覚えてなくても掲示板の利用に支障はありません。これっぽっちも。
WWWC などの Web 更新チェッカで新規投稿などを確認するには、以下の URL のいずれかをチェックしてください。どちらの場合でも、Last-Modified
ヘッダでログの最終更新時間を返します。
- http://www32.tok2.com/home/moriba/yybbs/yybbs.cgi
- http://www32.tok2.com/home/moriba/yybbs/yybbs.cgi?list
この掲示板は私(もりば)が管理を行っています。全ての記事は、私(もりば)の判断により予告なく削除される可能性があります。
この掲示板の CGI スクリプトは、KENT WEB の「YY-BOARD v4.8」をもとに、私(もりば)が改造を行ったものです。誤動作・不具合等は私(もりば)までお知らせください。
EOM
$iconkey and
print <<"EOM";
この掲示板で使用しているアイコン画像について:
EOM
print "
\n";
last DO_MAIN;
}
#------------#
# 改造履歴 #
#------------#
# 引数 0:なし
# 戻り値:なし
sub history {
my $histitle = '';
my $v = 0;
my $his_obj = '';
HISTITLE: {
if (!$num)
{ $histitle = '最近の改造履歴'; last HISTITLE; }
if ($num eq 'all')
{ $histitle = '全改造履歴'; last HISTITLE; }
if ($num eq '?')
{ $histitle = '改造 ToDo'; $v = 1; last HISTITLE; }
if ($num =~ /^[\d.\-]+$/o)
{ $histitle = "改造履歴 ver.$num"; $v = 1; last HISTITLE; }
}
$histitle or &resp('name' => 'badnum','info' => "mode=$mode, class=$class:$num");
my (@c,$ver,$date) = ();
my $f = 0;
# ログを読み込み
open(HIS,"$hisfile") or &resp('name' => 'hisopen','info' => "$hisfile");
while () {
if (//o) { (@c,$ver,$date) = (); $f++; next; }
if (/(.+)<\/ver>/o) { $ver = $1; next; }
if ($v and $ver ne $num) { next; }
if (/(.+)<\/date>/o) { $date = $1; next; }
if (/(.+)<\/content>/o) { push(@c,$1); next; }
if (/<\/history>/o) {
$his_obj .= qq(\n);
$his_obj .= "\n";
foreach (reverse(@c)) { $his_obj .= "- $_
\n"; }
$his_obj .= "
\n";
$num eq 'all' and next;
$v and last;
$f >= 7 and last;
}
}
close(HIS);
&header('title' => "$title - $histitle");
print $his_obj;
last DO_MAIN;
}
#----------------#
# 置換辞書表示 #
#----------------#
# 引数 0:なし
# 戻り値:なし
sub subst_dic {
my $dic_obj = '';
$dic_obj .= qq^注意事項
\n
- 「コメント」入力欄にて !置換対象語句 と入力すると 置換後語句 に変換されます。
- ただし、「タグ無効」にチェックが入っているとアレなことになります(「修正」してください)。
- 基本的に Dear Feeling .net (Bee-X さん)の掲示板「日々の堕記:御意見板」の辞書
をパチってと互換性があります。
- 追加希望はお気軽にどうぞ。
- 辞書ファイル本体。
\n^;
$dic_obj .= "置換対象語句 → 置換後語句
\n";
# 辞書を読み込み
open(DIC,"$dicfile") or &resp('name' => 'dicopen','info' => "$dicfile");
$dic_obj .= "\n";
while () {
my ($abbr,$expand,$url) = split(/,/);
if ($url) {
$dic_obj .= qq(- $abbr → $expand
\n);
}
else {
$dic_obj .= "- $abbr → $expand
\n";
}
}
close(DIC);
$dic_obj .= "
\n";
&header('title' => "$title - 置換辞書");
print $dic_obj;
last DO_MAIN;
}
#--------------------#
# アイコン一覧表示 #
#--------------------#
# 引数 0:なし
# 戻り値:なし
sub ico_image {
&header('title' => "$title - アイコン一覧");
print "目次
\n";
my ($icogrp);
print qq(\n";
print qq(\n);
print "アイコン
\n";
# アイコングループを展開
foreach $icogrp (sort(keys(%icons))) {
print qq(\n$icons{$icogrp}[0][1]\n);
# グループ内のアイコン数
my $ico_pcs = $#{$icogrp};
# 列数
my $ico_cols = 5;
# 行内の実際の列数(アイコン数が列数よりも少ないときに余分なセルを作らない)
my $limit = ($ico_pcs < $ico_cols) ? $ico_pcs : $ico_cols;
# 行グループ数(行数はこの2倍)
my $ico_rows = ($ico_pcs % $ico_cols) ? ($ico_pcs / $ico_cols +1) : ($ico_pcs / $ico_cols);
# (グループ内での)アイコンID
my $count = 1;
# 行グループ数分繰り返す
for (1..$ico_rows) {
print "\n\n";
# アイコンラベル
foreach $icoid ($count..$count+$limit-1) {
print "$icons{$icogrp}[$icoid][1] | \n";
}
print "
\n\n";
# 列数分繰り返す
foreach $icoid ($count..$count+$limit-1) {
# アイコンがあれば(2行グループ目以降対策)
if ($icons{$icogrp}[$icoid][0]) {
# アイコンへのパス
my $imgsrc = "$icodir$icogrp/$icons{$icogrp}[$icoid][0]";
# アイコンの代替文字列
# my $imgalt = "【$icons{$icogrp}[0][1]】$icons{$icogrp}[$icoid][1]";
# アイコンの説明
my $imgtitle = "【$icons{$icogrp}[0][1]】$icons{$icogrp}[$icoid][1]";
# アイコン情報(拡張子,width,height)のデフォルト
@imgattr[2..4] = ('png','100','100');
foreach (2..4) {
# アイコン定義が情報を持っていれば採用する
if ($icons{$icogrp}[$icoid][$_]) {
$imgattr[$_] = $icons{$icogrp}[$icoid][$_];
}
else { # アイコン定義が情報を持っていない場合に
# アイコングループ定義が情報を持っていれば採用する
if ($icons{$icogrp}[0][$_]) {
$imgattr[$_] = $icons{$icogrp}[0][$_];
}
}
}
# アイコンを表示
print qq( | \n);
}
# アイコンがなければ空のセル
else {
print " | \n";
}
}
print "
\n\n";
# 次行のアイコンIDを定義
$count += $ico_cols;
}
print qq(
\n\n);
}
last DO_MAIN;
}
#------------------#
# 管理モード入口 #
#------------------#
# 引数 0:なし
# 戻り値:なし
sub admin_gate {
&header('title' => "$title - 管理モード入口");
print <<"EOM";
EOM
last DO_MAIN;
}
#----------------#
# 管理ログ表示 #
#----------------#
# 引数 0:なし
# 戻り値:なし
sub admin {
my ($top,@lines) = ();
# ログを読み込み
if ($lockkey == 4) {
# flock
($top,@lines) = &file_read($logfile);
}
else {
if ($lockkey) {
$lockflag = &lock() or &resp('name' => 'lockbusy');
}
open(IN,"$logfile") or &resp('name' => 'fileopen','info' => "$logfile");
($top,@lines) = ;
close(IN);
&unlock($lockflag) if ($lockflag);
}
my @top = split(/<>/,$top);
my $cnt = 0;
my $admin_body = '';
foreach (@lines) {
($no,$reno,$udel,$pw,$times,$name,$com,$sub,$mail,$url,$mod_times,$env,$host) = split(/<>/);
if (!$reno) {
$in{'admin_log'} && $cnt++ >= $in{'admin_log'} and last;
$admin_body .= "\n\n";
}
if ($reno) { $reno = "$reno-"; }
$date = &time_fmt($times,3);
if ($mod_times) {
$date = "$date (${\time_fmt($mod_times,3)} 更新)";
}
# ユーザ削除記事
if ($udel) {
$admin_body .= qq^
$reno$no |
ユーザ削除済み | \n
\n$date | $host | \n
\n^;
}
# 通常記事
else {
$com =~ s/
.*$//o;
$com =~ s/\"/"/go;
# 長さ制限
if (length($sub) > $sub_len) {
$sub = substr($sub,0,$sub_len);
$sub .= "...";
}
if (length($com) > $sub_len) {
$com = substr($com,0,$sub_len);
$com .= "...";
}
$admin_body .= qq^
$reno$no |
$name | $mail | $sub | \n
$url | $com | \n
$date | $host | \n
$env |
\n^;
}
}
# 管理コントロール
my $admin_ctrl = qq^
|
| \n
\n^;
# 管理画面を整形
my $admin_view .= qq^
- 最新レス番: $top[0]
- 最新レス投稿時刻: ${\time_fmt($top[2],3)}
- スレッド数: $top[3]
\n^;
# 管理画面を表示
&header('title' => "$title - ログ管理");
print $admin_view;
last DO_MAIN;
}
#----------------#
# 管理削除処理 #
#----------------#
# 引数 0:なし
# 戻り値:なし
sub admin_delete {
# 排他処理
if ($lockkey) {
$lockflag = &lock() or &resp('name' => 'lockbusy');;
}
# ログを開く
if ($lockkey == 4) {
# flock
($top,@lines) = &file_read($logfile);
}
else {
if ($lockkey) {
$lockflag = &lock() or &resp('name' => 'lockbusy');
}
open(IN,"$logfile") or &resp('name' => 'fileopen','info' => "$logfile");
($top,@lines) = ;
close(IN);
&unlock($lockflag) if ($lockflag);
}
# 削除情報をマッチングし更新
my @new = ();
foreach (@lines) {
$flag = 0;
($no,$reno) = split(/<>/);
foreach my $del (@DEL) {
if ($no == $del or $reno == $del) { $flag = 1; last; }
}
unless ($flag) { push(@new,$_); }
}
# 親記事数カウント
my $pcnt = 0;
foreach (@new) {
($no,$reno) = split(/<>/);
if (!$reno) { $pcnt++; }
}
my @top = split(/<>/,$top);
$top[3] = $pcnt;
$top = join('<>',@top);
unshift(@new,$top);
# ログ更新
if ($lockkey == 4) {
# flock
&file_write($logfile,@new);
}
else {
if ($lockkey) {
$lockflag = &lock() or &resp('name' => 'lockbusy');
}
open(OUT,"> $logfile") or &resp('name' => 'filewrite','info' => "$logfile");
print OUT @new or &resp('name' => 'fileprint','info' => "$logfile");
close(OUT);
&unlock($lockflag) if ($lockflag);
}
return undef;
}
#------------------#
# チェックモード #
#------------------#
# 引数 0:なし
# 戻り値:なし
sub check {
&header('title' => "$title - チェックモード");
print "\n";
# 現在時刻
print "- 現在時刻: ", &time_fmt(time,3), "
\n";
# 環境確認
printf "- Perl ver.: $] (%vd)
\n", $^V;
print "- スクリプト ver.: $spt_ver
\n";
print "- タイムゾーン: $ENV{'TZ'}
\n";
# ログファイル
print "投稿ログ
\n\n";
if (-e $logfile) {
print "- ログファイル: $logfile
\n";
printf "- パーミッション: %04o
\n", (stat(_))[2] & 07777;
printf "- ファイルサイズ: %.1f KB
\n", (-s _) / 1024;
print "- 最終更新: ${\time_fmt((stat(_))[9],3)}
\n";
}
else { print "- ログファイル: NG
\n"; }
print "
\n";
# 排他処理
if ($lockkey == 0) { print "ロック形式: 設定なし
\n"; }
else {
my $lock = ('symlink','mkdir','rename')[$lockkey-1];
print "ロック形式: $lock
\n\n";
if ($lockkey == 3) {
if (-e $lockfile) {
print "- ロックファイル: $lockfile
\n";
printf "- パーミッション: %04o
\n", (stat(_))[2] & 07777;
}
else { print "- ロックファイル: NG
\n"; }
}
else {
($lockdir) = $lockfile =~ /(.*)[\\\/].*$/o;
if (-d $lockdir) {
print "- ロックディレクトリ: $lockdir
\n";
printf "- パーミッション: %04o
\n", (stat(_))[2] & 07777;
}
else { print "- ロックディレクトリ: NG
\n"; }
}
print "
\n";
}
# アイコン
if ($iconkey == 0) { print "アイコン: 使用しない
\n"; }
else {
print "アイコン: 使用する
\n\n";
if (-d $icodir) {
print "- アイコン画像ディレクトリ: $icodir
\n";
printf "- パーミッション: %04o
\n", (stat(_))[2] & 07777;
}
else { print "- アイコン画像ディレクトリ: NG
\n"; }
print "
\n";
}
# 置換機能
if ($substkey == 0) { print "置換機能: 使用しない
\n"; }
else {
print "置換機能: 使用する
\n\n";
if (-e $dicfile) {
print "- 置換辞書ファイル: $dicfile
\n";
printf "- パーミッション: %04o
\n", (stat(_))[2] & 07777;
printf "- ファイルサイズ: %.1f KB
\n", (-s _) / 1024;
print "- 最終更新: ${\time_fmt((stat(_))[9],3)}
\n";
}
else { print "- 置換辞書ファイル: NG
\n"; }
print "
\n";
}
# 過去ログ
if ($pastkey == 0) { print "過去ログ: 設定なし
\n"; }
else {
print "過去ログ: 設定あり
\n\n";
if (-e $idxfile) {
print "- 情報ファイル: $idxfile
\n";
printf "- パーミッション: %04o
\n", (stat(_))[2] & 07777;
}
else { print "- 情報ファイル: NG
\n"; }
if (-d $pastdir) {
print "- 過去ログディレクトリ: $pastdir
\n";
printf "- パーミッション: %04o
\n", (stat(_))[2] & 07777;
}
else { print "- 過去ログディレクトリ: NG
\n"; }
print "
\n";
}
print "
\n";
last DO_MAIN;
}
#------------------#
# ワード検索処理 #
#------------------#
# 引数 0:なし
# 戻り値:なし
sub find {
# 検索用パラメータ
# q=任意文字列 (検索語句。多分 UTF-8 限定。旧 word)
# n=任意数値 (表示件数。ゼロ以下は 5。旧 view)
# c=(AND | OR) (検索条件。どっちでもなかったら AND。旧 cond)
&header('title' => "$title - 検索");
print <<"EOM";
- 検索したいキーワードを入力し、「検索条件」「表示件数」を選択して「検索」ボタンを押して下さい。
- キーワードは「半角スペース」で区切って複数指定することができます。
\n);
# ワード検索の実行と結果表示
if ($in{'q'} ne ''){
# 入力内容を整理
$in{'q'} =~ s/ / /go;
@pairs = split(/\s+/, $in{'q'});
my ($top,@lines) = ();
# ログを読み込み
if ($lockkey == 4) {
# flock
($top,@lines) = &file_read($logfile);
}
else {
if ($lockkey) {
$lockflag = &lock() or &resp('name' => 'lockbusy');
}
open(IN,"$logfile") or &resp('name' => 'fileopen','info' => "$logfile");
($top,@lines) = ;
close(IN);
&unlock($lockflag) if ($lockflag);
}
my @new = ();
# 検索処理
foreach (@lines) {
$flag = 0;
foreach $pair (@pairs) {
if (index($_,$pair) >= 0) {
$flag = 1;
if ($in{'c'} eq 'OR') { last; }
}
else {
if ($in{'c'} eq 'AND') { $flag = 0; last; }
}
}
if ($flag) { push(@new,$_); }
}
# 検索終了
my $count = @new;
if ($page eq '') { $page = 0; }
$end_data = @new - 1;
$page_end = $page + $in{'n'} - 1;
if ($page_end >= $end_data) { $page_end = $end_data; }
$next_line = $page_end + 1;
$back_line = $page - $in{'n'};
($eword) = &url_enc($in{'q'});
$page_start = $page + 1;
print "検索結果( $count 件中 $page_start - $next_line 件目)
\n";
# ページコントロール
print qq(\n";
foreach ($page .. $page_end) {
($no,$reno,$udel,$pw,$times,$name,$com,
$sub,$mail,$url,$mod_times,$env,$host,$opt,$icon) = split(/<>/,$new[$_]);
# 親記事番号を定義
$d = $reno || $no;
# 結果を表示
print qq(
\n);
# 親記事
if (!$reno) { print qq(\n); }
# 子記事
else { print qq(
\n); }
print ${\res_fmt()};
print "
\n"
}
}
last DO_MAIN;
}
#----------------#
# 過去ログ目次 #
#----------------#
# 引数 0:なし
# 戻り値:なし
sub past {
# 過去ログ情報ファイルを読み込む
open(IN,"$idxfile") or &resp('name' => 'psxopen','info' => "$idxfile");
@pastidx =
;
close(IN);
my $pastno = shift(@pastidx);
$pastno =~ s/\s//g;
&header('title' => "$title - 過去ログ目次");
print "よろづ書込処v4 過去ログ
\n";
# 最新過去ログの確認
unless (-e "$pastdir$pastno.html") {
print "よろづ書込処v4 の過去ログはありません。
\n";
}
else {
# 過去ログ情報ファイルの表示
print "\n";
foreach (@pastidx) {
my ($plogname,$plog_sn,$plog_st,$plog_en,$plog_et) = split(/<>/);
$plog_sd = &time_fmt($plog_st,3);
$plog_ed = &time_fmt($plog_et,3);
print "- No.$plog_en - No.$plog_sn ($plog_ed - $plog_sd)
\n";
}
print "
\n";
}
print <<"EOM";
真・よろづ書込処 過去ログ
よろづ書込処 過去ログ
EOM
last DO_MAIN;
}
#----------------#
# 過去ログ生成 #
#----------------#
sub pastlog {
local ($pastno,$pastfile,$prev,$now,$next,$log,$no,$reno);
local @temp = ();
my $i = 0;
# 情報ファイルを開く
open(IDX,"$idxfile") or &resp('name' => 'psxopen','info' => "$idxfile");
@pastidx = ;
close(IDX);
# 過去ログのファイル名を定義
$pastno = shift(@pastidx);
$pastno =~ s/\s//g;
$prev = $pastno;
$pastno++; $now = $pastno;
$pastno++; $next = $pastno;
$pastfile = "$pastdir$now\.html";
# 過去ログを選別・整形
while ($i < $pastctn) {
$log = pop(@_);
unshift(@temp,$log);
($no,$reno) = split(/<>/,$log);
if (!$reno) { $i++; }
}
&past_fmt(@temp);
# 過去ログファイルを作成
open(OUT,"> $pastfile") or &resp('name' => 'pstwrite','info' => "$pastfile");
print OUT @fileb;
close(OUT);
chmod(0604,$pastfile);
# 情報ファイルを更新
unshift(@pastidx,"$now.html<>$plog_sn<>$plog_st<>$plog_en<>$plog_et<>\n");
unshift(@pastidx,"$now\n");
open(IDX,"> $idxfile") or &resp('name' => 'psxwrite','info' => "$idxfile");
print IDX @pastidx;
close(IDX);
# ログを返す
return(@_);
}
#----------------#
# 過去ログ整形 #
#----------------#
sub past_fmt {
@fileb = ();
local $pflag = "";
my $pno = substr($now,-2);
# $pno =~ s/^0/$'/;
push(@fileb,"\n");
push(@fileb,"\n");
push(@fileb,"");
push(@fileb,"\n");
push(@fileb,"\n");
push(@fileb,"\n");
push(@fileb,"\n");
push(@fileb,"\n");
push(@fileb,"\n");
push(@fileb,"$title 過去ログ No.$pno\n\n\n");
push(@fileb,"$title 過去ログ No.$pno - Poison des Yeux
\n\n");
push(@fileb,"\n");
push(@fileb,"トップ \n");
push(@fileb,"雑記 \n");
push(@fileb,"予定帳 \n");
push(@fileb,"書庫 \n");
push(@fileb,"掲示板\n");
push(@fileb,"について\n");
push(@fileb,"
\n\n\n");
$flag=0;
foreach (@_) {
($no,$reno,$udel,$pw,$times,$name,$com,
$sub,$mail,$url,$mod_times,$env,$host,$opt) = split(/<>/);
# 2つ目以降の親記事の前
push(@fileb,"
\n\n") if (!$reno && $flag);
# 親記事
if (!$reno) {
if (!$pflag) { $plog_en = $no; $plog_et = $times; $pflag=1; }
else { $plog_sn = $no; $plog_st = $times; }
push(@fileb,"\n");
$flag=1;
}
# 子記事
else {
push(@fileb,"
\n");
push(@fileb,"
\n");
}
# ユーザ削除済み
if ($udel) {
push(@fileb,"
No.$no: $del_sub
\n
$del_com
\n");
}
else {
# 題名の長さ
if (length($sub) > $sub_len) {
$sub = substr($sub,0,$sub_len);
$sub .= "...";
}
# オプション処理
($tag,$pre,$anc) = &read_opt($opt);
if ($tag) {
# マークアップ処理
$com = &do_tag($com,$pre);
# 文字実体参照処理
($com,$sub) = &do_entref($com,$sub);
# 数値文字参照処理
$com = &do_numref($com);
}
# URL自動リンク
$com = &do_anchor($com) if ($anc);
# @処理
($name,$sub,$com,$mail,$url,$env) = &do_atmark($name,$sub,$com,$mail,$url,$env);
if ($com) { $com =~ s|
|
|g; }
if ($name) { $name = "
Name: $name\n"; }
$date = &time_fmt($times,1);
if ($date) { $date = "
Date: $date\n"; }
if ($mod_times) {
$mod_date = &time_fmt($mod_times,1);
$mod_date = "
Last-Modified: $mod_date\n";
} else { $mod_date = ""; }
if ($mail) { $mail = "
E-mail: $mail\n"; }
if ($url) { $url = "
URL: $url\n"; }
if ($env) { $env = "
User-Agent: $env\n"; }
push(@fileb,"
No.$no: $sub
\n");
push(@fileb,"\n");
if ($pre) { push(@fileb,"
\n$com\n
\n"); }
else { push(@fileb,"
\n$com\n
\n"); }
push(@fileb,"\n");
}
push(@fileb,"
\n") if ($reno);
}
push(@fileb,"
\n
\n\n");
push(@fileb,"\n\n");
push(@fileb,"
\n");
# push(@fileb,"");
# push(@fileb,"© KENT
\n");
push(@fileb,"もりば <rinrin@funifuni.net>\n");
push(@fileb,"\n");
push(@fileb,"\n");
push(@fileb,"\n");
push(@fileb,"
\n\n\n");
}
#------------------#
# 応答メッセージ #
#------------------#
# 引数 0:エラーメッセージ
# 'name' :エラー名
# 'info' :エラー内容
# 'return':0=exit,1=return
# 戻り値:なし
sub resp {
my %resp = ('name' => '','info' => '','return' => 0,@_);
if (!$head_flag) {
&header('status' => "$respcode{$respmsg{$resp{'name'}}[0]}[0]",
'title' => "Response: $respcode{$respmsg{$resp{'name'}}[0]}[0]",
'h1' => "応答: $respcode{$respmsg{$resp{'name'}}[0]}[1]");
}
print "$respcode{$respmsg{$resp{'name'}}[0]}[2]
\n";
print "\n";
print "- $respmsg{$resp{'name'}}[1]
\n";
print "- $resp{'info'}
\n" if ($resp{'info'});
print "- $respmsg{$resp{'name'}}[2]
\n";
print "
\n";
$resp{'return'} and return undef;
&footer();
&unlock($lockflag) if ($lockflag);
exit;
}
#----------------#
# ホスト名取得 #
#----------------#
# 引数 0:なし
# 戻り値:(ホスト名 $host,IPアドレス $addr)
sub get_host {
my $host = $ENV{'REMOTE_HOST'};
my $addr = $ENV{'REMOTE_ADDR'};
if ($host eq '' or $host eq $addr) {
$host = gethostbyaddr(pack("C4", split(/\./, $addr)), 2) || $addr;
}
return ($host,$addr);
}
#----------------#
# アクセス制限 #
#----------------#
# 引数 0:なし
# 戻り値:なし
sub axs_check {
my $flag = 0;
foreach (@deny) {
if (!$_) { next; }
s/\*/\.\*/go;
if ($host =~ /$_/i) { $flag = 1; last; }
}
if ($flag) { &resp('name' => 'refshost','info' => "$host"); }
}
#----------------#
# 規制チェック #
#----------------#
# 引数 0:なし
# 戻り値:なし
sub deny_check {
$mode eq 'admin' and return;
my @flag = ();
my ($df_top,@df_lines) = ();
my ($df_id,$df_flag,$df_obj,$df_cont) = ();
# 規制ファイルを読み込み
if ($lockkey == 4) {
# flock
($df_top,@df_lines) = &file_read($denylist);
}
else {
if ($lockkey) {
$lockflag = &lock() or &resp('name' => 'lockbusy');
}
open(IN,"$denylist") or &resp('name' => 'fileopen','info' => "$denylist");
($df_top,@df_lines) = ;
close(IN);
&unlock($lockflag) if ($lockflag);
}
# 規制ファイルを解釈
DENYCHK: foreach (@df_lines) {
($df_id,$df_flag,$df_obj,$df_cont) = split(/<>/);
$df_flag or next DENYCHK;
# ホスト規制
if ($df_obj == 0) {
$df_cont =~ s|\.|\\\.|g;
$df_cont =~ s|\*|\.\*|g;
$host !~ /($df_cont)/i and next DENYCHK;
# アクセス規制
$df_flag & 2 and do {
@flag = ('name' => 'refshost','info' => "$host");
last;
};
$mode ne 'regist' and next DENYCHK;
# 投稿規制
$df_flag & 1 and do {
@flag = ('name' => 'rejpost','info' => "$host (Type 1)");
last;
};
}
# UserAgent規制(投稿規制のみ)
if ($df_obj == 1) {
$mode ne 'regist' and next DENYCHK;
$in{'agent'} =~ /($df_cont)/i and do {
@flag = ('name' => 'rejpost','info' => "$host (Type 2)");
last;
};
}
}
@flag and &resp("@flag");
# 投稿元チェック
REF_CHECK: {
$mode ne 'regist' and return;
$base_url or last REF_CHECK;
my $ref_url = $ENV{'HTTP_REFERER'} or last REF_CHECK;
$ref_url =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack("C", hex($1))/ego;
if ($ref_url !~ /$base_url/i) { &resp('name' => 'badref','info' => "$ref_url"); }
}
}
#------------------#
# クッキーの発行 #
#------------------#
# 引数 0:Cookie内容のリスト
# 戻り値:なし
sub set_cookie {
# 有効期限の設定
my $age = time+60*60*24*$ck_exp; # Set-Cookie2向け
my $gmt = &time_fmt($age,0); # Set-Cookie向け
# クッキーの内容はURLエンコードする
my $cook = join('<>',&url_enc(@_));
print "Set-Cookie: YYBBS=$cook; Expires=$gmt\x0D\x0A";
print qq(Set-Cookie2: YYBBS="$cook"; Max-Age="$age"; Version="1"\x0D\x0A);
}
#------------------#
# クッキーを取得 #
#------------------#
# 引数 0:なし
# 戻り値:Cookie内容のリスト
sub get_cookie {
(my $ck = $ENV{'HTTP_COOKIE'}) =~ s/\s//go;
foreach (split(/;/,$ck)) {
my ($key,$val) = split(/=/);
$key ne 'YYBBS' and next;
# $key =~ s/\s//go;
$val =~ tr/"//d; # "
$ck{$key} = $val;
}
# Cookieの内容をデコード
return &url_dec(split(/<>/,$ck{'YYBBS'}));
}
#----------------------#
# パスワード暗号処理 #
#----------------------#
# 引数 0:入力されたパスワード
# 戻り値:暗号化されたパスワード
sub encrypt {
my $inpw = $_[0];
my @SALT = ('a'..'z', 'A'..'Z', '0'..'9', '.', '/');
srand;
my $salt = $SALT[int(rand(@SALT))] . $SALT[int(rand(@SALT))];
return crypt($inpw, $salt) || crypt($inpw, '$1$' . $salt);
}
#----------------------#
# パスワード照合処理 #
#----------------------#
# 引数 0:入力されたパスワード
# 引数 1:ログに保存されたパスワード(暗号化済)
# 戻り値:真偽値
sub decrypt {
my ($inpw,$logpw) = @_;
my $salt = $logpw =~ /^\$1\$(.*)\$/ && $1 || substr($logpw, 0, 2);
if ((crypt($inpw, $salt) || crypt($inpw, '$1$' . $salt)) eq $logpw)
{ return 1; }
return 0;
}
#------------------------#
# ファイル読み込み処理 #
#------------------------#
# 引数 0:ファイル名
# 戻り値:データの配列
sub file_read {
my ($filename) = @_;
open(IN,"< $filename") or &resp('name' => 'fileopen','info' => "$filename");
flock(IN,1) or &resp('name' => 'lockbusy');
my @lines = ;
close(IN);
return @lines;
}
# &resp('name' => 'testok','info' => "$lines[0]");
#------------------------#
# ファイル書き込み処理 #
#------------------------#
# 引数 0:ファイル名
# 引数 1:データの配列
# 戻り値:1
sub file_write {
my ($filename,@data) = @_;
open(OUT,"+< $filename") or &resp('name' => 'filewrite','info' => "$filename");
flock(OUT,2) or &resp('name' => 'lockbusy');
seek(OUT,0,0) or &resp('name' => 'fileseek','info' => "$filename");
print OUT @data or &resp('name' => 'fileprint','info' => "$filename");
truncate(OUT,tell(OUT)) or &resp('name' => 'filetc','info' => "$filename");
close(OUT);
return 1;
}
#--------------#
# ロック処理 #
#--------------#
# 引数 0:なし
# 戻り値:ロックフラグ
sub lock {
my $retry = 5;
# rename関数
if ($lockkey == 3) {
while (--$retry >= 0) {
rename($lockfile,$newname = $lockfile . time) and return $newname;
} continue { sleep(1); }
# 1分以上古いロックは破棄して新たにロックする
my ($lockdir,$lockname) = $lockfile =~ /(.*)[\\\/](.*)$/;
opendir(LOCKDIR, $lockdir);
my @filelist = readdir(LOCKDIR);
closedir(LOCKDIR);
foreach (@filelist) {
if (/^$lockname(\d+)/) {
$1 < time - 60 && rename($lockfile . $1,$newname = $lockfile . time)
and return $newname;
last;
}
}
return undef;
}
# thx. Perlメモ(http://www.din.or.jp/~ohzaki/perl.htm)
# 1分以上古いロックは解除する
if (-e $lockfile) {
my $mtime = (stat($lockfile))[9];
if ($mtime < time - 60) { &unlock(); }
}
LOCK_TYPE: {
# mkdir関数式ロック
if ($lockkey == 2) {
until (mkdir($lockfile, 0700)) {
if (--$retry <= 0) { return undef; }
sleep(1);
}
last LOCK_TYPE;
}
# symlink関数式ロック
if ($lockkey == 1) {
until (symlink(".", $lockfile)) {
if (--$retry <= 0) { return undef; }
sleep(1);
}
last LOCK_TYPE;
}
}
return 1;
}
#--------------#
# ロック解除 #
#--------------#
# 引数 0:ロックフラグ
# 戻り値:なし
sub unlock {
if ($lockkey == 3) { rename($_[0],$lockfile); }
if ($lockkey == 2) { rmdir($lockfile); }
if ($lockkey == 1) { unlink($lockfile); }
undef $lockflag;
}
#--------------------#
# 出力メディア判定 #
#--------------------#
# 引数 0:なし
# 戻り値:出力メディアの真偽値(1:application/xhtml+xml, 0:text/html)
sub accept_media {
my ($xqvalue,$hqvalue) = (0,0);
my ($xflag,$hflag) = ();
$ENV{'HTTP_ACCEPT'} =~ s/[\x09\x0A\x0D\x20]//go;
my @accept = split(/,/,$ENV{'HTTP_ACCEPT'});
foreach (@accept) {
my ($media,@params) = split(/;/);
if ($media eq 'text/html') {
$hqvalue = 1;
foreach (@params) {
my ($pname,$pvalue) = split(/=/);
if ($pname eq 'q') { $hqvalue = $pvalue; last; }
}
$hflag = 1;
}
if ($media eq 'application/xhtml+xml') {
$xqvalue = 1;
foreach (@params) {
my ($pname,$pvalue) = split(/=/);
if ($pname eq 'q') { $xqvalue = $pvalue; last; }
}
$xflag = 1;
if ($xqvalue == 0) { return 0; }
}
if ($xflag and $hflag) { last; }
}
if ($xqvalue && $xqvalue >= $hqvalue) { return 1; }
return 0;
}
#------------------------------#
# 出力メディアパラメータ付与 #
#------------------------------#
# 引数 0:メディアタイプ(html|xml)
# 戻り値:クエリ文字列(o=(h|x))
sub media_param {
if ($_[0] eq 'html') { return 'o=h'; }
if ($_[0] eq 'xml') { return 'o=x'; }
&resp('name' => 'badoutput','info' => "output=$_[0]");
}
#-----------------#
# URLエンコード #
#-----------------#
# 引数 0:文字列のリスト
# 戻り値:URLエンコードされた文字列のリスト
sub url_enc {
foreach (@_) {
s/([^0-9A-Za-z ])/'%' . unpack('H2', $1)/ego;
tr/ /+/;
}
return @_;
}
#---------------#
# URLデコード #
#---------------#
# 引数 0:URLエンコードされた文字列のリスト
# 戻り値:文字列のリスト
sub url_dec {
foreach (@_) {
tr/+/ /;
s/%([0-9A-Fa-f][0-9A-Fa-f])/pack("C", hex($1))/ego;
}
return @_;
}
#------------------#
# オプション解釈 #
#------------------#
# 引数 0:4文字オプション
# 戻り値:各オプション真偽のリスト
sub read_opt {
my $opt = $_[0];
my $o = '';
my @opt = ();
for ($o = 1; $o < length($opt); $o++) { # 1文字目の「1」はダミー
push(@opt,substr($opt,$o,1));
}
return @opt;
}
#--------------------#
# マークアップ処理 #
#--------------------#
# 引数 0:コメント文字列
# 戻り値:マークアップを処理したコメント文字列
sub do_tag {
my @elements = ();
@elekey = keys(%eles);
foreach (@elekey) {
if ($eles{$_}) {
push(@elements,@$_);
if ($_ eq "inlpres") { if (!$pre) { push(@elements,@inlpresdepre); } }
}
}
foreach (@elements) {
$_[0] =~ s/<(\/?)($_)(( [a-z:]+="[^"]+")*)>/<$1$2$3>/g; # "
}
return $_[0];
}
#--------------------#
# 文字実体参照処理 #
#--------------------#
# 引数 0:文字列のリスト
# 戻り値:実体参照を処理した文字列のリスト
sub do_entref {
my $text;
foreach $text (@_) {
foreach (@entity) {
$text =~ s/&($_);/&$1;/g;
}
}
return @_;
}
#--------------------#
# 数値文字参照処理 #
#--------------------#
# 引数 0:コメント文字列
# 戻り値:数値参照を処理したコメント文字列
# 参照可能な範囲は 0..1114111 (0x00..0x10FFFF)
# より正確には(XHTML 1.1 DTD)、
# 9..10, 13, 32..126, 160..55295, 57344..65533 65536..1114111
# 0x09..0x0A, 0x0D, 0x20..0x7E, 0xA0..0xD7FF, 0xE000..0xFFFD, 0x10000..0x10FFFF
sub do_numref {
$_[0] =~ s{
&\#
(
( # decimal
9 | 10 | 13
| 3[2-9] | [4-9][0-9] | 1[01][0-9] | 12[0-6]
| 1[6-9][0-9] | [2-9][0-9][0-9]
| [1-9][0-9][0-9][0-9]
| [1-47-9][0-9][0-9][0-9][0-9]
| 5[0-489][0-9][0-9][0-9]
| 55[01][0-9][0-9] | 552[0-8][0-9] | 5529[0-5]
| 5734[4-9] | 573[5-9][0-9] | 57[4-9][0-9][0-9]
| 6[0-46-9][0-9][0-9][0-9]
| 65[0-46-9][0-9][0-9] | 655[0-24-9][0-9] | 6553[0-36-9]
| [1-9][0-9][0-9][0-9][0-9][0-9]
| 10[0-9][0-9][0-9][0-9][0-9]
| 110[0-9][0-9][0-9][0-9]
| 111[0-3][0-9][0-9][0-9]
| 11140[0-9][0-9] | 111410[0-9] | 111411[01]
)
|
x(?i: # hexadecimal
[9AD]
| [2-6A-F][0-9A-F] | 7[0-9A-E]
| [1-9A-F][0-9A-F][0-9A-F]
| [1-9A-CE][0-9A-F][0-9A-F][0-9A-F] | D[0-7][0-9A-F][0-9A-F]
| F[0-9A-E][0-9A-F][0-9A-F] | FF[0-9A-E][0-9A-F] | FFF[0-9A-D]
| [1-9A-F][0-9A-F][0-9A-F][0-9A-F][0-9A-F]
| 10[0-9A-F][0-9A-F][0-9A-F][0-9A-F]
)
)
;
}
{&\#$1;}gox;
return $_[0];
}
#-----------------#
# URL自動リンク #
#-----------------#
# 引数 0:コメント文字列
# 戻り値:URLをリンクに置換したコメント文字列
# RFC2396によるURI(関係部のみ抜粋)
# URI-reference = [ absoluteURI | relativeURI ] [ "#" fragment ]
# absoluteURI = scheme ":" ( hier_part | opaque_part )
# hier_part = ( net_path | abs_path ) [ "?" query ]
# net_path = "//" authority [ abs_path ]
# authority = server | reg_name
# server = [ [ userinfo "@" ] hostport ]
# hostport = host [ ":" port ]
# host = hostname | IPv4address
# hostname = *( domainlabel "." ) toplabel [ "." ]
# domainlabel = alphanum | alphanum *( alphanum | "-" ) alphanum
# toplabel = alpha | alpha *( alphanum | "-" ) alphanum
# IPv4address = 1*digit "." 1*digit "." 1*digit "." 1*digit
# port = *digit
# abs_path = "/" path_segments
# path_segments = segment *( "/" segment )
# segment = *pchar *( ";" param )
# param = *pchar
# pchar = unreserved | escaped | ":" | "@" | "&" | "=" | "+" | "$" | ","
# query = *uric
# fragment = *uric
# uric = reserved | unreserved | escaped
# reserved = ";" | "/" | "?" | ":" | "@" | "&" | "=" | "+" | "$" | ","
# unreserved = alphanum | mark
# mark = "-" | "_" | "." | "!" | "~" | "*" | "'" | "(" | ")"
# escaped = "%" hex hex
# space = " "
# delims = "<" | ">" | "#" | "%" | <">
# unwise = "{" | "}" | "|" | "\" | "^" | "[" | "]" | "`"
# XML 1.0(関係部のみ抜粋)
# ID Name
# Name ::= (Letter | '_' | ':') (NameChar)*
# Letter ::= BaseChar | Ideographic
# BaseChar ::= [#x0041-#x005A] A-Z
# [#x0061-#x007A] a-z
# [#x3041-#x3094] ひらがな
# [#x30A1-#x30FA] カタカナ
# Ideographic ::= [#x4E00-#x9FA5] CJK統合漢字 [\x{4E00}-\x{9FA5}]
# NameChar ::= Letter | Digit | '.' | '-' | '_' | ':' | CombiningChar | Extender
# Digit ::= [#x0030-#x0039] 0-9
# Extender ::= [#x309D-#x309E] ひらがな
# [#x30FC-#x30FE] カタカナ
sub do_anchor {
my ($new,$pre,$fake,$sche,$host,$port,$path,$epath,$que,$eque,$frag,$efrag,$close,@tmp) = ();
$_ = $_[0];
s/
/\x0/go;
s/<//go;
s/&/&/go;
while (m{
(.*?) # $1
(\()? # $2
(?:
(http|ftp):// # scheme $3
(?i)
( # host $4
(?: # IPv4address (0..255)
(?:[0-9][0-9]?|1[0-9][0-9]|2[0-5][0-5])\.
(?:[0-9][0-9]?|1[0-9][0-9]|2[0-5][0-5])\.
(?:[0-9][0-9]?|1[0-9][0-9]|2[0-5][0-5])\.
(?:[0-9][0-9]?(?!\d)|1[0-9][0-9]|2[0-5][0-5])
)
|
(?: (?:[0-9A-Z]+|[0-9A-Z]+[0-9A-Z\-]*?[0-9A-Z]+)\. )* # domainlabel
(?: [A-Z]+|[A-Z]+[0-9A-Z\-]*?[0-9A-Z]+) # toplabel
\.?
)
( : # port (0..65535) $5
(?:
0
| [1-9][0-9]{0,3}(?!\d)
| [1-5][0-9]{4}
| 6[0-4][0-9]{3}
| 65[0-4][0-9]{2}
| 655[0-2][0-9]
| 6553[0-5]
)
)?
( / # path_segments $6
(?: # segments
[\w\-.!~*\'():@&=+\$,/<>%"{}|\\^\[\]`]*
)?
(?: ; # param
[\w\-.!~*\'():@&=+\$,;/<>%"{}|\\^\[\]`]*
)*
)*
(?: \? # query
( [\w\-.!~*\'();/?:@&=+\$,<>%"{}|\\^\[\]`]* )? # $7
)?
(?: \# (?!xml) # fragment
( [\w\-.!~*\'();/?:@&=+\$,<>\#%"{}|\\^\[\]`]* ) # $8
)?
( (?(2) \) # close-parenthesis $9
(?! [\w\-.!~*\'();/?:@&=+\$,<>\#%"{}|\\^\[\]`]) )
)
)
(.*) # $10
}gox ) {
($pre,$fake,$sche,$host,$port,$path,$que,$frag,$close,$_)
= ($1,$2,$3,$4,$5,$6,$7,$8,$9,$10);
($epath = $path) =~ s/([~<>\"{}|\\^\[\]`]|%(?![2-7][0-9a-f]))/'%' . unpack('H2', $1)/egio;
($pre_que,$eque) = ();
if ($que) {
$pre_que = '?';
($eque = $que) =~ s/([~<>\"{}|\\^\[\]`]|%(?![2-7][0-9a-f]))/'%' . unpack('H2', $1)/egio;
}
($pre_frag,$efrag) = ();
if ($frag) {
$pre_frag = '#';
($efrag = $frag) =~ s/([~<>\#\"{}|\\^\[\]`]|%(?![2-7][0-9a-f]))/'%' . unpack('H2', $1)/egio;
}
@tmp = ($pre,"$sche://$host$port$path$pre_que$que$pre_frag$frag",
"$sche://$host$port$epath$pre_que$eque$pre_frag$efrag");
foreach (@tmp) {
s/&/&/go;
s/</go;
s/>/>/go;
}
$new .= qq($tmp[0]$fake$tmp[1]$close);
}
s/&/&/go;
s/</go;
s/>/>/go;
$new .= $_;
$new =~ s/\x0/
/go;
return $new;
}
#----------------------#
# メールアドレス処理 #
#----------------------#
# 引数 0:文字列
# 戻り値:メールアドレスをリンクに置換した文字列
# RFC1783(RFC822)によるMAILTO URL(関係部のみ抜粋)
# MAILTO URL = mailto:
# addr-spec = local-part "@" domain ; global address
# local-part = word *("." word) ; uninterpreted
# ; case-preserved
# word = atom / quoted-string
# domain = sub-domain *("." sub-domain)
# sub-domain = domain-ref / domain-literal
# domain-ref = atom ; symbolic reference
# atom = 1*
# CHAR = ; ( 0-177, 0.-127.)
# specials = "(" / ")" / "<" / ">" / "@" ; Must be in quoted-
# / "," / ";" / ":" / "\" / <"> ; string, to use
# / "." / "[" / "]" ; within a word.
# SPACE = ; ( 40, 32.)
# CTL = ; ( 177, 127.)
sub do_mail {
$_ = $_[0];
s{
( # local-part
(?: [\w!\#\$\%&\'\*\+\-/=\?^`{\|}~]+)
(?:\. [\w!\#\$\%&\'\*\+\-/=\?^`{\|}~]+ )*
)
\@
( # domain
(?: [\w!\#\$\%&\'\*\+\-/=\?^`{\|}~]+)
(?:\. [\w!\#\$\%&\'\*\+\-/=\?^`{\|}~]+ )*
)
}
{$1&\#64;$2}giox;
return $_;
}
#---------#
# @処理 #
#---------#
# 引数 0:文字列のリスト
# 戻り値:@ を @ に変換した文字列のリスト
sub do_atmark {
foreach (@_) {
s/\@/&\#64;/go;
}
return @_;
}
#----------------------#
# 日時のフォーマット #
#----------------------#
# 引数 0:UTC で 1970 年 1 月 1 日 00:00:00 からの連続秒数
# 引数 1:フォーマット形式(0:Cookie用, 1:お茶目な形式, 2:短い形式, 3:普通の形式)
# 戻り値:フォーマットされた日付
sub time_fmt {
$ENV{'TZ'} = 'JST-9';
my ($times,$type) = @_;
my @d = localtime($times);
my @month = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
my @week = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
if ($type == 1) {
return sprintf("%s, %02d %s %04d %02d:%02d:%02d JST",
$week[$d[6]],$d[3],$month[$d[4]],$d[5]+1900,$d[2],$d[1],$d[0]);
}
if ($type == 2) {
return sprintf("%02d/%02d/%02d %02d:%02d",
$d[5]-100,$d[4]+1,$d[3],$d[2],$d[1]);
}
if ($type == 3) {
return sprintf("%04d/%02d/%02d %02d:%02d:%02d",
$d[5]+1900,$d[4]+1,$d[3],$d[2],$d[1],$d[0]);
}
@d = gmtime($times);
return sprintf("%s, %02d-%s-%04d %02d:%02d:%02d GMT",
$week[$d[6]],$d[3],$month[$d[4]],$d[5]+1900,$d[2],$d[1],$d[0]);
}