# Ir-i-BBS   -  subroutine module
# -------------------------------
#   Copyright (c) 1999 by Irao Computer System, All rights reserved.
#

sub make_unique_key {
    my @saltset = ('a' .. 'z', 'A' .. 'Z', '0' .. '9');
    my $ssize = $#saltset + 1;
    my $now = time;
    my ($p1, $p2) = unpack("C2", $now);
    my $seed = $now ^ ($$ + ($$ << 15));
    my $work = int($now / (60 * 60 * 24 * 7)) + $p1 + $p2 - 8 + $seed;
    my $nsalt = $saltset[$work % $ssize] . $saltset[$seed % $ssize];
    $nsalt .= (($work ^ $$) % 1000 + ($seed % 100));
    my $unique = 0;
    while($now > 0) {
      $unique = (($unique << 8) + ($now % 10)) % 931193;
      $now = int($now / 10);
    }
    $nsalt .= $unique;
    return ($nsalt);
}

sub make_random_pass {
    if ($terminal eq "imode"){
        $ret = 'im';
    } else {
        $ret = 'js';
    }
    my @saltset = ('0' .. '9');
    my $ssize = $#saltset + 1;
    my $now = time;
    my ($p1, $p2) = unpack("C2", $now);
    my $seed = time ^ ($$ + ($$ << 15));
    my $work = int($now / (60*60*24*7)) + $p1 + $p2 - 8 + $seed;
    $ret .= $saltset[$work % $ssize] . $saltset[$seed % $ssize];
    return ($ret);
}

sub certify_pass {
	my $input = shift;
	my $pass = shift;
	my $ismd5 = ($pass =~ /^\$1\$/)? 3 : 0;
	my $crypt = crypt($input, substr($pass, $ismd5, 2));
	$crypt = crypt($input, substr($pass, 0, 5)) 
		if ($ismd5 and $crypt !~ /^\$1\$/);
	$crypt = $input if ($crypt eq '');
	return $crypt;
}

sub get_des_salt {
	my @saltSet = ('a'..'z', 'A'..'Z', '0'..'9', '.', '/');
	my $sSize = $#saltSet + 1;
	my $now = time;
	my ($p1, $p2) = unpack("C2", $now);
	my $seed = time ^ ($$ + ($$ << 15));
	my $work = int($now / (60 * 60 * 24 * 7)) + $p1 + $p2 - 8 + $seed;
	my $nsalt = $saltSet[$work % $sSize] . $saltSet[$seed % $sSize];
	return $nsalt;
}

sub encode_pass {
	my $pass = shift;
	my $mslt = '$1$';
	my $dslt = &get_des_salt();
	my $md5 = crypt $pass, "$mslt$dslt";
	if ($md5 =~ /^\$1\$/) {
		my $chk = crypt($pass, substr($md5, 0, 5));
		return $md5 if ($md5 ne '' and $md5 eq $chk);
	}
	my $des = crypt $pass, $dslt;
	my $chk = crypt($pass, substr($des, 0, 2));
	return $des if ($des ne '' and $des eq $chk);
	return $pass;
}

=cut
sub encode_pass {
    my ($arg) = @_;
    my @saltset = ('a'..'z','A'..'Z','0'..'9','.','/');
    my $ssize = $#saltset + 1;
    my $now = time;
    my ($p1, $p2) = unpack("C2", $now);
    my $seed = time ^ ($$ + ($$ << 15));
    my $work = int($now / (60*60*24*7)) + $p1 + $p2 - 8 + $seed;
    my $nsalt = $saltset[$work % $ssize] . $saltset[$seed % $ssize];
    return(crypt($arg, $nsalt));
}
=cut

sub get_gmt {
    my ($inc) = @_;
    $ENV{'TZ'} = "GMT";
    my ($secg,$ming,$hourg,$mdayg,$mong,$yearg,$wdayg,$ydayg,$isdstg) =
                                            gmtime(time + $inc);

    $wdayg = ("Sunday", "Monday", "Tuesday", "Wednesday",
                        "Thursday", "Friday", "Saturday")[$wdayg];
    $mong = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul",
                        "Aug", "Sep", "Oct", "Nov", "Dec")[$mong];
    $yearg += 1900 if ($yearg < 1900);
    my $dateg = sprintf("%s, %02d\-%s\-%04d %02d:%02d:%02d GMT",
                $wdayg, $mdayg, $mong, $yearg, $hourg, $ming, $secg);
    return ($dateg);
}

sub get_date_cookie {
    return &get_gmt(30*24*60*60);
}

sub get_date {
    $ENV{'TZ'} = "JST-9";
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);

    $mon++;
    $wday = ('日','月','火','水','木','金','土')[$wday];
    $year += 1900 if ($year < 1900);

    my $date = sprintf("%04d<y>%02d<mo>%02d<d>%s<w>%02d<h>%02d<mi>",
                            $year, $mon, $mday, $wday, $hour, $min);
    return ($date);
}

sub get_query {
    my ($buffer, @pairs, $pair);

    if ($ENV{'REQUEST_METHOD'} eq "POST") {
        read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
    } else {
        $buffer = $ENV{'QUERY_STRING'};
    }
    my ($terminal, $sv) = ("pc", '');
    my ($kanji_convert, $kcode);

    $terminal = &check_imode();
	$subtype = $terminal;
    $terminal = 'imode' if ($terminal eq 'astel');
    $terminal = 'imode' if ($terminal eq 'paldio');
    $buffer =~ /sv=(\w{2})/o;
    ($sv = $1) =~ tr/A-Z/a-z/d;
    $sv =~ tr/a-z//cd;
    
    $terminal = 'imode' if ($sv eq "im");
    $terminal = 'ez' if ($sv eq "ez");
    $terminal = 'jsky' if ($sv eq "js");
    
    if ($buffer =~ /kan=([^&]+)/o) {
        my ($kanji);
        $kanji = $1;
        $kanji =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/ego;
        $kcode = &jcode::getcode(\$kanji);
        if (($kcode eq "jis") || ($kcode eq "euc")) {
            $kanji_convert = "jcode::${kcode}2sjis";
        }
    }
    if ($buffer =~ /(?:^|&)act(?:%3A|%3a|:)([^=&]+)/) {
        $submit{'act'} = $1;
    } elsif ($buffer =~ /(?:^|&)pos(?:%3A|%3a|:)(\d+)/) {
        $submit{'pos'} = $1;
    }
    @pairs = split(/[;&]/o, $buffer);
    undef @remove_queue;
    foreach $pair (@pairs) {
        my ($name, $value) = split(/=/, $pair, 2);
        $value =~ tr/+/ /;
        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/ego;
        
        if ($terminal eq "pc") {
            if ($kanji_convert) {
                &$kanji_convert(\$value);
            } else {
                if ($kcode eq "sjis") {
                    &jcode::h2z_sjis(\$value);
                } else {
                    &jcode::convert(\$value, 'sjis');
                }
            }
        } else {
            &jcode::h2z_sjis(\$value);
        }
        unless ($name =~ /(head_lines|long|compact|eztop)/o) {
            $value =~ s/<br>/\n/gi;
            $value =~ s/</&lt;/g;
            $value =~ s/>/&gt;/g;
            $value =~ tr/\t//d;
            $value =~ s/\r\n/\n/g;
            $value =~ s/\r/\n/g;
            if ($name eq "remove") {
                push @remove_queue, $value;
                next;
            }
        }
        $FORM{$name} = $value;
    }
    $FORM{'action'} = $FORM{'a'}
        if (exists $FORM{'a'} and not exists $FORM{'action'});
    if ($submit{'act'} ne "") {
        $FORM{'action'} = $submit{'act'};
    }
    if ($submit{'pos'} ne "") {
        $FORM{'start'} = $submit{'pos'};
    }
    return ($terminal);
}

sub url_encode {
    local($line) = @_;

    $line =~ s/(\W)/sprintf("%%%02X",ord($1))/eg;
    $line =~ tr/ /+/;
    return($line);
}

sub unescape {
    local ($_) = @_;
    tr/+/ /;
    s/%([0-9a-fA-F]{2})/chr(hex($1))/ge;
    return($_);
}

