#!/usr/local/bin/perl
# ↑CGIが動かないようでしたらこれを調整してみて下さい。Perl 5.004以上必須です。
BEGIN{
# 「なつみかん」個人設定用CGI「nmp.cgi」
# Copyright (C) 1999-2000 ari All Rights Reserved.
# Copyright (C) 2000 hiya All Rights Reserved.

# 注意！！このSSIを使うときは、必ず下記設定をしてください。
#################################
# ここから設定範囲

####
# 共通設定ファイルの絶対パス
my $headfile		= "/home/hiya/public_html/hina/bin/nm.ph";

# 設定範囲はここまで
#################################
# これ以降はさわらないでください










































# 読み込み
require qq($headfile);
}


## メイン
require 5.004;
use strict;
use lib ("$nm::cf::lib", "$nm::cf::bin", "$nm::cf::base");

# シグナル設定
$SIG{'INT'} = $SIG{'BUS'} = $SIG{'HUP'} = $SIG{'QUIT'} = $SIG{'TERM'} = 'autokill';
if($nm::cf::os eq "unix"){
	alarm(60);
}

use nm::files;
use nm::times;
use LIRS;
use CGI qw(-debug);

# 初期値設定
my $Files = new nm::files;
my $Times = new nm::times;
my $LIRS = new LIRS;

my $q = new CGI;
my $script = $q->url(-relative=>1);
my $state = "not_personalized";
my $now = time;
my $path;
my @cookie;
my $cookie_path = $q->url(-absolute=>1);
$cookie_path =~ s|/[^/]*$||; $path = '/' unless ($path);
my %diaries;
$nm::remote_ref = {};
my $info_ref = {};
my $localTime = ($Times->tz2tzlag($nm::cf::localTimeZone))[1];
my $conv;
my $template;

