#! /usr/bin/perl # # omb.cgi # 1.004 : 2/5/08 : 返信のアンカーのマイナーチェンジ # 1.003 : 3/2/07 : 書き込み部分を若干修正 # 1.002 : 2/22/07 : 時間表示に年を追加 # 1.001 : 2/21/07 : 時間表示の秒数を削除 # 1.0 : 2/20/07 : Created # # http://www.hidekik.com # # $Id: omb.cgi,v 1.9 2008/02/05 08:09:50 Hideki Kanayama Exp $ # Copyright(c) 2007-2008, Hideki Kanayama, All rights reserved. use strict; use CGI::Carp qw(fatalsToBrowser); use CGI qw(:cgi-bin); use File::Basename; #管理人パスワードファイル my $admindat = "adminpwd.dat"; #セットアップファイル my $setupfile = "omb_setup.pl"; my $version="1.004"; my $lastupdateyear = "2008"; #このスクリプト my $script = basename($0); my $admin_link = "$script?mode=admin"; my $lang = 0; #### 環境設定 ###### ここから ############ our $logfile = "logdata.dat"; # lock file name our $lockfile = "lockfile.txt"; #ブラウザのタイトルバーに表示される文字 our $title = '一行掲示板'; our $toplink_en = 1; our $toplink_link = '..'; our $toplink_title = 'トップへ'; our $admin_link_en = 1; our $admin_title = '管理用'; # バックグランドカラー our $bgcolor = '#ffffff'; # 表示幅 ブラウザからの％ our $body_width = "100"; # フォントカラー our $name_color = 'darkblue'; our $main_color = 'black'; our $time_color = 'gray'; # 変更機能 1:有効 0:無効 our $modify_en = 1; # 削除機能 1:有効 0:無効 our $delete_en = 1; #cookie name our $cookie_name = 'omb_cookie'; # 1ページに表示する行数 our $maxline = 30; # 時間設定 our $localtime_en = 1; our $offset = 9; #〜内に挿入できる構文 1:on, 0:off our $head_insert_en = 0; our $head_insert = ''; #ページトップに表示される文 our $body_insert = '
一行掲示板