sub zen_to_han {
    local($_) = @_;

# jcode.pl の tr は遅いので変換テーブルを用いる

    %CONV =("，" => ",", "．" => ".", "：" => ":", "；" => ";", "？" => "?",
            "！" => "!", "｀" => "`", "＾" => "^", "＿" => "_",
            "\x81\\x5e" => "/", "｜" => "|", "’" => "'", "”" => '"',
            "（" => "(", "）" => ")", "［" => "[", "］" => "]",
            "｛" => "{", "｝" => "}", "\x81\\x7b" => "+",
            "\x81\\x7c" => "-", "＜" => "<",
            "＞" => ">", "￥" => "\\", "＝" => "=", "＄" => "\$", "％" => "\%",
            "＃" => "#", "＆" => "&", "＊" => "*",  "＠" => "\@", "０" => "0",
            "１" => "1", "２" => "2", "３" => "3", "４" => "4", "５" => "5",
            "６" => "6", "７" => "7", "８" => "8", "９" => "9", "Ａ" => "A",
            "Ｂ" => "B", "Ｃ" => "C", "Ｄ" => "D", "Ｅ" => "E", "Ｆ" => "F",
            "Ｇ" => "G", "Ｈ" => "H", "Ｉ" => "I", "Ｊ" => "J", "Ｋ" => "K",
            "Ｌ" => "L", "Ｍ" => "M", "Ｎ" => "N", "Ｏ" => "O", "Ｐ" => "P",
            "Ｑ" => "Q", "Ｒ" => "R", "Ｓ" => "S", "Ｔ" => "T", "Ｕ" => "U",
            "Ｖ" => "V", "Ｗ" => "W", "Ｘ" => "X", "Ｙ" => "Y", "Ｚ" => "Z",
            "ａ" => "a", "ｂ" => "b", "ｃ" => "c", "ｄ" => "d", "ｅ" => "e",
            "ｆ" => "f", "ｇ" => "g", "ｈ" => "h", "ｉ" => "i", "ｊ" => "j",
            "ｋ" => "k", "ｌ" => "l", "ｍ" => "m", "ｎ" => "n", "ｏ" => "o",
            "ｐ" => "p", "ｑ" => "q", "ｒ" => "r", "ｓ" => "s", "ｔ" => "t",
            "ｕ" => "u", "ｖ" => "v", "ｗ" => "w", "ｘ" => "x", "ｙ" => "y",
            "ｚ" => "z", "\x81\\x40" => " "
    );

    while (($before, $after) = each %CONV) {
        s/$before/$after/g;
    }
    return ($_);
}


sub subst_secure {
    my $adat = $COOKIE{'authorize'};
    my $aval = "authorize=$adat";
    if ($terminal eq "ez") {
        $buffer =~ s/(<(ACTION|CE)[^>]+DEST=")\?([^"]+)"/$1\?$aval\&$3"/gio;
        $buffer =~ s/(<ACTION[^>]+POSTDATA=")([^"]+)"/$1$aval\&$2"/gio;
        return;
    }
    $authen = '<input type="hidden" name="authorize" value="' . $adat . '">';
    if ($buffer !~ /(name=|name="?action"?\s+value=)"?authorize"?/igo) {
        $buffer =~ s|</form>|$authen</form>|gio;
    }

    $buffer =~ s/(<a[^>]+href="$bbs_local)\?([^"]+")/$1\?$aval\&$2/ig;
    $buffer =~ s/(<a[^>]+href="$bbs_local)\??"/$1\?$aval"/ig;
    $footer =~ s/(<a[^>]+href="$bbs_local)\?([^"]+")/$1\?$aval\&$2/ig;
    $footer =~ s/(<a[^>]+href="$bbs_local)\??"/$1\?$aval"/ig;

}

sub get_cookie {
    my (%temp, $cookies, @pairs, $pair, $name, $value);
    %COOKIE = ();
    $cookies = $ENV{'HTTP_COOKIE'};

    @pairs = split(/;/o, $cookies);
    foreach $pair (@pairs) {
        ($name, $value) = split(/=/o, $pair);
        $name =~ tr/ //d;
        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/ego
            unless ($name eq $bbs_id);
        $temp{$name} = $value;
        $COOKIE{'authorize'} = $value if ($name eq "Authorize");
		$COOKIE{'EzLAx'} = $value if ($name eq 'EzLAx');
    }

    @pairs = split(/[,+]/o, $temp{$bbs_id});
    foreach $pair (@pairs) {
        ($name, $value) = split(/:/o, $pair, 2);
        $value = &unescape($value) if ($name =~ /(name|email|webpage)/o);
        $COOKIE{$name} = $value;
    }
}

sub is_check_referer {
	return 0 unless ($referer_check);
	return 1 if ($terminal eq 'ez' and $send_referer_ez);
	return 1 if ($subtype eq 'astel' and $check_astel_referer);
	return 1 if ($subtype eq 'paldio' and $check_paldio_referer);
	if ($terminal eq 'pc') {
		if (&check_pocket_ie()) {
			return 1 unless ($no_check_pocket_ie);
		} else {
			return 1;
		}
	}
	return 0;
}

sub check_pocket_ie {
	my $httpUA = $ENV{'HTTP_USER_AGENT'};
	if ($httpUA =~ /MS(P?IE) (\d)\.[\d.]+/ and $httpUA =~ /Windows CE/) {
		my $type = $1;
		my $majv = $2;
		return 0 if ($majv == 3 and $type ne 'IE');
		return 0 if ($majv <= 2 and $type ne 'PIE');
		my $color = $ENV{'HTTP_UA_COLOR'};
		my $cpu = $ENV{'HTTP_UA_CPU'};
		my $os = $ENV{'HTTP_UA_OS'};
		my $pixel = $ENV{'HTTP_UA_PIXELS'};
		return 0 if ($majv > 1 and not ($color and $cpu and $os and $pixel));
		return 0 if ($os and not ($os =~ /Windows CE/));
		return 0 if (exists $ENV{'HTTP_REFERER'});
		return 1;
	}
	return 0;
}

sub is_imode {
    my ($huag, $hxjn) = @_;
    my ($isim);
    $isim = 'pc';
    $isim = 'imode' if ($huag =~ m|DoCoMo/[\d.]+/[A-Za-z]+\d{3}i|o);
    $isim = 'paldio' if ($huag =~ m|DoCoMo/[\d.]+/\d{3}S|o);
    $isim = 'astel' if ($huag =~ m|ASTEL/[\d.]+/[A-Za-z]+-\d{3}|o);
    $isim = 'ez' if ($huag =~ m|UP\.Browser/[\d.]+|o);
    $isim = 'jsky'
      if (($hxjn) || ($huag =~ m|J-PHONE/[\d.]+/J-[A-Za-z]+[0-9]+|o));

#   $isim = 'pdx' if ($huag =~ m|PDXGW/[\d.]+|o);
#   $isim = 'pda' if ($huag =~ /sharp pda browser/o);
#   $isim = 'pda' if ($huag =~ /Dialo/o);

    return ($isim);
}

sub check_imode {
    $real_term = &is_imode($ENV{'HTTP_USER_AGENT'},
                            $ENV{'HTTP_X_JPHONE_MSNAME'});
    return ($real_term);
}

sub get_delete_key_pass {
    my ($line) = @_;
    chomp $line;
    my ($subject, $name, $mail, $web, $message, $date, $host,
                $addr, $agent, $pass, $num) = split(/\t/o, $line);
    return ($num, $pass);
}

sub conv_date {
    my ($date) = @_;
    $date =~ s/<d>(.*)<w>/<d>\($1\) /o;
    $date =~ s/<wd>//o;
    $date =~ s/(\d+)<y>(\d+)<mo>(\d+)<d>/$1年$2月$3日/o;
    $date =~ s/(\d+)<h>(\d+)<mi>/$1時$2分/o;
    return ($date);
}

sub conv_date_imode {
    my ($date) = @_;
    $date =~ s/<d>.*<w>/<d>/o;
    $date =~ s/<wd>//o;
    $date =~ s/(\d+)<y>(\d+)<mo>(\d+)<d>/$2\/$3 /o;
    $date =~ s/(\d+)<h>(\d+)<mi>/$1:$2/o;
    return ($date);
}

sub save_log_file {
    my (@new);
    &file_lock("$bbs_log_file");
    if (-e $bbs_log_file) {
        open (FHI, "$bbs_log_file")
            || &error("ログファイルが開けません", $bbs_log_file);
        @new = <FHI>;
        close(FHI);
    }
    unshift @new, @_;
    open (FHO, "> $bbs_log_file")
        || &error("ログファイルが開けません", $bbs_log_file);
    print FHO @new;
    close(FHO);
    &file_unlock("$bbs_log_file");
}

sub file_lock {
    my ($file) = @_;
    my ($lock) = $file . ".lock";
    my ($del_sec) = 30;
    my ($lock_timeout) = $del_sec / (60 * 60 * 24);
    my ($retry) = 30;
    my ($can_symlink) = (eval { symlink("",""); }, $@ eq "");
    my ($error_message) = <<"EOERMSGFL";
ただいま混雑しています<BR>
戻ってもう一度お試しください<BR>
(ファイルのロックに失敗しました; $lock)
EOERMSGFL

    if((-M "$lock") > $lock_timeout) {
        unlink $lock;
    }

    if($can_symlink) {
        while (not symlink $file, $lock){
            if (--$retry <= 0){
                &error($error_message);
            }
            sleep 2;
        }
    } else {
        $count = 0;
        while(-f "$lock") {
            $count++;
            if ($count >= $retry) {
                &error($error_message);
            }
            sleep 2;
        }
        open(LOCK,">$lock");
        close(LOCK);
    }
    return;
}

sub file_unlock {
    my ($file) = @_;
    my ($lock) = $file . ".lock";

    unlink $lock || &error("ロックの解除ができません, $lock");
    return;
}

sub combine_data {
    my ($ml) = "";
    unless ($mail =~ /^\s*$/o) {
        $ml = $mail;
    }
    unless ($web =~ /^\s*$/o) {
        $ml .= ", " if ($ml);
        $ml .= $web;
    }

    $ml = "" if ($ml =~ /^\(\s*\)$/o);
    my ($im);
    $im = "i-mode" if ($terminal eq "imode");
    $im = "PC" if ($terminal eq "pc");
    $im = "ezWeb" if ($terminal eq "ez");
    $im = "J-Sky" if ($terminal eq "jsky");
    my $dat = <<"EODCMBD";
投稿者:$name($im)
メール:$ml
題名:$subject
本文:$message
EODCMBD
    return ($dat);
}
=cut
sub purse_mask {
    my ($masks) = @_;
    my (@list, $ip, $mask, @aip);
    while ($masks =~ s/^\s*(\([^@\)]+\)|[\d.]+)(\@([\d.]+))?\s*//o) {
        $ip = $1;
        $mask = ($3)? $3 : '255.255.255.255';
        if ($ip =~ /^\(([\s\d.]+)\)/o) {
            @aip = split (/\s/o, $1);
            foreach (@aip) {
                push @list, "$_ $mask";
            }
        } else {
            push @list, "$ip $mask";
        }
    }
    return (@list);
}
=cut