# IDとパスワードをcookieか入力フォームから取得(入力フォームの方を優先)
my $id = $q->param('id') || $q->cookie(-name=>'nmp_id');
my $crypt;
if($q->param('password')){
	$crypt = crypt($q->param('password'), substr($id, 0, 2));
}elsif($q->cookie(-name=>'nmp_pass')){
	$crypt = $q->cookie(-name=>'nmp_pass');
}
# ID チェック (アルファベットで始まり、数字、アルファベット、「!'()-.;=?@_~」の文字だけであること)
if($id && $id !~ /^[a-zA-Z]/ || $id =~ /^[^!'()\-.\/0-9;=?\@A-Z_a-z~]+$/){
	$id = undef;
}


# IDとPasswordが正しいか判定
if($id && $crypt){
	# IDとPasswordが入力されていた場合
	my $check_id = &check_id($id);
	if($check_id){
		# IDが登録されていた場合
		# IDとPassword判定
		if($check_id eq $crypt){
			# Passwordが正しかった場合
			if(-e "$nm::cf::nmp::nmpdir$id"){
				# ID設定ファイルがあった場合
				$state = 'personalized';

			}else{
				# ID設定ファイルがなかった場合
				$state = 'noid';
				&delete_id($id);
			}
		}else{
			# Passwordが間違えていた場合
			$state = 'illegal_password';
		}
	}else{
		# IDが登録されていなかった場合
		$state = 'noid';

	}

}elsif($id){
	# IDだけ入力されていた場合(Illegal Password)
	$state = 'illegal_password';

}else{
	# IDもPasswordもわからない場合(新規登録モード)
#	$state = 'select';
	$state = 'not_personalized';

}


# モードを確認
if($q->param('method') eq 'select'){
	# 選択モード
	$state = 'select';
	$template = $nm::cf::nmp::template_select;
	@nm::cf::nmp::cfg = @nm::cf::nmp::readcfg;

}elsif($q->param('method') eq 'regist'){
	# 登録モード
	$template = $nm::cf::nmp::template;

	if($state eq 'personalized' || $state eq 'noid'){
		# 登録可能な状態の時
		&add_id($id, $crypt) if($state eq 'noid');

		$state = "regist";

		open(F, ">$nm::cf::nmp::nmpdir$id");
		flock(F, 2);
		foreach($q->param('diaries')){
			print F "$_\012";
			$_ = $Times->showdate(($now - (60 * 60 * 12)), $_) if(/%.+%/);
			$diaries{$_} = 1;
		}
		close(F);
		chmod 0666, "$nm::cf::nmp::nmpdir$id";

		# 登録終了
	}
}else{
	# いずれのモードでもない場合
	$template = $nm::cf::nmp::template;

}


# 投げるcookieの設定
if($state eq 'personalized' || $state eq 'regist' || $state eq 'select'){
	push(@cookie,
		$q->cookie(-name		=> 'nmp_id',
					-value		=> $id,
					-path		=> $cookie_path,
					-expires	=> "+30d"));

	push(@cookie,
		$q->cookie(-name		=> 'nmp_pass',
					-value		=> $crypt,
					-path		=> $cookie_path,
					-expires	=> "+30d"));
}else{
	push(@cookie,
		$q->cookie(-name		=> 'nmp_id',
					-value		=> '',
					-path		=> $cookie_path,
					-expires	=> "now"));

	push(@cookie,
		$q->cookie(-name		=> 'nmp_pass',
					-value		=> '',
					-path		=> $cookie_path,
					-expires	=> "now"));

}


# IDデータファイルの読み込み
if($state eq 'personalized' || $state eq 'select'){
	# IDデータファイルの読み込み
	open(ID, "$nm::cf::nmp::nmpdir$id");
	while(<ID>){
		s/\015\012/\012/g;
		s/\015/\012/g;
		chomp;
		$_ = $Times->showdate(($now - (60 * 60 * 12)), $_) if(/%.+%/ && $state ne 'select');
		$diaries{$_} = 1;
	}
	close(ID);

}


# 漢字コード処理ルーチンの選定
if(eval 'require NKF'){
	$conv = q(NKF);
}else{
	if(eval 'require Jcode'){
		$conv = q(Jcode);
	}else{
		if(eval 'require "jcode.pl"'){
			$conv = q(jcodepl);
		}else{
			$conv = q(error);
		}
	}
}
if($conv eq 'error'){
	print "\012ERROR!: Can't find Kanji code converter.\012";
	exit(1);
}

# cfgファイル(定義ファイル)の読み込み
my @cfgdat = $Files->read_file("$nm::cf::bin$nm::cf::nmp::rem", $nm::cf::os);
for(@cfgdat){
	$_ = &eucconv($_);
	unless(/^#/){
		if(/^REMOTE.*/){
			chomp;
			s/\\/%5c/g;
			s/%5c%5c/%rr/g;
			s/%5c,/%2c/g;
			s/%rr/\\\\/g;
			s/%5c/\\/g;
			my ($nul, $m_name, $name, $url, $filename, $get_url, $lag, $nul) = split(",", $_, 8);
			$url =~ s/%7e/~/io;

			$m_name =~ s/%2c/,/ig;
			$name =~ s/%2c/,/ig;
			$url =~ s/%2c/,/ig;
			$filename =~ s/%2c/,/ig;
			$get_url =~ s/%2c/,/ig;

			$nm::remote_ref->{$get_url}->{'LASTMOD'} = 0;
			$nm::remote_ref->{$get_url}->{'M_NAME'} = $m_name;
			$nm::remote_ref->{$get_url}->{'NAME'} = $name;
			$nm::remote_ref->{$get_url}->{'URL'} = $url;
			$nm::remote_ref->{$get_url}->{'FILE'} = $filename;
			$nm::remote_ref->{$get_url}->{'GET_URL'} = $get_url;
			$nm::remote_ref->{$get_url}->{'LAG'} = $lag;
		}
	}
}


# 出力開始
if(@cookie){
	print $q->header(-type => 'text/html; charset="euc-jp"', -cookie => \@cookie);
}else{
	print $q->header('text/html; charset="euc-jp"');
}


# 出力
open(BASE, "$nm::cf::nmp::basefile");
while(my $qr = <BASE>){
	$qr =~ s/\015\012/\012/g;
	$qr =~ s/\015/\012/g;

	if($qr =~ /^<!--NATSUMICAN_P_OUTPUT-->(\015|\012)*$/){
		if($state !~ /(not_personalized|illegal_password|noid)/i){
			foreach my $cfile (@nm::cf::nmp::cfg){
				open(SRC, "$nm::cf::bin$cfile");
				while(<SRC>){
					$_ = &eucconv($_);
					unless(/^#/){
						if(/^LIRS.*/){
							my $output = &lirs2html($_);
							print $output;
						}
					}
				}
				close(SRC);
			}
		}
		$qr = undef;

	}elsif($qr =~ /^<!--NATSUMICAN_P_SORT_OUTPUT-->(\015|\012)*$/){
		if($state !~ /(not_personalized|illegal_password|noid)/i){
			foreach my $cfile (@nm::cf::nmp::cfg){
				open(SRC, "$nm::cf::bin$cfile");
				while(<SRC>){
					$_ = &eucconv($_);
					unless(/^#/){
						if(/^LIRS.*/){
							my ($time, $lmd, $lag, $length, $url, $title, $author, $remote, $optional) = $LIRS->tolist($_);
							$optional =~ s/\\,/%2c/g;
							my ($vurl, $key, $option, $etc, $refer) = split(",", $optional);
							$vurl =~ s/%2c/\,/ig;
							$key =~ s/%2c/\,/ig;
							$option =~ s/%2c/\,/ig;
							$etc =~ s/%2c/\,/ig;

							if($url){
								$info_ref->{$url}->{'LASTMOD'} = $time;
								$info_ref->{$url}->{'LMD'} = $lmd;
								$info_ref->{$url}->{'LAG'} = $lag;
								$info_ref->{$url}->{'LENGTH'} = $length;
								$info_ref->{$url}->{'TITLE'} = $title;
								$info_ref->{$url}->{'AUTHOR'} = $author;
								$info_ref->{$url}->{'REMOTE'} = $remote;
								$info_ref->{$url}->{'VURL'} = $vurl;
								$info_ref->{$url}->{'KEY'} = $key;
								$info_ref->{$url}->{'OPTION'} = $option;
								$info_ref->{$url}->{'ETC'} = $etc;
								$info_ref->{$url}->{'REFER'} = $refer;
							}
						}
					}
				}
				close(SRC);
			}

			foreach my $i (sort{$info_ref->{$b}->{'LASTMOD'} <=> $info_ref->{$a}->{'LASTMOD'}} keys %$info_ref){
				my ($time, $lmd, $lag, $length, $url, $title, $author, $optional, $remote, $vurl, $key, $option, $etc, $refer);
				$time = $info_ref->{$i}->{'LASTMOD'};
				$lmd = $info_ref->{$i}->{'LMD'};
				$lag = $info_ref->{$i}->{'LAG'};
				$length = $info_ref->{$i}->{'LENGTH'};
				$title = $info_ref->{$i}->{'TITLE'};
				$author = $info_ref->{$i}->{'AUTHOR'};
				$remote = $info_ref->{$i}->{'REMOTE'};
				$vurl = $info_ref->{$i}->{'VURL'};
				$key = $info_ref->{$i}->{'KEY'};
				$option = $info_ref->{$i}->{'OPTION'};
				$etc = $info_ref->{$i}->{'ETC'};
				$refer = $info_ref->{$i}->{'REFER'};

				my $s = "$vurl,$key,$option,$etc,$refer";
				my $r = $LIRS->toLIRS($time, $lmd, $lag, $length, $i, $title, $author, $remote, $s);

				my $output = &lirs2html($r);
				print $output;
			}
			$info_ref ={};
		}
		$qr = undef;

	}elsif($qr =~ /<!--NATSUMICAN_P_STARTFORM-->/){
		my $ret;
		if($state =~ /^select/){
			$ret = $q->startform(-method		=> "post",
									-action		=> $script,
									-enctype	=> "multipart/form-data");
			$ret .= "ID:".$q->textfield(-name		=>'id',
											-default	=>"$id",
											-override	=>1);
			$ret .= $q->hidden(-name		=>'method',
								-value		=>['regist'],
								-override	=>1);
			$ret .= "　Password:".$q->password_field(-name=>'password');
		}
		$qr =~ s/<!--NATSUMICAN_P_STARTFORM-->/$ret/g;

	}elsif($qr =~ /<!--NATSUMICAN_P_ENDFORM-->/){
		my $ret;
		if($state =~ /^select/){
			$ret = $q->submit(-value=>"登録")."　".$q->reset(-value=>"取消").$q->endform;

		}else{
			$ret = $q->startform(-method		=>"post",
									-action		=>$script,
									-enctype	=>"multipart/form-data");
			$ret .= "ID:".$q->textfield(-name		=>'id',
										-default	=>"$id",
										-override	=>1);
			$ret .= "　Password:".$q->password_field(-name=>'password');
			$ret .= "　".$q->submit("", "表示");
			$ret .= $q->endform;
		}
		$qr =~ s/<!--NATSUMICAN_P_ENDFORM-->/$ret/g;
	}

	$qr =~ s/<!--NATSUMICAN_P_INTRODUCTION-->/eval("\"$nm::cf::nmp::introduction{$state}\";")/ge;

	print $qr;
	$qr = undef;
}
close(BASE);

exit(0);




















































## サブルーチン群

sub lirs2html{
	my $lirs = shift;
	my ($time, $lmd, $lag, $length, $url, $title, $author, $remsrc, $optional) = $LIRS->tolist($lirs);

	$optional =~ s/\\,/%2c/g;
	my ($vurl, $key, $option, $etc, $refer) = split(",", $optional);
	$vurl =~ s/%2c/\,/ig;
	$key =~ s/%2c/\,/ig;
	$option =~ s/%2c/\,/ig;
	$etc =~ s/%2c/\,/ig;

#	if($url && ($state ne "personalized" || defined($diaries{$url}))){
#	if($url && ($q->param('method') eq 'select' || defined($diaries{$url}))){
	if($url && ( $state eq 'select' || !defined($diaries{$url}) )){
		my ($remote, $outdat);

		if($refer eq "HEAD"){
			$remote = "H";
		}elsif($refer eq "GET"){
			$remote = "G";
		}elsif($refer eq "FILE"){
			$remote = "F";
		}elsif($refer eq "CACHE"){
			$remote = "C";
		}elsif($refer eq "LENGTH"){
			$remote = "L";
		}elsif($refer eq "PUSH"){
			$remote = "P";
		}else{
			foreach my $v (keys %$nm::remote_ref){
				if($nm::remote_ref->{$v}->{'URL'} eq $refer){
					$remote = $nm::remote_ref->{$v}->{'M_NAME'};
					last;
				}
			}
			if($remote eq ""){
				$remote = "0";
			}
		}
		$remsrc = "" if($remsrc eq "0");

		if($time <= 0){
			$outdat = $Times->showdate("null", "$template");
			$option = "";
		}else{
			my $lags = ($Times->tz2tzlag($lag))[1];
			$outdat = $Times->showdate(($time + $lags), "$template");
		}
		my $timezone = ($Times->tz2tzlag($lag))[0];
		$title = "TITLE UNKNOWN" if($title eq "0");
#		$title = undef if($title eq "0");
#		$author = "unknown" if($author eq "0");
		$author = undef if($author eq "0");

		$outdat =~ s/%title%/$title/g;
		if($vurl){
			$outdat =~ s/%vurl%/$vurl/g;
		}else{
			$outdat =~ s/%vurl%/$url/g;
		}
#		$outdat =~ s/%url%/$url$option/g;
		$outdat =~ s/%url%/$url/g;
		$outdat =~ s/%option%/$option/g;
		$outdat =~ s/%author%/$author/g;
		$outdat =~ s/%etc%/&nm::cf::html::etcscript("$etc")/eg;
		$outdat =~ s/%remote%/$remote/g;
		$outdat =~ s/%remsrc%/$remsrc/g;
		$outdat =~ s/%tz%/$timezone/g;
		$outdat =~ s/%checkbox%/$q->checkbox('diaries', defined($diaries{$url}), $url, "")/ge;

		$outdat =~ s/\\,/,/g;
		$outdat =~ s/\\n/\012/g;
		$outdat =~ s/\\t/\t/g;

		return $outdat;
	}
	return undef;
}


sub eucconv{
	my $str = shift;

	if($conv eq 'NKF'){
		$str = &NKF::nkf('-e', $str);

	}elsif($conv eq 'Jcode'){
		$str = Jcode->new($str)->h2z->euc;

	}elsif($conv eq 'jcodepl'){
		&jcode::convert(\$str, 'euc');
	}

	$str;
}


sub check_id($) {
	my $id = shift;
	my $ret;

	if(open(PASS, "$nm::cf::nmp::passwdfile")){
		flock(PASS, 2) if($nm::cf::os eq "unix");
		while(<PASS>){
			chomp;
			if(/^$id:/){
				$ret = $';
				last;
			}
		}
		flock(PASS, 8) if($nm::cf::os eq "unix");
		close(PASS);

		return $ret;
	}
	return undef;
}


sub add_id($$) {
	my ($id, $crypt) = @_;

	if(open(PASS, ">>$nm::cf::nmp::passwdfile")){
		flock(PASS, 2) if($nm::cf::os eq "unix");
		binmode PASS;
		print PASS "$id:$crypt\012";
		flock(PASS, 8) if($nm::cf::os eq "unix");
		close(PASS);

		chmod 0666, $nm::cf::nmp::passwdfile;
		return 1;
	}
	return undef;
}


sub delete_id($) {
	my $id = shift;
	my $output;

	if(open(PASS, "$nm::cf::nmp::passwdfile")){
		flock(PASS, 2) if($nm::cf::os eq "unix");
		while(<PASS>){
			if($_ !~ /^$id:/){
				$output .= $_;
			}
		}
		close(PASS);

		open(PASS, ">$nm::cf::nmp::passwdfile");
		flock(PASS, 2) if($nm::cf::os eq "unix");
		binmode PASS;
		print PASS $output;
		close(PASS);

		chmod 0666, $nm::cf::nmp::passwdfile;
		return 1;
	}
	return undef;
}


##
# 自爆サブルーチン
sub autokill{
	print STDERR "$!\n";
	exit(0);
}


1;