view release on metacpan or  search on metacpan

plugins/demo/webmail  view on Meta::CPAN

#!/usr/bin/perl -w

use Digest::SHA1 qw(sha1_hex);
use AxKit2::Utils qw(xml_escape);
use Net::IMAP::Simple::NB;
use Matts::Message::Parser;
use Scalar::Util qw(weaken isweak);
use Data::Pageset;
use Time::Piece qw(gmtime);
use Text::Wrap qw(wrap);
use File::Temp qw(tempfile);

my %imap_cache;
my %password_cache;

sub conf_IMAP_Server;
sub conf_IMAP_Port;

sub register {
    my $self = shift;
    $self->register_hook('xmlresponse' => 'main_response');
    $self->register_hook('xmlresponse' => 'main_response_cont');
    $self->register_hook('xmlresponse' => 'auth_response');
    $self->register_hook('xmlresponse' => 'auth_response_cont');
}

sub main_response {
    my ($self, $input) = @_;
    
    my $client  = $self->client;
    my $headers = $client->headers_in;
    
    $client->notes('mail_response', DECLINED);
    
    my $cookie  = $headers->cookie('mail_session');
    
    # No cookie, skip to auth
    return DECLINED unless $cookie;
    
    # Cookie invalid/expired, skip to auth
    my $login = eval { decookie($cookie) };
    if ($@) {
        $self->log(LOGINFO, $@);
        $client->notes('cookie_failure', $@);
        return DECLINED;
    }
    
    my $server = shift @{ $imap_cache{$login} || [] };
    if ($server) {
        my $bref = $server->read(1);
        if (!defined $bref) {
            # connection went away, login again
            return $self->imap_login($input, $client, $headers, $login, $password_cache{$login}) if $password_cache{$login};
            return DECLINED; # if password isn't currently stored for some reason
        }
    }
    else {
        return $self->imap_login($input, $client, $headers, $login, $password_cache{$login}) if $password_cache{$login};
        return DECLINED; # if password isn't currently stored for some reason
    }
    
    push @{ $imap_cache{$login} }, $server;
    
    $self->display_page($input, $client, $headers, $login);
    
    # Everything IMAP happens as a continuation
    return CONTINUATION;
}

sub main_response_cont {
    my ($self, $input) = @_;
    
    if ($self->client->notes('mail_response') == OK) {
        return OK, $input;
    }
    return $self->client->notes('mail_response');
}

*auth_response_cont = \&main_response_cont;

sub auth_response {
    my ($self, $input, $headers) = @_;
    
    $self->log(LOGDEBUG, "Sending login page");
    
    my $client = $self->client;
    $client->notes('mail_response', DECLINED);
    
    # display login page
    if ($client->headers_in->request_method eq 'GET') {
        return $self->display_login($input, $client, $headers);
    }
    else {
        my $login    = $client->param('login');
        my $password = $client->param('password');
        
        return $self->imap_login($input, $client, $headers, $login, $password);
    }
}