# Selima Website Content Management System
# AuthDig.pm: The mod_perl HTTP digest authentication handler.

#  Copyright (c) 2004-2018 imacat.
#
#  Licensed under the Apache License, Version 2.0 (the "License");
#  you may not use this file except in compliance with the License.
#  You may obtain a copy of the License at
#
#      http://www.apache.org/licenses/LICENSE-2.0
#
#  Unless required by applicable law or agreed to in writing, software
#  distributed under the License is distributed on an "AS IS" BASIS,
#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
#  See the License for the specific language governing permissions and
#  limitations under the License.

# Author: imacat <imacat@mail.imacat.idv.tw>
# First written: 2004-09-12

package Selima::AuthDig;
use 5.008;
use strict;
use warnings;

use Apache::AuthDigest::API qw();
use CGI qw();
use Fcntl qw(:flock);
use File::Spec::Functions qw(catfile);

use Selima::Checker::LogIn;
use Selima::DataVars qw($AUTHINFO $IS_MP2 :db :input);
use Selima::DBI;
use Selima::HTTP;
use Selima::Init;
use Selima::LogIn;
use Selima::Session;

BEGIN {
if ($IS_MP2) {
    require Apache2::Const;
    import Apache2::Const qw(OK AUTH_REQUIRED);
} else {
    require Apache::Constants;
    import Apache::Constants qw(OK AUTH_REQUIRED);
}
}

# Full HTTP Digest Authentication is specified in RFC 2617

# handler: Handle the HTTP digest authentication
sub handler {
    local ($_, %_);
    my ($r, $rd, $d, $status, $response, $pkg);
    my ($form, $checker);
    $r = $_[0];
    $rd = Apache::AuthDigest::API->new($r);
    $d = new Selima::AuthDig::Destroy($rd);
    
    # Retrieve the authentication information
    ($status, $response) = $rd->get_digest_auth_response;
    # No authentication information available
    return $status unless $status == OK;
    
    # Initialize the environemnt
    $pkg = $r->dir_config("PACKAGE");
    initvars($pkg);
    
    # Logged out
    if (    defined($_ = $GET->param("logout"))
            && -e ($_ = catfile($Selima::Session::DIR, "logout_$_"))) {
        unlink $_;
        $rd->note_digest_auth_failure;
        return AUTH_REQUIRED;
    }
    
    # Connect to the database
    $DBH = Selima::DBI->new($DBI_TYPE);
    %_ = ("users" => LOCK_EX, "groups" => LOCK_SH, "usermem" => LOCK_SH);
    $DBH->lock(%_);
    
    # Check the password digest
    $form = new CGI("");
    $form->param("id", $rd->user);
    $checker = new Selima::Checker::LogIn($form);
    $checker->{"rd"} = $rd;
    $checker->{"response"} = $response;
    $checker->{"login"} = 1;
    $_ = $checker->check(qw(id authdig));
    
    # Failed
    if (defined $_) {
        $rd->note_digest_auth_failure;
        return AUTH_REQUIRED;
    }
    
    # Let $d->DESTROY release the database lock
    # We do not update user information here.  Updating user information
    #   requires initiating the session and set the session cookie SID.
    #   But cookies cannot be set under HTTP 304 Not Modified.  We are
    #   protecting the whole directory, where there are a lot of static
    #   contents, including the Magicat home index.html.  HTTP 304 occurs
    #   all the time, from the beginning of Magicat home entrance.
    #   Failing to set session cookie SID causes new sessions be
    #   reinitialited for every request.  The user visits accounting
    #   would become non-sense.  That accounting is important!
    # We update user information at the script executing phrase, where
    #   we have more control over the output, including the cookies
    #   and the HTTP 304 status.
    $AUTHINFO = $checker->{"row"};
    return OK;
}

# Selima::AuthDig::Destroy: Object to remove program data
package Selima::AuthDig::Destroy;

use 5.008;
use strict;
use warnings;

use Selima::DataVars qw($DBH);

# new: Initialize the destroyer
sub new : method {
    local ($_, %_);
    my ($class, $rd, $self);
    ($class, $rd) = @_;
    $self = bless {}, $class;
    $self->{"rd"} = $rd;
    return $self;
}

# DESTROY: Release the acquired locks
sub DESTROY : method {
    local ($_, %_);
    my ($self, $rd, $headers);
    $self = $_[0];
    $rd = $self->{"rd"};
    
    # Disconnect database handle
    if (defined $DBH) {
        $DBH->disconnect;
        undef $DBH;
    }
    
    # Destroy myself
    $self->SUPER::DESTROY if $self->can("SUPER::DESTROY");
    # I cannot really undefine myself ($_[0]) after all
    return;
}

return 1;