'; #スタイルシート 1:on 0:off our $style_sheet_en = 1; our $style_sheet = ' A:link {text-decoration: none} A:visited {text-decoration: none} A:active {text-decoration: none} A:hover {text-decoration: underline} '; #### 環境設定 ###### ここまで ############ if (-e "$setupfile"){ require "$setupfile"; } my $url_pattern = 'https?:\/\/[\w\.\~\/\?\&\+\=\:\@\%\;\#\$\%\-]*'; my $q = new CGI; my $cgierror = $q->cgi_error; &error($cgierror) if ($cgierror); my %in = $q->Vars; %in = &postprocess(%in); my $now=time; my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = $localtime_en ? localtime($now) : gmtime($now + $offset * 3600); my $date_now = sprintf("%d年%d月%d日%d時%d分",$year+1900,$mon+1,$mday,$hour,$min); my %attendee; if ($in{mode} eq 'admin'){ &admin; } elsif ($in{mode} eq 'write' or $in{mode} eq 'reply'){ &write; } elsif ($in{mode} eq 'delform'){ &delform; } elsif ($in{mode} eq 'modify' or $in{mode} eq 'delete'){ &modify_delete; } elsif ($in{mode} eq 'modform'){ &modform; } elsif ($in{mode} eq 'repform'){ &repform; } elsif ($in{mode} eq 'wradminpwd'){ &wradminpwd; } elsif ($in{mode} eq 'setup'){ &setup; } elsif ($in{mode} eq 'wrsetup'){ &wrsetup; } else { if (! -e "$admindat"){ &admin; } else { &toppage; } } sub toppage { my ($mbname,$pwd) = &getcookie; &htmlhead("$title"); print "$body_insert"; if ($toplink_en == 1){ print "
$toplink_title

\n"; } print "

\n"; print "\n"; &inputform($mbname,'',$pwd); my @data; my $i = 0; my $flag = 0; my $prevpageid; my $latestid = 0; my $nextpageid = 0; my $matchcount = 0; if (open(IN,"< $logfile")) { flock IN, 1; while (){ ($latestid) = split /,/; if ($flag == 0){ push @data, $_; if ($i >= $maxline){ $prevpageid = shift @data; chomp($prevpageid); $prevpageid =~ s/^(\d+),.*$/$1/; } if ($in{id} ne '' and /^$in{id},/){ $flag = 1; $matchcount = $i; } } if ($flag) { if ($i - $matchcount <= $maxline){ $nextpageid = $latestid; } } $i++; } close(IN); } print "\n"; if ($in{id} ne '' and $latestid != $in{id}){ print "

最新から表\示\n"; } print "

\n"; my $id; my $date; my $name; my $main; my $host; my $encpwd; foreach (reverse @data) { chomp; ($id,$date,$name,$main,$host,$encpwd) = split /,/; $main =~ s/^($url_pattern)/$1<\/a>$2/g; $main =~ s/\[(\d+)\]/\[$1<\/a>\]/g; print "[$id] $name> "; print "$main "; my @option; push @option, "返信"; push @option, "変更" if ($modify_en); push @option, "削除" if ($delete_en); my $option = join " ", @option; print "[$option]"; print "($date)"; print "
\n"; } print "
\n"; if ($nextpageid != 0 and $latestid != $in{id}){ print "←更に最近のページを見る\n"; } if ($prevpageid != 0){ print "更に前のページを見る→\n"; } print "\n"; if ($admin_link_en == 1){ print "
$admin_title
"; } &htmltail; } sub copyright{ my $mysite = ('http://www.hidekik.com/','http://www.hidekik.com/en/')[$lang]; print "
omb.cgi Ver. $version
\n"; print "
Copyright(C) 2007-$lastupdateyear, hidekik.com
\n"; } sub write { my $main = $in{main}; my $mbname = $in{mbname}; if ($main ne '' and $mbname ne ''){ if ($ENV{"REQUEST_METHOD"} ne "POST"){ &error("正規の書き込みではありません。"); } my $host = $ENV{'REMOTE_HOST'}; my $addr = $ENV{'REMOTE_ADDR'}; if ($host eq $addr or $host eq '') { $host = gethostbyaddr(pack('C4',split(/\./,$host)),2) || $addr; } $main =~ s/,/&\#44;/g; $mbname =~ s/,/&\#44;/g; &lockfile; open(IN,"+< $logfile") or open(IN, "> $logfile") or &error("データファイルが作成できません。"); flock IN, 2; my $latestid; while (){ ($latestid) = split /,/; } my $id = $latestid + 1; print IN "$id,$date_now,$mbname,$main,$host," . &makecrypt($in{pwd}) . "\n"; close(IN); &unlockfile; &setcookie($mbname,$in{pwd}); } print "Location: $script\n\n"; } sub lockfile { open (LOCK, "> $lockfile") or &error("$lockfileが作成されません。"); flock LOCK, 2; } sub unlockfile { no strict; close LOCK; close TMP if (defined TMP); unlink "tmp.$$" if (-e "tmp.$$"); } sub inputform { my $mbname = shift; my $main = shift; my $pwd = shift; print "名前： \n"; print "パスワード：
\n"; print "内容： \n"; } sub repform { my ($mbname,$pwd) = &getcookie; &htmlhead("返信"); print "

返信

"; print "
\n"; print "\n"; my ($id,$date,$name,$main,$host,$encpwd) = split /,/, &getline($in{id}); print "\n"; print "[$id] $name> "; print "$main "; print "

への返信"; print "

\n"; &inputform($mbname,"[$id]への返信：",$pwd); print "

\n"; &htmltail; } sub getline { my $id = shift; my $line; if (open(DATA,"< $logfile")) { flock DATA, 1; while (){ if (/^$id,/) { $line = $_; last; } } close(DATA); } chomp($line); return $line; } sub modform { $modify_en or print "Location: $script\n\n"; my ($mbname,$pwd) = &getcookie; &htmlhead("変更"); print "

変更

"; print "
\n"; print "\n"; my ($id,$date,$name,$main,$host,$encpwd) = split /,/, &getline($in{id}); print "\n"; print "[$id] $name> "; print "$main "; print "

の変更"; print "

\n"; &inputform($name,$main,$pwd); print "

\n"; &htmltail; } sub modify_delete { ($modify_en or $delete_en) or print "Location: $script\n\n"; my $main = $in{main}; my $mbname = $in{mbname}; if ($main ne '' and $mbname ne '' or $in{mode} eq 'delete'){ if ($ENV{"REQUEST_METHOD"} ne "POST"){ &error("正規の書き込みではありません。"); } my $host = $ENV{'REMOTE_HOST'}; my $addr = $ENV{'REMOTE_ADDR'}; if ($host eq $addr or $host eq '') { $host = gethostbyaddr(pack('C4',split(/\./,$host)),2) || $addr; } $main =~ s/,/&\#44;/g; $mbname =~ s/,/&\#44;/g; &lockfile; open (TMP, "> tmp.$$"); open(IN,"< $logfile"); flock IN, 2; while (){ if (/^$in{id},/){ chomp; my ($org_id,$org_date,$org_name,$org_main,$org_host,$org_encpwd) = split /,/; if (!&checkcrypt($in{pwd},$org_encpwd)){ close(IN); close(TMP); &error("パスワードが違います。"); } if ($in{mode} eq 'modify') { print TMP "$org_id,$org_date,$mbname,$main,$host," . &makecrypt($in{pwd}) . "\n"; } } else { print TMP "$_"; } } close(IN); close(TMP); rename "tmp.$$", "$logfile"; &unlockfile; } print "Location: $script\n\n"; } sub delform { $delete_en or print "Location: $script\n\n"; my ($mbname,$pwd) = &getcookie; &htmlhead("削除"); print "

削除

"; print "
\n"; print "\n"; my ($id,$date,$name,$main,$host,$encpwd) = split /,/, &getline($in{id}); print "\n"; print "[$id] $name> "; print "$main "; print "

の削除"; print "

\n"; print "パスワード：
\n"; print "\n"; print "

\n"; &htmltail; } ###### セットアップフォーム ######################### sub setup { open(ADMIN,"< $admindat"); my $adminpwd = ; close(ADMIN); if (! &checkcrypt($in{pwd},"$adminpwd")){ &error('パスワードが違います。'); } &htmlhead("セットアップ"); print "\n"; my @toplink_en_check; my @modify_check; my @delete_check; my @admin_link_en_check; my @style_sheet_check; my @head_insert_check; my @localtime_check; $toplink_en_check[$toplink_en] = 'checked'; $modify_check[$modify_en] = 'checked'; $delete_check[$delete_en] = 'checked'; $admin_link_en_check[$admin_link_en] = 'checked'; $style_sheet_check[$style_sheet_en] = "checked"; $head_insert_check[$head_insert_en] = "checked"; $localtime_check[$localtime_en] = "checked"; print <
  • ディレクトリの設定は、$scriptから見た相対パス、又は絶対パスで指定してください。バックグランドファイルやロゴファイルはhttp://からのリンクの指定も可能\\です。
  • 管理人パスワードを変更するには、$admindatを削除して、$scriptを実行しなおしてパスワードを再入力してください。
  • これらの設定は$setupfileに保存されます。また、$setupfileをエディタ等で変更してもこの設定ページに反映されます。
  • $admindatと$setupfileのファイル名はこの設定ページでは変更できません。変更したい場合は$scriptの中で変更してください。
  • 管理用リンク表\\示をオフにしてる場合にこのページに入るには、$script?mode=adminからパスワードを入力して入って下さい。
  • 数字やカラー指定は必ず半角で指定してください。全角やブランクだとＣＧＩが起動しなくなります。万一間違って全角で書いてしまった場合は、$setupfileをエディタで開きその場所を半角に正しく修正してください。それで直ります。
データファイル データファイルの名前
ロックファイル ロックファイルの名前
タイトル ブラウザのタイトルバーに表\示される文字列。ページのタイトルは「ページトップ挿入文」で指定してください。
タイトル名
トップへのリンク 有り 無し
リンク名
リンク先
管理用へのリンク 有り 無し
リンク名
バックグランドカラー 表\示
表\示幅 ブラウザ幅の %
フォントカラー 名前
本文
時間
変更機能\ 有効 無効
削除機能\ 有効 無効
クッキー名
1ページに表\示する行数
時間設定 GMTからのオフセット ローカルタイム
GMTからのオフセットに設定した場合、GMTより時間(日本：+9時間)
ページトップ挿入文 HTML書式
<head>内挿入文 有効 無効
HTML書式
ポップアップ広告やJavascript、<META>を挿入したい場合にここに記述する。
以下の記述が<head>〜</head>内に挿入される。
スタイルシート 有効 無効
<style ...></style>は除いて内容だけを記述
 
END &htmltail; } ###### セットアップファイル作成 ######################### sub wrsetup { if (!&checkadmin($in{pwd})){ &error("パスワードが違います。"); } foreach ('body_insert','head_insert','style_sheet'){ $in{$_} =~ s/
/\n/g; $in{$_} =~ s/,/,/g; $in{$_} =~ s/<//g; } open(FILE,"> $setupfile"); print FILE <〜内に挿入できる構文 1:on, 0:off \$head_insert_en = $in{head_insert_en}; \$head_insert = '$in{head_insert}'; #スタイルシート 1:on 0:off \$style_sheet_en = $in{style_sheet_en}; \$style_sheet = '$in{style_sheet}'; #使い方の説明 \$usage = '$in{usage}'; 1; END close(FILE); print "Location: $script\n\n"; } ###### ヘッダー ######################### sub htmlhead { my ($localtitle,$refresh,$interval,$url) = @_; print "Content-Type: text/html\n\n"; print "\n\n"; print "\n"; if ($head_insert_en == 1){ print "$head_insert\n"; } if ($style_sheet_en == 1){ print "\n"; } if ($in{mode} eq 'repform' or $in{mode} eq 'delform' or $in{mode} eq 'modform'){ print "\n"; } print "$localtitle\n"; print "\n"; print "\n"; print "\n"; print "
\n"; } ###### フッター ######################### sub htmltail { ©right; print "
\n"; print "\n"; print "\n"; exit; } ###### 管理人パスワード設定 ######################### sub admin { &htmlhead('$title'); print "
\n"; if (-e "$admindat"){ print "
管理者用パスワードを入力してください。
\n"; print "\n"; print "\n"; print "\n"; } else { print "
管理者用パスワードを設定してください。
\n"; print "\n"; print "\n"; print "\n"; } print "
\n"; &htmltail; } ###### 管理人パスワード登録 ######################### sub wradminpwd { my $passwd = &makecrypt($in{pwd}); if (open(FILE,"> $admindat")){ print FILE "$passwd"; close(FILE); } else { &error('パスワードファイル作成に失敗しました'); } print "Location: $script\n\n"; } ###### デコード ######################### sub postprocess { my (%all) = @_; while (my ($key,$value)=each %all){ $value =~ s//>/g; my $br; if ($key eq 'style_sheet' || $key =~ /insert/){ $br = "
"; } else { $br = ""; } $value =~ s/\r\n/$br/g; $value =~ s/\n/$br/g; $value =~ s/\r/$br/g; $value =~ s/,/&\#44;/g; $all{"$key"}="$value"; } return(%all); } sub getcookie { my $cookies = $q->cookie($cookie_name); my @pairs = split(/,/,$cookies); my %COOKIE; foreach my $pair (@pairs) { my ($name, $value) = split(/:/, $pair); $COOKIE{$name} = $value; } return($COOKIE{mbname},$COOKIE{pwd}); } sub setcookie { my $mbname = shift; my $pwd = shift; my $cook="mbname:$mbname,pwd:$pwd"; my $cookie = $q->cookie(-name => "$cookie_name", -value => "$cook", -expires => "+1y"); $cookie = &cookie_path_fix($cookie); print "Set-Cookie: $cookie\n"; } sub makecrypt { my $plain = shift; my $salt = join "", ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64]; my $result = crypt($plain,$salt) or crypt($plain,'$1$'.$salt.'$'); return $result; } sub checkcrypt { my ($pwd,$encpwd)=@_; return(crypt($pwd,$encpwd) eq "$encpwd" or checkadmin($pwd)); } ###### エラー ######################### sub error { &htmlhead("$_[0]"); print "
$_[0]
\n"; &unlockfile; &htmltail; } sub cookie_path_fix { my $a = shift; $a =~ s/path\s*=\s*[^;]*;//i; return $a; } sub checkadmin { my $pwd = shift; $pwd ||= $in{pwd}; if (open(FILE,"< $admindat")){ my $filepwd = ; close(FILE); my $inpwd = crypt($pwd,$filepwd); return ("$inpwd" eq "$filepwd"); } else { my $message = ('パスワードファイルが存在しません','Cannot find password file.')[$lang]; &error($message); } }