# -*- cperl -*-
# -----------------------------------------------------------------------------
# $Id: Permission.pm,v 1.2 2004/09/30 17:00:40 admin Exp $
# -----------------------------------------------------------------------------
# Celaenitoは次のやうなcookieを用ゐて認證を行ふ。
# name: celaenito.auth
# value: 以下のハッシュ
#   {
#     uid        => user id,
#     passwd     => password,
#   }
# expires: 認證時に決定
# domain: none
# path: /
# secure: none
# -----------------------------------------------------------------------------
package Celaenito::Permission;
use strict;
use warnings;
use CGI::Cookie;
use Carp;
use UNIVERSAL qw(isa);
use constant {
    PERM_OK => 1,
    PERM_NG => 0,
};
use constant ACTS => qw(SEE ADD EDIT UPDATE DEL CONFIG);
use Celaenito::DB;
require Exporter;
our @ISA = qw(Exporter);

our %EXPORT_TAGS = ( # この他に :all も追加される。
    const => [qw(PERM_OK PERM_NG)],
    can   => [map {"CAN_$_"} ACTS],
    meta  => [qw(LOGINNED_P LOGGED_IN_P LOGIN_UID LOGIN_PASSWD LOGIN_USERNAME)],
    set   => [qw(SET_LOGIN UNSET_LOGIN UPDATE_LOGIN)],
   );
do {
    my %seen;
    push @{$EXPORT_TAGS{all}},
      grep {!$seen{$_}++} @{$EXPORT_TAGS{$_}} foreach keys %EXPORT_TAGS;
};
Exporter::export_tags('all');

BEGIN {
    foreach my $act (ACTS) {
	my $func = qq{
	    sub CAN_$act (\$) {
		my \$request = \$_[0]; # HTTP::Request
		if (!\$request or !isa(\$request, 'HTTP::Request')) {
		    croak "CAN_$act: usage - CAN_$act(HTTP::Request)";
		}

                my \$uid = LOGIN_UID(\$request);
                defined \$uid or \$uid = 'guest';

		my \$user_info = _user_info(\$uid);
		if (!\$user_info) {
		    return PERM_NG;
		}

		\$user_info->{"can_" . lc qq($act)} eq 'no'
		  and return PERM_NG;

		PERM_OK;
	    }
	};
	eval $func;
	if ($@) {
	    die $@;
	}
    }
}

sub _user_info($) {
    my $uid = shift;
    DB->selectrow_hashref(
	q{SELECT * FROM user_info WHERE uid=?}, undef, $uid);
}

sub LOGINNED_P($) {
    goto &LOGGED_IN_P;
}

sub LOGGED_IN_P($) {
    my $req = $_[0]; # HTTP::Request

    defined LOGIN_UID($req);
}

sub LOGIN_UID($) {
    # ログインしてゐる人物のuidを返す。
    # 正當なログインでない、またはログインをしてゐない場合はundefを返す。
    my $req = $_[0]; # HTTP::Request
    if ($_ = $req->header('Cookie')) {
	my %cookies = CGI::Cookie->parse($_);
	if (my $cookie = $cookies{'celaenito.auth'}) {
	    my $hash = eval {
		my %hash = $cookie->value;
		\%hash;
	    };
	    if ($hash) {
		my $uid  = defined $hash->{uid}    ? $hash->{uid}    : '';
		my $passwd = defined $hash->{passwd} ? $hash->{passwd} : '';

		if ($uid eq 'guest') {
		    return undef;
		}

		my $user_info = _user_info($uid);
		if (!$user_info) {
		    return undef;
		}

		if ($user_info->{passwd} ne '') {
		    $user_info->{passwd} ne $passwd
		      and return undef;
		}

		return $uid;
	    }
	}
    }
    undef;
}

sub LOGIN_USERNAME ($) {
    my $request = $_[0]; # HTTP::Request

    my $uid = LOGIN_UID($request);
    defined $uid or $uid = 'guest';

    my $user_info = _user_info($uid);
    $user_info ? $user_info->{name} : undef;
}

sub LOGIN_PASSWD ($) {
    my $request = $_[0]; # HTTP::Request

    my $uid = LOGIN_UID($request);
    defined $uid or $uid = 'guest';

    my $user_info = _user_info($uid);
    $user_info ? $user_info->{passwd} : undef;
}

sub SET_LOGIN ($$$;$) {
    # HTTP::Responseに認證の爲のCookie:ヘッダを付加する。
    # 正當なログインであれば1を、さうでなければundefを返す。
    # $expire: undefまたは'+30d'形式(CGI.pm)の文字列。
    my ($response, $uid, $passwd, $expire) = @_;

    if ($uid eq 'guest') {
	return;
    }
    
    my $user_info = _user_info($uid);
    if ($user_info) {
	if ($user_info->{passwd} eq $passwd) {
	    my $cookie = CGI::Cookie->new(
		-name  => 'celaenito.auth',
		-value => {
		    uid    => $uid,
		    passwd => $passwd,
		},
		($expire ?
		   (-expires => $expire) : ()),
		-path  => '/',
	       );
	    $response->header('Set-Cookie' => $cookie->as_string);
	    return 1;
	}
    }
    return;
}

sub UNSET_LOGIN($) {
    # HTTP::Response に認証解除の爲の Cookie: ヘッダを付加する。
    my $response = shift;

    my $cookie = CGI::Cookie->new(
	-name    => 'celaenito.auth',
	-expires => '-1y',
	-path    => '/',
       );
    $response->header('Set-Cookie' => $cookie->as_string);
}

sub UPDATE_LOGIN ($$;$) {
    # ログインが行はれてゐる時、そのexpire時刻を再設定する。
    # さうでなければ何もしない。
    my ($request, $response, $expire) = @_;
    LOGGED_IN_P($request) or return;

    my $uid = LOGIN_UID($request);
    my $passwd = LOGIN_PASSWD($request);
    SET_LOGIN($response, $uid, $passwd, $expire);
}
		    
1;