sub parseIpList {
	my $list = shift;
	my ($ipst, $ipen, $mask);
	if ($list =~ /^(\d+\.\d+\.\d+\.\d+\.?|\d+)(-
					(\d+\.\d+\.\d+\.\d+\.?|\d+))?(\@
					(\d+\.\d+\.\d+\.\d+\.?|\d+))?$/x) {
		$ipst = $1;
		$ipst = unpack('N', pack('C4', split(/\./, $ipst)))
			unless ($ipst =~ /^\d+$/);
		$ipen = ($3)? $3 : undef;
		$mask = ($5)? $5 : undef;
		if (defined $ipen) {
			$ipen = unpack('N', pack('C4', split(/\./, $ipen)))
				unless ($ipen =~ /^\d+$/);
		}
		if (defined $mask) {
			$mask = unpack('N', pack('C4', split(/\./, $mask)))
				unless ($mask =~ /^\d+$/);
		}
	} else {
		$ipst = $list;
		$ipen = undef;
		$mask = undef;
	}
	return ($ipst, $ipen, $mask);
}

sub expandMasks {
	my $formula = shift;
	my $mask = shift;
	my @list = split /\s+/, $formula;
	return join(" " => map { "$_\@$mask"; } @list);
}

sub isHostListed {
	my $list = shift;
	my $host = $ENV{'REMOTE_HOST'};
	my $addr = $ENV{'REMOTE_ADDR'};
	$host = gethostbyaddr(pack('C4', split(/\./, $addr)), 2) or $addr
		if (not $host or $host eq $addr);
	$ipv4 = unpack('N', pack('C4', split(/\./, $addr)));
	$list =~ s/\(((?:\d+\.){3}\d+(?:-(?:\d+\.){3}\d+)?(?:\s+(?:\d+\.){3}\d+(?:-(?:\d+\.){3}\d+)?)*)\)\@((?:\d+\.){3}\d+)/&expandMasks($1, $2);/ego;
	foreach (split /\s+/, $list) {
		next if (/^\s*$/);
		($ipst, $ipen, $mask) = &parseIpList($_);
		next unless (defined $ipst);
		if ($ipst =~ /^\d+$/) {
			if (defined $mask) {
				$ipst &= $mask;
				$ipen &= $mask if (defined $ipen);
				$ipv4 &= $mask;
			}
			if (defined $ipen) {
				return 1 if ($ipst <= $ipv4 and $ipv4 <= $ipen);
			} else {
				return 1 if ($ipst == $ipv4);
			}
		} else {
			if ($ipst =~ /^~(.*)$/) {
				$ipst = $1;
				next if ($ipst =~ /^\s*$/);
			} else {
				if ($ipst =~ tr/*?/*?/ > 0) {
					$ipst = quotemeta($ipst);
					$ipst =~ s/\\([*?])/\.$1/g;
				} else {
					$ipst = quotemeta($ipst);
				}
			}
			return 1 if ($host =~ /$ipst/);
		}
	}
	return 0;
}

=cut
sub check_host {
    my ($radr, @list) = @_;
    my ($ra, $ip, $mask, $ia, $nm);
    $ra = pack('C4', split(/\./o, $radr));
    foreach (@list) {
        next if (/^\s*$/o);
        ($ip, $mask) = split;
        next if ($ip =~ /^\d+\.\d+\.\d+\.\d+\.?$/o);
        next if ($mask =~ /^\d+\.\d+\.\d+\.\d+\.?$/o);
        $ia = pack('C4', split(/\./o, $ip));
        $nm = pack('C4', split(/\./o, $mask));
        $ia &= $nm;
        $ra &= $nm;
        return 0 if ($ia eq $ra);
    }
    return 1;
}
=cut
=cut
sub can_send {
    my ($name, $mail) = @_;
    my ($host) = $ENV{'REMOTE_ADDR'};
    
    return 0 unless ($email_send);
    unless ($except_names =~ /^\s*$/o) {
        foreach $n (split(/[,;\s]/o, $except_names)) {
            return 0 if ($n eq $name);
        }
    }
    unless ($except_adrs =~ /^\s*$/o) {
        foreach $n (split(/[,;\s]/o, $except_adrs)) {
            return 0 if ($n eq $mail);
        }
    }
    if ($except_ip_list) {
        return &check_host($host, &purse_mask($except_ip_list));
    }
    if ($interval_send) {
        return 0 if (time - $last_send < $interval_send * 60);
    }
    
    return 1;
}

sub send_mail {
    ($_, $mode) = @_;
    $email_subj .= '[' . ((defined $mode)? "修正" : "新規") . ']';
    open MOH, "| $sendmail $email_to" || return;
    print MOH "To: $email_to\n";
    print MOH "From: $email_from\n";
    &jcode::sjis2jis(\$email_subj);
    print MOH "Subject: $email_subj\n";
    print MOH "X-Mailer: Ir-i-BBS Mailer $version\n";
    print MOH "Content-Transfer-Encoding: 7bit\n";
    print MOH 'Content-Type: text/plain; charset=iso-2022-jp' . "\n\n";
    $term_pseudo = 'notag';
    $_ = &conv_imchr($_);
    $_ = &conv_jschr($_);
    $term_pseudo = '';
    s/<br>/\n/gio;
    s/&lt;/</go;
    s/&gt;/>/go;
    s/&quot;/\"/go;
    s/&amp;/\&/go;
    s/[ \t]+/ /go;
    s/\n /\n/go;
    s/ \n/\n/go;
    s/\n+/\n/go;
    s/^\s+//o;
    s/\s+$//o;
    &jcode::sjis2jis(\$_, "jis");
    print MOH "$_\n";
    close MOH;
    &save_time;
    return;
}
=cut

sub can_send {
    my ($name, $mail) = @_;
    my ($host) = $ENV{'REMOTE_ADDR'};
    
    return 0 unless ($email_send);
    unless ($except_names =~ /^\s*$/o) {
        foreach $n (split(/[,;\s]/o, $except_names)) {
            return 0 if ($n eq $name);
        }
    }
    unless ($except_adrs =~ /^\s*$/o) {
        foreach $n (split(/[,;\s]/o, $except_adrs)) {
            return 0 if ($n eq $mail);
        }
    }
    if ($except_ip_list) {
        return &check_host($host, &purse_mask($except_ip_list));
    }
    if ($interval_send) {
        return 0 if (time - $last_send < $interval_send * 60);
    }

	if ($prohibit_time_zone) {
		my $now = int(time / 3600) % 24;
		my $ptzb = $prohibit_time_zone_begin % 24;
		my $ptze = $prohibit_time_zone_end % 24;
		if ($ptzb <= $ptze) {
			return 0 if ($ptzb <= $now and $ptze >= $now);
		} else {
			return 0 if ($ptzb <= $now and 23 >= $now);
			return 0 if (0 <= $now and $ptze >= $now);
		}
	}
    
    return 1;
}

sub send_mail {
	return if ($email_method > 0 and not $sendmail);
	return if ($email_method < 0 and not $blat);
	return if ($email_method == 0 and not $smtp_server);

	my $body = shift;
	my $mode = shift;
    my $subject = $email_subj . '[' . ((defined $mode)? "修正" : "新規") . ']';
	if ($email_method >= 0) {
		&jcode::sjis2jis(\$subject);
		&jcode::sjis2jis(\$body);
	}
	
	my @header;
	
	push @header, "To: $email_to";
	push @header, "From: $email_from";
	push @header, "Subject: $subject";
	push @header, "X-Mailer: Ir-i-BBS Mailer $version";
	push @header, "Content-Transfer-Encoding: 7bit";
	push @header, "Content-Type: text/plain; charset=iso-2022-jp";

	$term_pseudo = 'notag';
	$body = &conv_imchr($body);
	$body = &conv_jschr($body);
	$term_pseudo = '';
	$body =~ s/<br>/\n/gio;
	$body =~ s/&lt;/</go;
	$body =~ s/&gt;/>/go;
	$body =~ s/&quot;/\"/go;
	$body =~ s/&amp;/\&/go;
	$body =~ s/[ \t]+/ /go;
	$body =~ s/\n /\n/go;
	$body =~ s/ \n/\n/go;
	$body =~ s/\n+/\n/go;
	$body =~ s/^\s+//o;
	$body =~ s/\s+$//o;

	if ($email_method > 0) {
		open MOH, "| $sendmail $email_to" or return 1;
		my $head = join "\n" => @header;
		print MOH $head, "\n\n";
		print MOH $body, "\n";
		close MOH;
	} elsif ($email_method < 0) {
		my @args = ('-', '-t', qq/"$email_to"/, '-s', qq/"$subject"/);
		push @args, '-from', qq/"$email_from"/ if ($email_from);
		my $status = system $blat, @args;
		return if ($status);
		print STDOUT $body, "\x1a";
	} else {
		local $/ = "\015\012";
		my $msg = join "\015\012", @header;
		$msg .= "\015\012\015\012$body";
		my $status = &send_smtp($email_to, $email_from, $msg);
		return if ($status);
	}

    &save_time;
    return;
}

sub timeoutSignal {
	my $signal = shift;
	return;
}

sub send_smtp {
	my ($to, $from, $msg) = @_;

	$SIG{'ALRM'} = \&timeoutSignal;
	$SIG{'INT'} = \&timeoutSignal;
	alarm(120);
	my $localhost = 'localhost';
	my $smtpRetry = 10;
	my $smtpDelay = 1;
	my $defPort = (getservbyname("smtp", "tcp"))[2];
	my $smtpPort = ($smtp_port)? $smtp_port : $defPort;
	my $smtpHost = gethostbyname($smtp_server);
	my $packdAdr = pack('S n a4 x8', 2, $smtpPort, $smtpHost);
	my $protonum = (getprotobyname 'tcp')[2];
	sub resumeSig {
		alarm(0);
		$SIG{'ALRM'} = IGNORE;
		$SIG{'INT'} = IGNORE;
	}
	sub fail {
		close SMTP;
		resumeSig();
		return 1;
	}
	sub checkSMTP {
		my $reply;
		recv(SMTP, $reply, 256, 0);
		my $result = (split / /, $reply, 2)[0];
		return (not($result >= 400 and $result < 600));
	}

	socket(SMTP, 2, 1, $protonum) or return fail();
	connect(SMTP, $packdAdr) or return fail();
	select((select(SMTP), $| = 1)[0]);

	checkSMTP() or return fail();
	my $r = 0;
	while(1) {
		send(SMTP, "EHLO $localhost\015\012", 0);
		last if (checkSMTP());
		send(SMTP, "HELO $localhost\015\012", 0);
		last if (checkSMTP());
		last if ($r > $smtpRetry);
		$r++;
		sleep($smtpDelay);
	}
	return fail() if ($r > $smtpRetry);

	send(SMTP, "RSET\015\012", 0);
	checkSMTP() or return fail();

	send(SMTP, "MAIL FROM: <$from>\015\012", 0);
	checkSMTP() or return fail();

	send(SMTP, "RCPT TO: <$to>\015\012", 0);
	checkSMTP() or return fail();

	send(SMTP, "DATA\015\012", 0);
	checkSMTP() or return fail();

	send(SMTP, "$msg\015\012.\015\012", 0);
	checkSMTP() or return fail();

	send(SMTP, "QUIT\015\012", 0);

	close(SMTP);
	resumeSig();
	return 0;
}

sub check_send_mail {
	my @cmds = qw(/usr/sbin/sendmail /usr/bin/sendmail /usr/lib/sendmail /var/qmail/bin/qmail-inject);
	foreach (@cmds) {
		return $_ if(-x $_);
	}
	return '<font color="red">検出不可</font>';
}

sub save_time {
    local(%FORM);
    $FORM{'last_send'} = time;
    &save_init($init_file, $init_exist);
}

sub conv_imchr {
    ($_) = @_;

    s/\&#(63[5-9]\d\d)(;|)/&conv_char($1)/ego;
    s/\&#x(f[89][\da-f][\da-f])(;|)/&conv_char($1)/igeo;
    if (($term_pseudo ne 'notag') && ($terminal eq "imode")) {
        if ($real_term eq "") {
            my $hua = $ENV{'HTTP_USER_AGENT'};
            my $hxjn = $ENV{'HTTP_X_JPHONE_MSNAME'};
            $real_term = &is_imode($hua, $hxjn);
        }
        return ($_) if ($real_term eq 'imode');
    }
    s/([\x81-\x9f\xe0-\xef][\x40-\x7e\x80-\xfc]|\xf8[\x40-\x4f\x9e-\xff]|\xf9[\x40-\xb0])/&proc_imchr($1)/ego;
    return ($_);
}

sub proc_imchr {
    my ($arg) = @_;
    my ($retc, $ret);
    my ($img1, $img2);

    return ($arg) unless ($arg =~ /(\xf8[\x40-\x4f\x9e-\xff]|\xf9[\x40-\xb0])/o);
    my ($arg1, $arg2) = unpack "CC", $arg;
    $ret = sprintf "%02x%02x", $arg1, $arg2;
    
    ($retc = $ret) =~ tr/a-f/A-F/;
    if ($terminal eq "pc") {
        $img1 = '<img src="' . $im_chr_cgi . '?code=x' . $ret;
        if ($body{'text'}) {
            my ($c);
            ($c = $body{'text'}) =~ tr/#/x/;
            $img1 .= '&color=' . $c unless ($c =~ /(000000|^black)$/o);
        }
        $img1 .= '" border=0 width=16 height=16 alt="';
    } elsif ($terminal eq "ez") {
        if ((exists $imchr_icon{$retc}) && ($imchr_ezicon)) {
            my @imgz1;
            foreach (split(/\&/o, $imchr_icon{$retc})) {
                push @imgz1, '<IMG ICON="' . $_;
            }
            $img1 = join('">', @imgz1);
        } else {
            $img1 = '<IMG SRC="' . $im_chr_cgi . '?mode=ez&code=x' . $ret;
        }
        $img1 .= '" ALT="';
    } elsif ($terminal eq "jsky") {
		if ($envimgpath =~ m|^http://|) {
			$img1 = qq|<img src="${envimgpath}${ret}.png" alt="|;
		} else {
            if (!(-e ("$envimgpath$ret" . '.png'))) {
                &imchr_expand_jsky($ret);
            }
            if (-e ("$envimgpath$ret" . '.png')) {
                $img1 = '<img src="' . "${envimgpath}${ret}.png" . '" alt="';
            }
        }
    }
    $img2 = '">' if ($img1);

    if (($imchr_title) && (exists $imchr_explain{$retc})) {
        $retc = "&amp;#x" . $ret . ";[" . $imchr_explain{$retc} . "]";
    } else {
        $retc = "絵文字:&amp;#x" . $ret . ";";
    }
    $retc = $img1 . $retc . $img2 unless ($term_pseudo eq 'notag');
    return ($retc);
}

sub conv_char {
    my ($arg) = @_;
    $arg = hex $arg if ($arg =~ /^[a-fA-F]/o);
    return ('&#' . $arg . ';') unless ((($arg >= 63552) && ($arg <= 63567))
                                    || (($arg >= 63646) && ($arg <= 63743))
                                    || (($arg >= 63808) && ($arg <= 63920)));
    return (chr ($arg >> 8) . chr ($arg & 0xff));
}

sub conv_jschr {
    ($_) = @_;
    s/\x1b\x24([EFG][\x21-\x7a]+)\x0f?/&proc_jschr($1)/ego;
    s/\x1b\x24[EFG]\x0f?//og;
    return ($_);
}

sub get_jschr {
    ($code) = @_;

    if (-e $jschr_file) {
        open(FILE, $jschr_file);

        while ($line = <FILE>) {
            $line =~ s/\r?\n?$//o;
            if ((!($line =~ /^#/o)) && (!($line =~ /^\s*$/o))) {
                @inf = split(/,/o, $line);
                last if ($inf[0] == $code);
            }
        }
        close(FILE);
    }
    return ($inf[1], $inf[2]) if ($terminal eq "imode");
    return ($inf[1], $inf[3]) if ($terminal eq "ez");
    return ($inf[1]);
}

sub proc_jschr {
    my ($arg) = @_;
    my ($retd, $mode);

    @args = unpack "c*", $arg;
    $mode = (shift @args) - ord('E');
    $mode++;
    $mode %= 3;
    foreach $code (@args) {
        $code -= 0x20;
# $code = ord($arg) - 0x20;
if ($mode == 0) {
        if ($terminal eq "imode") {
            ($alt, $chr) = &get_jschr($code);
            if ($chr) {
                $chr = hex $chr;
                $ret = pack "CC", ($chr >> 8), ($chr & 0xff);
                $retd .= $ret;
            }
        } elsif ($terminal eq "ez") {
            ($alt, $chr) = &get_jschr($code);
            if ($chr) {
                $ret = '<IMG ICON="' . $chr . '">';
                $retd .= $ret;
            }
        } else {
            $alt = &get_jschr($code);
        }
}
$extcode = $code + 90 * $mode;
        $code = sprintf "%02d", $code;
$extcode = sprintf "%03d", $extcode;
        my ($img0, $img2);
        $img0 = '<img src="';
        $img1 = $im_chr_cgi . '?char=' . $code;
        if ($terminal eq "pc") {
            if ($body{'text'}) {
                my ($c);
                ($c = $body{'text'}) =~ tr/#/x/;
                $img1 .= '&color=' . $c unless ($c =~ /(000000|^black)$/);
                $img1 .= '&ext=' . $extcode;
            }
            $img1 .= '&term=pc" border=0 width=16 height=16 alt="';
        } elsif ($terminal eq "ez") {
            $img0 =~ tr/a-z/A-Z/;
            $img1 .= '&term=ez" ALT="';
        } elsif ($terminal eq "imode") {
            if ($imode_body{'text'}) {
                my ($c);
                ($c = $imode_body{'text'}) =~ tr/#/x/;
                $img1 .= '&color=' . $c unless ($c =~ /(000000|^black)$/o);
                $img1 .= '&ext=' . $extcode;
            }
            $img1 .= '&term=im" border=0 alt="';
        }
        $img1 = $img0 . $img1;
        $img2 = '">';

        if (($imchr_title) && ($alt)) {
            $retc = "#" . $code . ";[" . $alt . "]";
        } else {
            $retc = "絵文字:#" . $code . ";";
        }
       unless ($term_pseudo eq 'notag') {
           $retd .= $img1 . $retc . $img2;
       } else {
           $retd .= $retc;
       }
    }
    return ($retd);

}

sub get_color_code {
    my ($col) = @_;
    $col =~ tr/#/x/;
    if ($col =~ /^\w+$/o) {
        my %color_table = (
            'aliceblue' => 'xf0f8ff', 'antiquewhite' => 'xfaebd7',
            'aqua' => 'x00ffff', 'aquamarine' => 'x7fffd4',
            'azure' => 'xf0ffff', 'beige' => 'xf5f5dc',
            'bisque' => 'xffe4c4', 'black' => 'x000000',
            'blanchedalmond' => 'xffebcd', 'blue' => 'x0000ff',
            'blueviolet' => 'x8a2be2', 'brown' => 'xa52a2a',
            'burlywood' => 'xdeb887', 'cadetblue' => 'x5f9ea0',
            'chartreuse' => 'x7fff00', 'chocolate' => 'xd2691e',
            'coral' => 'xff7f50', 'cornflowerblue' => 'x6495ed',
            'cornsilk' => 'xfff8dc', 'crimson' => 'xdc143c',
            'cyan' => 'x00ffff', 'darkblue' => 'x00008b',
            'darkcyan' => 'x008b8b', 'darkgoldenrod' => 'xb8860b',
            'darkgray' => 'xa9a9a9', 'darkgreen' => 'x006400',
            'darkkhaki' => 'xbdb76b', 'darkmagenta' => 'x8b008b',
            'darkolivegreen' => 'x556b2f', 'darkorange' => 'xff8c00',
            'darkorchid' => 'x9932cc', 'darkred' => 'x8b0000',
            'darksalmon' => 'xe9967a', 'darkseagreen' => 'x8fbc8f',
            'darkslateblue' => 'x483d8b', 'darkslategray' => 'x2f4f4f',
            'darkturquoise' => 'x00ced1', 'darkviolet' => 'x9400d3',
            'deeppink' => 'xff1493', 'deepskyblue' => 'x00bfff',
            'dimgray' => 'x696969', 'dodgerblue' => 'x1e90ff',
            'firebrick' => 'xb22222', 'floralwhite' => 'xfffaf0',
            'forestgreen' => 'x228b22', 'fuchsia' => 'xff00ff',
            'gainsboro' => 'xdcdcdc', 'ghostwhite' => 'xf8f8ff',
            'gold' => 'xffd700', 'goldenrod' => 'xdaa520',
            'gray' => 'x808080', 'green' => 'x008000',
            'greenyellow' => 'xadff2f', 'honeydew' => 'xf0fff0',
            'hotpink' => 'xff69b4', 'indianred' => 'xcd5c5c',
            'indigo' => 'x4b0082', 'ivory' => 'xfffff0',
            'khaki' => 'xf0e68c', 'lavender' => 'xe6e6fa',
            'lavenderblush' => 'xfff0f5', 'lawngreen' => 'x7cfc00',
            'lemonchiffon' => 'xfffacd', 'lightblue' => 'xadd8e6',
            'lightcoral' => 'xf08080', 'lightcoral' => 'xe0ffff',
            'lightgoldenrodyellow' => 'xfafad2', 'lightgreen' => 'x90ee90',
            'lightgrey' => 'xd3d3d3', 'lightpink' => 'xffb6c1',
            'lightsalmon' => 'xffa07a', 'lightseagreen' => 'x20b2aa',
            'lightskyblue' => 'x87cefa', 'lightslategray' => 'x778899',
            'lightsteelblue' => 'xb0c4de', 'lime' => 'x00ff00',
            'limegreen' => 'x32cd32', 'linen' => 'xfaf0e6',
            'magenta' => 'xff00ff', 'maroon' => 'x800000',
            'mediumaquamarine' => 'x66cdaa', 'mediumblue' => 'x0000cd',
            'mediumorchid' => 'xba55d3', 'mediumpurple' => 'x9370db',
            'mediumseagreen' => 'x3cb371', 'mediumslateblue' => 'x7b68ee',
            'mediumspringgreen' => 'x00fa9a', 'mediumturquoise' => 'x48d1cc',
            'mediumvioletred' => 'xc71585', 'midnightblue' => 'x191970',
            'mintcream' => 'xf5fffa', 'mistyrose' => 'xffe4e1',
            'moccasin' => 'xffe4b5', 'navajowhite' => 'xffdead',
            'navy' => 'x000080', 'oldlace' => 'xfdf5e6',
            'olive' => 'x808000', 'olivedrab' => 'x6b8e23',
            'orange' => 'xffa500', 'orangered' => 'xff4500',
            'orchid' => 'xda70d6', 'palegoldenrod' => 'xeee8aa',
            'palegreen' => 'x98fb98', 'paleturquoise' => 'xafeeee',
            'palevioletred' => 'xdb7093', 'papayawhip' => 'xffefd5',
            'peachpuff' => 'xffdab9', 'peru' => 'xcd853f',
            'pink' => 'xffc0cb', 'plum' => 'xdda0dd',
            'powderblue' => 'xb0e0e6', 'purple' => 'x800080',
            'red' => 'xff0000', 'rosybrown' => 'xbc8f8f',
            'royalblue' => 'x4169e1', 'saddlebrown' => 'x8b4513',
            'salmon' => 'xfa8072', 'sandybrown' => 'xf4a460',
            'seagreen' => 'x2e8b57', 'seashell' => 'xfff5ee',
            'sienna' => 'xa0522d', 'silver' => 'xc0c0c0',
            'skyblue' => 'x87ceeb', 'slateblue' => 'x6a5acd',
            'slategray' => 'x708090', 'snow' => 'xfffafa',
            'springgreen' => 'x00ff7f', 'steelblue' => 'x4682b4',
            'tan' => 'xd2b48c', 'teal' => 'x008080',
            'thistle' => 'xd8bfd8', 'tomato' => 'xff6347',
            'turquoise' => 'x40e0d0', 'violet' => 'xee82ee',
            'wheat' => 'xf5deb3', 'white' => 'xffffff',
            'whitesmoke' => 'xf5f5f5', 'yellow' => 'xffff00',
            'yellowgreen' => 'x9acd32', 'whitemist' => 'xf0f8ff'
        );
        $col =~ tr/A-Z/a-z/;
        $col = $color_table{$col} if (exists $color_table{$col});
    }
    my ($col_r, $col_g, $col_b);

    if ($col =~ /^(x|#|%(25)?23)[0-9a-fA-F]{6}$/o) {
        $col =~ /([0-9a-fA-F]{2})([0-9a-fA-F]{2})([0-9a-fA-F]{2})/o;
        $col_r = $1;
        $col_g = $2;
        $col_b = $3;
    }
    return ($col_r, $col_g, $col_b);
}

sub png_pal {
    my ($type, $c1, $c2, $crc, $col_r, $col_g, $col_b) = @_;
    if ($c1 eq "\x00\x00\x00") {
        $c1 = pack("C*", hex $col_r, hex $col_g, hex $col_b);
    } else {
        $c2 = pack("C*", hex $col_r, hex $col_g, hex $col_b);
    }
    $crc = &crc32("$type$c1$c2");
    $crc = pack "N", $crc;
    $crc = ~$crc;
    return ("$c1$c2$crc");
}

sub change_fore_color {
    my ($data, $r, $g, $b) = @_;
    my ($p, $a1, $a2, $a3);
    if ($data =~ /^\x89PNG/o) {
        $data =~ m/(PLTE)/gio;
        $p = pos($data);
        $a1 = substr($data, $p, 3);
        $a2 = substr($data, $p+3, 3);
        $a3 = substr($data, $p+6, 4);
        substr ($data, $p, 10) = &png_pal($1, $a1, $a2, $a3, $r, $g, $b);
    }
    return ($data);
}

sub crc32 {
    my ($arg) = @_;
    my (@crc_table) =(
             0x00000000, 0x77073096, 0xee0e612c, 0x990951ba, 0x076dc419,
             0x706af48f, 0xe963a535, 0x9e6495a3, 0x0edb8832, 0x79dcb8a4,
             0xe0d5e91e, 0x97d2d988, 0x09b64c2b, 0x7eb17cbd, 0xe7b82d07,
             0x90bf1d91, 0x1db71064, 0x6ab020f2, 0xf3b97148, 0x84be41de,
             0x1adad47d, 0x6ddde4eb, 0xf4d4b551, 0x83d385c7, 0x136c9856,
             0x646ba8c0, 0xfd62f97a, 0x8a65c9ec, 0x14015c4f, 0x63066cd9,
             0xfa0f3d63, 0x8d080df5, 0x3b6e20c8, 0x4c69105e, 0xd56041e4,
             0xa2677172, 0x3c03e4d1, 0x4b04d447, 0xd20d85fd, 0xa50ab56b,
             0x35b5a8fa, 0x42b2986c, 0xdbbbc9d6, 0xacbcf940, 0x32d86ce3,
             0x45df5c75, 0xdcd60dcf, 0xabd13d59, 0x26d930ac, 0x51de003a,
             0xc8d75180, 0xbfd06116, 0x21b4f4b5, 0x56b3c423, 0xcfba9599,
             0xb8bda50f, 0x2802b89e, 0x5f058808, 0xc60cd9b2, 0xb10be924,
             0x2f6f7c87, 0x58684c11, 0xc1611dab, 0xb6662d3d, 0x76dc4190,
             0x01db7106, 0x98d220bc, 0xefd5102a, 0x71b18589, 0x06b6b51f,
             0x9fbfe4a5, 0xe8b8d433, 0x7807c9a2, 0x0f00f934, 0x9609a88e,
             0xe10e9818, 0x7f6a0dbb, 0x086d3d2d, 0x91646c97, 0xe6635c01,
             0x6b6b51f4, 0x1c6c6162, 0x856530d8, 0xf262004e, 0x6c0695ed,
             0x1b01a57b, 0x8208f4c1, 0xf50fc457, 0x65b0d9c6, 0x12b7e950,
             0x8bbeb8ea, 0xfcb9887c, 0x62dd1ddf, 0x15da2d49, 0x8cd37cf3,
             0xfbd44c65, 0x4db26158, 0x3ab551ce, 0xa3bc0074, 0xd4bb30e2,
             0x4adfa541, 0x3dd895d7, 0xa4d1c46d, 0xd3d6f4fb, 0x4369e96a,
             0x346ed9fc, 0xad678846, 0xda60b8d0, 0x44042d73, 0x33031de5,
             0xaa0a4c5f, 0xdd0d7cc9, 0x5005713c, 0x270241aa, 0xbe0b1010,
             0xc90c2086, 0x5768b525, 0x206f85b3, 0xb966d409, 0xce61e49f,
             0x5edef90e, 0x29d9c998, 0xb0d09822, 0xc7d7a8b4, 0x59b33d17,
             0x2eb40d81, 0xb7bd5c3b, 0xc0ba6cad, 0xedb88320, 0x9abfb3b6,
             0x03b6e20c, 0x74b1d29a, 0xead54739, 0x9dd277af, 0x04db2615,
             0x73dc1683, 0xe3630b12, 0x94643b84, 0x0d6d6a3e, 0x7a6a5aa8,
             0xe40ecf0b, 0x9309ff9d, 0x0a00ae27, 0x7d079eb1, 0xf00f9344,
             0x8708a3d2, 0x1e01f268, 0x6906c2fe, 0xf762575d, 0x806567cb,
             0x196c3671, 0x6e6b06e7, 0xfed41b76, 0x89d32be0, 0x10da7a5a,
             0x67dd4acc, 0xf9b9df6f, 0x8ebeeff9, 0x17b7be43, 0x60b08ed5,
             0xd6d6a3e8, 0xa1d1937e, 0x38d8c2c4, 0x4fdff252, 0xd1bb67f1,
             0xa6bc5767, 0x3fb506dd, 0x48b2364b, 0xd80d2bda, 0xaf0a1b4c,
             0x36034af6, 0x41047a60, 0xdf60efc3, 0xa867df55, 0x316e8eef,
             0x4669be79, 0xcb61b38c, 0xbc66831a, 0x256fd2a0, 0x5268e236,
             0xcc0c7795, 0xbb0b4703, 0x220216b9, 0x5505262f, 0xc5ba3bbe,
             0xb2bd0b28, 0x2bb45a92, 0x5cb36a04, 0xc2d7ffa7, 0xb5d0cf31,
             0x2cd99e8b, 0x5bdeae1d, 0x9b64c2b0, 0xec63f226, 0x756aa39c,
             0x026d930a, 0x9c0906a9, 0xeb0e363f, 0x72076785, 0x05005713,
             0x95bf4a82, 0xe2b87a14, 0x7bb12bae, 0x0cb61b38, 0x92d28e9b,
             0xe5d5be0d, 0x7cdcefb7, 0x0bdbdf21, 0x86d3d2d4, 0xf1d4e242,
             0x68ddb3f8, 0x1fda836e, 0x81be16cd, 0xf6b9265b, 0x6fb077e1,
             0x18b74777, 0x88085ae6, 0xff0f6a70, 0x66063bca, 0x11010b5c,
             0x8f659eff, 0xf862ae69, 0x616bffd3, 0x166ccf45, 0xa00ae278,
             0xd70dd2ee, 0x4e048354, 0x3903b3c2, 0xa7672661, 0xd06016f7,
             0x4969474d, 0x3e6e77db, 0xaed16a4a, 0xd9d65adc, 0x40df0b66,
             0x37d83bf0, 0xa9bcae53, 0xdebb9ec5, 0x47b2cf7f, 0x30b5ffe9,
             0xbdbdf21c, 0xcabac28a, 0x53b39330, 0x24b4a3a6, 0xbad03605,
             0xcdd70693, 0x54de5729, 0x23d967bf, 0xb3667a2e, 0xc4614ab8,
             0x5d681b02, 0x2a6f2b94, 0xb40bbe37, 0xc30c8ea1, 0x5a05df1b,
             0x2d02ef8d
    );

    $crc = 0xffffffff;
    $len = length($arg);
    @args = unpack "c*", $arg;
    for ($i = 0; $i < $len; $i++) {
        $index = ($crc ^ $args[$i]) & 0xff;
        $crc = $crc_table[$index] ^ (($crc >> 8) & 0x00ffffff);
    }
    return ($crc);
}

sub set_body_color {
    my (%body) = @_;
    my ($k, $v, %body_attr, $body_attributes);

    while(($k, $v) = each %body) {
        $body_attr{$k} = $k . '="' . $v . '"' if ($v ne "");
    }

    $body_attributes = join(" ", values %body_attr);
    $body_attributes = ($body_attributes =~ /^\s*$/o)? "" : " $body_attributes";
    return $body_attributes;
}

sub init_set {
    my ($init, $ent) = @_;
    if (exists $ini{$ent}) {
        return $ini{$ent};
    } else {
        return $init;
    }
}

sub init_set_color {
    my ($init, $ent) = @_;
    my ($result) = &init_set($init, $ent);
    $result =~ s/^\\#/#/o;
    return $result;
}

sub check_double_post {

    my ($prev, $post) = @_;
    @prev_array = split(/\t/o, $prev);
    @post_array = split(/\t/o, $post);
    $prev_array[5] = "";
    $post_array[5] = "";
    $prev_array[9] = "";
    $post_array[9] = "";
    $prev_array[10] = "";
    $post_array[10] = "";
    return (join(',', @prev_array) eq join(',', @post_array));
}

sub set_bbs_path {
    $bbs_url = 'http://' . $ENV{'SERVER_NAME'} . $ENV{'SCRIPT_NAME'};
    $bbs_local = $ENV{'SCRIPT_NAME'};
}

sub load_init {
    my ($file) = @_;
    my (@text, $home);
    my ($line, $ini_variable, $ini_lvalue, $ini_rvalue, $ini_split);
    local (%ini);
    my ($exist) = 0;

    if (-e $file) {
        open(FILE, $file) || &error('設定ファイルが開けません.');
        
        while ($line = <FILE>) {
            chomp($line);
            if ((!($line =~ /^#/o)) && (!($line =~ /^\s*$/o))) {
                push(@text, $line);
            }
        }
        close(FILE);
    }

    if ((@text) && (join("", @text) !~ /^\s*$/o)) {
        while (@text) {
            $line = shift(@text);
            if ($line =~ /^\[(.*)\]/o) {
                $ini_variable = $1;
                if ($1 eq "head_lines") {
                    $nextline = shift(@text);
                    my ($cnt, @hl);
                    while ((defined $nextline) && ($nextline !~ /^\[/o)) {
                        $hl[$cnt++] = $nextline;
                        $nextline = shift(@text);
                    }
                    $headlines = join("", @hl);
                    unshift(@text, $nextline);
                } elsif ($text[0] !~ /^\[(.*)\]/o) {
                    $ini{$ini_variable} = shift(@text);
                }
            }
        }
        $exist = 1;
    }

    $regist_max = &init_set(600, 'regist_max');
    $bbs_id = &init_set('IrIBBS', 'bbs_id');
    $bbs_url = &init_set('', 'bbs_url');
    $bbs_url = '' if ($bbs_url eq 'http://(設置URL)/ir-i-bbs.cgi');
    $ret_url = &init_set('', 'ret_url');
    $ret_url = '' if ($ret_url eq 'http://(戻り先URL)');
    $ret_ez = &init_set('', 'ret_ez');
    $ret_ez = '' if ($ret_ez eq 'http://(戻り先URL)/index.hdml');
    $ret_imode = &init_set('', 'ret_imode');
    $ret_imode = '' if ($ret_imode eq 'http://(戻り先URL)/index.html');
    $ret_jsky = &init_set('', 'ret_jsky');
    $ret_jsky = '' if ($ret_jsky eq 'http://(戻り先URL)/index.html');
    $ret_pc = &init_set('', 'ret_pc');
    $ret_pc = '' if ($ret_pc eq 'http://(戻り先URL)/index.html');
    $page_max_i = &init_set(5, 'page_max_i');
    $imode_auto = &init_set(0, 'imode_auto');
    $imode_auto_size = &init_set(2, 'imode_auto_size');
    $ez_auto = &init_set(0, 'ez_auto');
    $ez_auto_size = &init_set(1, 'ez_auto_size');
    $jsky_auto = &init_set(0, 'jsky_auto');
    $jsky_auto_size = &init_set(3, 'jsky_auto_size');
    $page_max_ez = &init_set(3, 'page_max_ez');
    $page_max_ez_ce = &init_set(6, 'page_max_ez_ce');
    $page_max_pc = &init_set(10, 'page_max_pc');
    $page_max_j = &init_set(6, 'page_max_j');
    $title = &init_set('掲示板', 'title');
    $imode_title = &init_set($title, 'imode_title');
    $jsky_title = &init_set($title, 'jsky_title');
    $jsky_mylink_title = &init_set($title, 'jsky_mylink_title');
    $jsky_station_title_control = &init_set(1, 'jsky_station_title_control');
    $ezweb_title = &init_set($title, 'ezweb_title');
    $astel_title = &init_set($title, 'astel_title');
    
    $email_admin = &init_set('', 'email_admin');
    $email_admin = '' if ($email_admin eq '(管理者メールアドレス)');
    $email_send = &init_set(0, 'email_send');
    $sendmail = &init_set('/usr/bin/sendmail', 'sendmail');
    
    $email_method = &init_set(1, 'email_method');
    $blat = &init_set('blat.exe', 'blat');
    $smtp_server = &init_set('', 'smtp_server');
    $smtp_port = &init_set('25', 'smtp_port');
    $prohibit_time_zone = &init_set(0, 'prohibit_time_zone');
    $prohibit_time_zone_begin = &init_set('', 'prohibit_time_zone_begin');
    $prohibit_time_zone_end = &init_set('', 'prohibit_time_zone_end');

    $email_to = &init_set('', 'email_to');
    $email_to = '' if ($email_admin eq '(通知メールアドレス)');
    $email_from = &init_set('', 'email_from');
    $email_subj = &init_set('投稿通知', 'email_subj');
    $referer_check = &init_set(1, 'referer_check');
    $imchr_title = &init_set(1, 'imchr_title');
    $imchr_ezicon = &init_set(1, 'imchr_ezicon');
    $print_ip = &init_set(1, 'print_ip');
    $contact_admin = &init_set(1, 'contact_admin');
    $send_referer_ez = &init_set(1, 'send_referer_ez');
    $envimgpath = &init_set("", 'env_img_path');
    $envimgpath .= './' if ($envimgpath =~ m|^\s*$|);
    $envimgpath .= '/' if ($envimgpath !~ m|/$|);
    $ac_valid = &init_set(0, 'ac_valid');
    $ac_mark = &init_set(0, 'ac_mark');
    $ac_public = &init_set(0, 'ac_public');
    $ac_domain = &init_set('', 'ac_domain');
    $ac_path = &init_set('', 'ac_path');
    $except_names = &init_set('', 'except_names');
    $except_adrs = &init_set('', 'except_adrs');
    $except_ip_list = &init_set('', 'except_ip_list');
#    $except_ips = &init_set('', 'except_ips');
#    $net_mask = &init_set('', 'net_mask');
    $restrict_ip_list = &init_set('', 'restrict_ip_list');
    $restrict_mode = &init_set(0, 'restrict_mode');
    $restrict_newline = &init_set(10, 'restrict_newline');
    $restrict_size = &init_set(2, 'restrict_size');
    $limit_mode = &init_set(0, 'limit_mode');
    $limit_pass = &init_set('', 'limit_pass');
    $print_version = &init_set(0, 'print_version');
    $print_title = &init_set(1, 'print_title');
    $print_gtitle = &init_set(0, 'print_gtitle');
    $title_gpath = &init_set('', 'title_gpath');
    $title_galt = &init_set('', 'title_galt');
    $title_gwidth = &init_set(0, 'title_gwidth');
    $title_gheight = &init_set(0, 'title_gheight');
    $del_pass_mode = &init_set(0, 'del_pass_mode');

$check_paldio_referer = &init_set(1, 'check_paldio_referer');
$check_astel_referer = &init_set(1, 'check_astel_referer');
$allow_astel_savepage = &init_set(1, 'allow_astel_savepage');

$no_check_pocket_ie = &init_set(1, 'no_check_pocket_ie');

$mobile_counter_mode = &init_set(0, 'mobile_counter_mode');
$mobile_counter_front_str = &init_set('あなたは', 'mobile_counter_front_str');
$mobile_counter_back_str = &init_set('人目のお客様です', 'mobile_counter_back_str');
$pc_counter_mode = &init_set(0, 'pc_counter_mode');
$pc_counter_front_str = &init_set('あなたは', 'pc_counter_front_str');
$pc_counter_back_str = &init_set('人目のお客様です', 'pc_counter_back_str');

$cookDaysEz = &init_set(30, 'cookDaysEz');
$restricted_words = &init_set('', 'restricted_words');
$write_limit = &init_set(0, 'write_limit');

    $cook_author_master = &init_set(24, 'cook_author_master');
    $cook_author_enter = &init_set(-1, 'cook_author_enter');
    $cook_initial = &init_set(-1, 'cook_initial');
    $last_send = &init_set(0, 'last_send');
    $interval_send = &init_set(5, 'interval_send');
    $enable_counter = &init_set(0, 'enable_counter');
    $save_log = &init_set(0, 'save_log');
    $imode_post_button = &init_set(0, 'imode_post_button');
    $term_logic_mode = &init_set(0, 'term_logic_mode');
    if ($ac_valid == 1) {
        $ac_mark = 2 if (!($ac_mark) && ($ac_public));
        $ac_public = 0;
        if ($ac_mark == 0) {
            $d_markable = '';
            $d_public = '';
        } elsif ($ac_mark == 1) {
            $d_markable = 'true';
            $d_public = '';
        } elsif ($ac_mark == 2) {
            $d_markable = 'false';
            $d_public = 'true';
        }
#        $d_markable = ($ac_mark)? 'true' : 'false';
#        $d_public = ($ac_public)? 'true' : 'false';
        $d_accessdomain = $ac_domain;
        $d_accesspath = $ac_path;
        $d_markable =~ tr/a-z/A-Z/;
        $d_public =~ tr/a-z/A-Z/;
    } else {
        $d_markable = "";
        $d_public = "";
        $d_accessdomain = "";
        $d_accesspath = "";
    }

    $body{'bgcolor'} = &init_set_color('#EEEEFF', 'body.bgcolor');
    $body{'text'} = &init_set_color('black', 'body.text');
    $body{'vlink'} = &init_set_color('#CC80CC', 'body.vlink');
    $body{'alink'} = &init_set_color('', 'body.alink');
    $body{'link'} = &init_set_color('#4080FF', 'body.link');
    $body{'background'} = &init_set_color('', 'body.background');
    $caption_table_color = &init_set_color('#CCCCFF', 'caption.color');
    $content_table_color = &init_set_color('#CCCCEE', 'content.color');
    $subject_color = &init_set_color('#4040FF', 'subject.color');
    $caption_head_color = &init_set_color('#CCDDFF', 'form.head.color');
    $title_back_color = &init_set_color('#DDE8FF', 'title.bgcolor');
    $imode_body{'bgcolor'} = &init_set_color('#EEEEFF', 'im.bgcolor');
    $imode_body{'text'} = &init_set_color('black', 'im.text');
    $imode_body{'link'} = &init_set_color('', 'im.link');
    $jsky_body{'bgcolor'} = &init_set_color('#EEEEFF', 'js.bgcolor');
    $jsky_body{'text'} = &init_set_color('black', 'js.text');
    $jsky_body{'link'} = &init_set_color('', 'js.link');
    &set_pc_body_color;
    $other = &init_set('', 'body.other');
    $body_attributes .= $other;

    return $exist;
}

sub save_init {
    my ($file, $existance) = @_;

    if ($existance) {
        my (@output, @entry, $ent, $out, $key);
        open RINI, "$file" || &error('設定を読み出せません.', $file);
        @entry = <RINI>;
        close (RINI);
        while (@entry) {
            my $ent = shift(@entry);
            chomp $ent;
            if ($ent =~ /^#/o) {
                push @output, "$ent\n";
            } else {
                if ($ent =~ /^\[(.*)\]/o) {
                    my $ini_id = $1;
                    next if ($ini_id =~ /^(action|pass|authorize|sv|ac_public)$/o);
                    push @output, "$ent\n";
                    if(exists $FORM{$ini_id}) {
                        push @output, "$FORM{$ini_id}\n";
                    } else {
                        if ($entry[0] =~ /^(\[|#)/o) {
                            push @output, "\n";
                        } else {
                            while($entry[0] !~ /^(\[|#)/o) {
                                $ent = shift(@entry);
                                push @output, $ent;
                                last unless (@entry);
                            }
                        }
                    }
                    delete $FORM{$ini_id};
                }
            }
        }
        foreach $key (keys %FORM) {
            $FORM{$key} = $FORM{'email_admin'}
                if (($key eq "email_from") && ($FORM{$key} =~ /^\s*$/o));
            push @output, "\[$key\]\n$FORM{$key}\n"
                unless ($key =~ /^(action|pass|authorize|sv|bbs_localac_public)$/o);
        }
        open INI, "> $file"
            || &error('設定をファイルに記録できません.', $file);
        foreach $out (@output) {
            print INI "$out";
        }
        close(INI);
        return;
    } else {
        open INI, "> $file"
            || &error('設定をファイルに記録できません.', $file);
        print INI <<"EOIT";
#  Ir-i-BBS/$version
#  --------------------------------------------------------------
#    設定保存ファイル
#  --------------------------------------------------------------
#    This file is automatically generated / Recommend not to edit
#
EOIT
        foreach $key (sort keys %FORM) {
            $FORM{$key} = $FORM{'email_admin'}
                if (($key eq "email_from") && ($FORM{$key} =~ /^\s*$/o));
            print INI "\[$key\]\n$FORM{$key}\n"
                unless ($key =~ /^(action|pass|authorize|sv|bbs_local|ac_public)$/o);
        }
#        print INI <<"EOIB";
# for Ir-i-BBS/$version,  Copyright (c) 1999 by Irao.
#EOIB
        close INI;
        $FORM{'action'} = 'ch_color' if ($terminal eq 'pc');
        $initial_setup = 'color';
    }
}

sub save_color {
    my ($file, $existance) = @_;

    if ($FORM{'other'} =~ /^\s*$/o) {
        my $other = $FORM{'other'};
        $other = " $other" if ($other !~ /^ /o);
    }
    $temp{'body.bgcolor'} = $FORM{'bgcolor'};
    $temp{'body.text'} = $FORM{'text'};
    $temp{'body.vlink'} = $FORM{'vlink'};
    $temp{'body.alink'} = $FORM{'alink'};
    $temp{'body.link'} = $FORM{'link'};
    $temp{'body.background'} = $FORM{'background'};
    $temp{'body.other'} = $other;
    $temp{'caption.color'} = $FORM{'caption'};
    $temp{'content.color'} = $FORM{'content'};
    $temp{'subject.color'} = $FORM{'subject'};
    $temp{'form.head.color'} = $FORM{'form'};
    $temp{'title.bgcolor'} = $FORM{'titleback'};
    $temp{'im.bgcolor'} = $FORM{'im_bg'};
    $temp{'im.text'} = $FORM{'im_tx'};
    $temp{'im.link'} = $FORM{'im_ln'};
    $temp{'js.bgcolor'} = $FORM{'js_bg'};
    $temp{'js.text'} = $FORM{'js_tx'};
    $temp{'js.link'} = $FORM{'js_ln'};
    $temp{'print_title'} = $FORM{'print_title'};
    $temp{'print_version'} = $FORM{'print_version'};
    $temp{'print_gtitle'} = $FORM{'print_gtitle'};
    $temp{'title_gpath'} = $FORM{'title_gpath'};
    $temp{'title_galt'} = $FORM{'title_galt'};
    $temp{'title_gheight'} = $FORM{'title_gheight'};
    $temp{'title_gwidth'} = $FORM{'title_gwidth'};
    undef(%FORM);
    while (($key, $value) = each %temp) {
        ($FORM{$key} = $value) =~ s/^#/\\#/o;
    }
    
    &save_init($file, $existance);
}

sub load_about {
    my (@text, $home);
    my ($line, $req);
    my ($def_about_data) =<<'EOD';
この掲示板の運営方針は、基本的に自由放任です。
ただし営業行為や誹謗中傷、または不利益と判断した場合は予告無く削除します。
またHTML, HDMLタグは使用できません。
EOD

    if ($terminal eq "pc") {
        $req = "long";
    } elsif ($topez eq "true") {
        $req = "eztop";
    } else {
	$req = "compact";
    }

    return $def_about_data unless (-e $about_data_file);
    
    open(FILE, $about_data_file) || &error('概要ファイルが開けません.');
    
    while ($line = <FILE>) {
        chomp($line);
        if (($line !~ /^#/o) && ($line !~ /^\s*$/o)) {
            push(@text, $line);
        }
    }
    close(FILE);
    
    return $def_about_data if (join("", @text) =~ /^\s*$/o);
    
    while (@text) {
        $line = shift(@text);
        if ($line =~ /^\*${req}/) {
            $nextline = shift(@text);
            my ($count, @lines);
            while ((defined $nextline) && ($nextline !~ /^\*/o)) {
                $lines[$count++] = $nextline;
                $nextline = shift(@text);
            }
            if ($terminal !~ m|ez(/pseudo)?|o) {
                $data = join("", @lines);
            } else {
                $data = join("\n", @lines);
            }
            unshift(@text, $nextline);
        }
    }
    if ($terminal eq "ez") {
        $data =~ s/\n/<BR>/go;
    }
    $data =~ s/\$(\w+)/${$1}/go;
    return $data if (defined $data);
    return $def_about_data;
}

