view release on metacpan or  search on metacpan

lib/Captive/Portal/Role/Session.pm  view on Meta::CPAN

    my ( $session, $error );
    try { $session = JSON->new->decode($slurp) } catch { $error = $_ };

    if ($error) {

        # JSON exception to logfile
        ERROR $error;

        return;
    }

    return $session;
}

=item $capo->write_session_handle($lock_handle, $session)

Encode the session hashref into JSON and write the session file belonging to $lock_handle.

=cut

sub write_session_handle {
    my $self = shift;

    my $fh = shift
      or LOGDIE "missing param 'file_handle'";

    my $session = shift
      or LOGDIE "missing param 'session'";

    DEBUG "write_session_handle";

    seek( $fh, 0, 0 ) or LOGDIE "Couldn't rewind session file: $!";
    truncate( $fh, 0 ) or LOGDIE "Couldn't truncate session file: $!";

    print $fh JSON->new->pretty->encode($session)
      or LOGDIE "Couldn't write session: $!";
}

=item $capo->delete_session_from_disk($key)

Unlink session file from disk.

=cut

sub delete_session_from_disk {
    my $self = shift;

    my $key = shift
      or LOGDIE "missing param 'session key'";

    DEBUG "delete session from disk '$key'";

    my $fname = $self->cfg->{SESSIONS_DIR} . "/$key";

    unlink $fname or die "Couldn't unlink '$fname': $!";
}

=item $capo->mk_cookie()

Generate a I<CaPo> cookie with random- and session-data or use the already existing session cookie. The cookie is used to fast reactivate an idle session if the IP/MAC/COOKIE is still matching. Cookies are not mandatory, they are just for a better us...

=cut

sub mk_cookie {
    my $self = shift;

    my $session = $self->{CTX}{SESSION}
      or LOGDIE "FATAL: missing 'SESSION' in run CTX,";

    my $query = $self->{CTX}{QUERY}
      or LOGDIE "FATAL: missing 'QUERY' in run CTX,";

    my $value;
    if ( $value = $session->{COOKIE} ) {
        DEBUG 'use stored cookie-value from session data';
    }
    else {
        DEBUG 'generate cookie with session- and random-data';

        $value = md5_hex(
                time()
              . $session->{IP}
              . $session->{MAC}
              . $session->{USERNAME}
              . int( rand(100000) ) );
    }

    my $cookie = $query->cookie(
        -name     => 'CaPo',
        -value    => $value,
        -httponly => 1,
        $self->cfg->{SSL_REQUIRED} ? ( -secure => 1 ) : (),
    ) or LOGDIE "Couldn't create cookie\n";

    return $cookie;
}

=item $capo->match_cookie()

Check if request cookie is equal session cookie. Returns true on success and false on failure.

=cut

sub match_cookie {
    my $self = shift;

    DEBUG "compare request cookie with session cookie";

    my $query = $self->{CTX}{QUERY}
      or LOGDIE "FATAL: missing 'QUERY' in run CTX,";

    my $session = $self->{CTX}{SESSION}
      or LOGDIE "FATAL: missing 'SESSION' in run CTX,";

    return unless $session->{COOKIE};

    my $request_cookie = $query->cookie('CaPo');
    return unless $request_cookie;

    return 1 if $request_cookie eq $session->{COOKIE};