sub save_about {
    my ($file) = @_;

    if (-e $file) {
        local $terminal = "pc";
        $long = &load_about;
        $terminal = 'ez/pseudo';
        $compact = &load_about;
        local $topez = "true";
        $eztop = &load_about;
        chomp $long;
        chomp $compact;
        chomp $eztop;
    }
    $long = $FORM{'long'} if ($FORM{'long'} !~ /^\s*$/o);
    $compact = $FORM{'compact'} if ($FORM{'compact'} !~ /^\s*$/o);
    $eztop = $FORM{'eztop'} if ($FORM{'eztop'} !~ /^\s*$/o);
    open AB, "> $file"
            || &error('概要をファイルに記録できません.', $file);
    print AB <<"EOA";
#  Ir-i-BBS
#  --------------------------------------------------------------
#    掲示板の概要 データファイル
#  --------------------------------------------------------------
#
#  行頭に＃のある行はコメントとして取扱います(無視されます)
#  行頭に＊のある行は制御用ですので削除／変更しないでください
#  それ以外の行は各自の環境にあわせて変更してください
#
# i-mode/EZweb/EZaccess/J-skyweb 用　掲示板概要
*compact
$compact
# EZweb/EZaccess 用　トップ
*eztop
$eztop
# PC 用　掲示板の概要
*long
$long
# Ir-i-BBS/End of file
EOA
    close AB;
}

sub gzip_output {
    $|=1;
    if ((-x "/bin/gzip") && ($ENV{'HTTP_ACCEPT_ENCODING'}=~/gzip/o)) {
        print "Content-type: text/html\n";
        if($ENV{'HTTP_ACCEPT_ENCODING'}=~/x-gzip/o ){
            print "Content-encoding: x-gzip\n\n";
        } else {
            print "Content-encoding: gzip\n\n";
        }
        open STDOUT, "| /bin/gzip -1 -c";
    } else {
        print "Content-type: text/html\n\n";
    }
}

sub build_condition {
    my ($cond) = shift;
    my (@rexp) = @_;
    my ($expr) = join $cond => map {"m/$rexp[$_]/o"} (0..$#rexp);
    my ($mfnc) = eval "sub { $expr }";
    die if $@;
    return ($mfnc);
}

sub build_or {
    build_condition (' || ', @_);
}

=cut
$fnc2 = build_or qw{
#patterns
};
xxx if &$fnc2;
=cut

1;