#/*
# *  Copyright 2007 hkrn <hikarin@users.sourceforge.jp>
# *
# *  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.
# */
#
# $Id: MailPost.pm 610 2007-05-09 14:49:15Z hikarin $
#

package Img0ch::App::MailPost;

use strict;
use base qw(Img0ch::App::BBS);
use Email::MIME qw();
use Mail::POP3Client qw();

sub new {
    my ( $iClass, $iKernel, @args ) = @_;
    my $iApp = $iClass->SUPER::new( $iKernel, @args );
    $iApp->{__from} = undef;
    $iApp->{_request}
        = Img0ch::App::MailPost::Request->new( Img0ch::Request->new(@args) );
    return $iApp;
}

sub run {
    my ($iApp)   = @_;
    my $mail_rec = [];
    my $fetch    = 0;
    $iApp->{_config}->get('Maintenance')
        and die 'img0ch MAINTENANCE: Please try again later.', "\n";

    if ( $iApp->get_mail_via_pop3($mail_rec) ) {
        my @args = (
            'mobile', 'shiftjis',
            sub { ${ $_[0] } =~ s/\n//gxms; ${ $_[0] } },
            \&send_error_mail
        );
        $iApp->set_parameters_from_mail($mail_rec)
            or return $iApp->redirect_error(@args);
        $iApp->validate()     or return $iApp->redirect_error(@args);
        $iApp->is_writeable() or return $iApp->redirect_error(@args);
        $iApp->get_date();
        $iApp->post() or return $iApp->redirect_error(@args);
        $iApp->update_subback( undef, 1 );
        $iApp->update_index();
        $fetch++;
    }
    $iApp->redirect_success($fetch);
    return 1;
}

sub redirect_success {
    my ( $iApp, $fetch ) = @_;
    my $iBBS     = $iApp->bbs();
    my $iConfig  = $iApp->{_config};
    my $iRequest = $iApp->{_request};

    if ( !$iBBS ) {
        require Img0ch::BBS;
        my $iKernel = $iApp->kernel();
        my @path = split '/', $iRequest->path_info();
        $path[1] =~ /\A([\w\-]+)\z/xms;
        $iBBS = Img0ch::BBS->new( $iKernel, { bbs => $1 } );
    }

    require Img0ch::Metadata;
    require Img0ch::Template;
    my $iMeta     = Img0ch::Metadata->new($iBBS);
    my $iTemplate = Img0ch::Template->new(
        $iBBS,
        {   file    => 'mobile',
            request => $iRequest,
            setting => $iApp->setting(),
            version => $iRequest->credit(),
        }
    );
    $iTemplate->param(
        {   Banner  => $iMeta->mobile_banner(),
            Flag    => 0,
            Fetch   => $fetch,
            Referer => $iRequest->get_header('referer') || '""',
        }
    );

    my $charset = $iConfig->get('DefaultCharset');
    $iRequest->send_http_header( 'text/html', $charset );
    $iTemplate->flush( sub { ${ $_[0] } =~ s/\n//gxms; ${ $_[0] } } );
    1;
}

sub get_mail_via_pop3 {
    my ( $iApp, $mail_rec ) = @_;
    my $iConfig = $iApp->{_config};
    my $iKernel = $iApp->kernel();
    my $pop3    = Mail::POP3Client->new(
        HOST =>
            ( $iConfig->get('pop3.server') || $iConfig->get('POP3Server') ),
        PORT => ( $iConfig->get('pop3.port') || 110 ),
        USESSL => ( $iConfig->get('pop3.ssl') ? 1 : 0 ),
        TIMEOUT => 5
    );

    $pop3->User( $iConfig->get('pop3.user') || $iConfig->get('POP3User') );
    $pop3->Pass( $iConfig->get('pop3.pass') || $iConfig->get('POP3Pass') );
    if ( $pop3->Connect() >= 0 ) {
        if ( my $i = $pop3->Count() ) {
            @$mail_rec = split /\r\n/xms, $pop3->HeadAndBody($i);
            $pop3->Delete($i)
                or $iKernel->throw_exception( $pop3->Message() );
            $pop3->Close();
            return 1;
        }
        return 0;
    }
    else {
        $iKernel->throw_exception( $pop3->Message() );
    }
}

sub send_error_mail {
    my ( $iApp, $message ) = @_;
    my $iKernel = $iApp->kernel();
    my $iConfig = $iKernel->get_config();
    my $from    = $iConfig->get('MailRawAddress');
    my $to      = $iApp->{__from};

    require Unicode::Japanese;
    $message =~ s{<br\s?/?>}{\n}gxms;
    my $message_jis = Unicode::Japanese->new( $message, 'auto' )->jis();

    require Email::Send;
    my $sender;
    if ( my $sendmail = $iConfig->get('SendmailPath') ) {
        $sender = Email::Send->new( { mailer => 'Sendmail' } );
        $Email::Send::Sendmail::SENDMAIL = $sendmail;
    }
    elsif ( my $qmail = $iConfig->get('QmailPath') ) {
        $sender = Email::Send->new( { mailer => 'Qmail' } );
        $Email::Send::Qmail::QMAIL = $qmail;
    }
    else {
        my $host = $iConfig->get('smtp.host');
        my $port = $iConfig->get_int('smtp.port');
        $port and $host = join ':', $host, $port;
        $sender = Email::Send->new( { mailer => 'SMTP' } );
        $sender->mailer_args(
            [   Host => $host,
                ssl  => $iConfig->get('smtp.ssl'),
                tls  => $iConfig->get('smtp.tls'),
            ]
        );
    }

    require Img0ch::Template;
    my $iTemplate
        = Img0ch::Template->new( $iKernel, { file => 'mobile_error_mail' } );
    $iTemplate->param(
        {   From    => $from,
            To      => $to,
            Message => $message_jis,
        }
    );
    my $result = $sender->send( ${ $iTemplate->to_string() } );
    $result or $iKernel->throw_exception($result);
    return;
}

sub set_parameters_from_mail {
    my ( $iApp, $mail_rec ) = @_;
    my $iConfig  = $iApp->{_config};
    my $iKernel  = $iApp->kernel();
    my $iRequest = $iApp->request();

    map {tr/\r\n//d} @$mail_rec;    ## no critic
    my $mime = Email::MIME->new( join "\r\n", @$mail_rec );
    $iApp->_get_host( $iConfig, $mime ) or return 0;

    require Unicode::Japanese;
    my $found = 0;
    for my $part ( $mime->parts() ) {
        if ( my $fn = $part->filename() ) {
            my $cte = $part->header('Content-Transfer-Encoding');
            if ( $cte =~ s/\s+//gxms ) {
                $part->header_set( 'Content-Transfer-Encoding', $cte );
            }
            require File::Temp;
            my ( $fh, $temp ) = File::Temp::tempfile( UNLINK => 1 );
            binmode $fh;
            print {$fh} $part->body();
            close $fh;
            $iRequest->upload_internal( $temp, $fn );
            $found++;
        }
        else {
            $iApp->_parse_body( \$part->body() ) or return 0;
        }
    }
    if ( !$found ) {
        $iApp->set_error('INVALID_MAILPOST');
        return 0;
    }

    my $subject
        = Unicode::Japanese->new( $mime->header('Subject'), 'auto' )->sjis();
    $subject =~ s/\A\s+//xms;
    $subject =~ s/\s+\z//xms;
    $subject =~ s/(?:\r\n)+//gxms;
    $subject =~ s/\n+//gxms;
    _nonl($subject);
    if ( $subject =~ /(.*?)<>(.*)/xms ) {
        my ( $name, $mail ) = ( $1, $2 );
        $name =~ s/\s+\z//xms;
        $mail =~ s/\A\s+//xms;
        $iRequest->set_param_internal( 'FROM', $name );
        $iRequest->set_param_internal( 'mail', $mail );
    }
    else {
        $iRequest->set_param_internal( 'FROM', $subject );
        $iRequest->set_param_internal( 'mail', '' );
    }

    $iApp->init() or return 0;
    my $iSetting = $iApp->setting();
    if ( !$iSetting->is_checked('BBS_ACCEPT_MAILPOST') ) {
        $iApp->set_error('NOT_ACCEPT_ERROR');
        return 0;
    }

    1;
}

sub _parse_body {
    my ( $iApp, $body ) = @_;
    my $iRequest = $iApp->request();
    my ( $bbs, $key, $text ) = split '<>', $$body;

    $bbs ||= '';
    $key ||= '';
    if ( $bbs =~ /\A(?:\r\n)*([\w\-]+)\z/xms ) {
        $iRequest->set_param_internal( 'bbs', $1 );
        if ( $key =~ /\A(\d{9,10})\z/xms ) {
            $iRequest->set_param_internal( 'key', $1 );
            $text = Unicode::Japanese->new( $text, 'auto' )->sjis();
            _nonl($text);
            $text =~ s/\r\n/\n/gxms;
            $text =~ s/\n\n/\n/gxms;
            $text =~ s/\n+\z//gxms;
            $iRequest->set_param_internal( 'MESSAGE', $text );
            return 1;
        }
    }

    $iApp->set_error('INVALID_MAILPOST');
    return 0;
}

sub _get_host {
    my ( $iApp, $iConfig, $mime ) = @_;
    my $from;

    if ( !( $from = $mime->header('Reply-To') ) ) {
        if ( !( $from = $mime->header('Return-Path') ) ) {
            if ( !( $from = $mime->header('From') ) ) {
                $from = 'unknown';
            }
        }
    }

    $from =~ /<(.*?)>/xms and $from = $1;
    if ( !$iConfig->get('AcceptMailPostFromAnother') ) {
        if (    $from !~ /docomo\.ne\.jp/xms
            and $from !~ /ezweb\.ne\.jp/xms
            and $from !~ /jp-[dhtckrnsq]\.ne\.jp/xms
            and $from !~ /[dhtckrnsq]\.vodafone\.ne\.jp/xms
            and $from !~ /softbank\.ne\.jp/xms )
        {
            $iApp->set_error('MAILPOST_FROM_NOT_MOBILE_ADDRESS');
            return 0;
        }
    }
    $iApp->{__from} = $from;

    my $ip = $mime->header('Received') || '';
    $ip =~ /.+[\[\(]([\d\.]+)[\]\)]/ixms;
    $ip = $1 || '127.0.0.1';
    my $ip_int = pack 'C*', split( '\.', $ip );
    $iApp->{_ip}     = $ip;
    $iApp->{_ip_int} = $ip_int;
    $iApp->{_host}   = gethostbyaddr( $ip_int, 2 ) || $ip;

    require Digest::MD5;
    my $seed = $iConfig->get('Seed');
    $iApp->{_serial} = Digest::MD5::md5_hex( $from, $seed );
    1;
}

sub _nonl {
    $_[0] =~ s/\A(?:\r\n)+//xms;
    $_[0] =~ s/(?:\r\n)+\z//xms;
}

package Img0ch::App::MailPost::Request;

use base qw(Img0ch::Request::Interface);

BEGIN {
    my $pkg = __PACKAGE__;
    for my $method (
        qw(agent fh get_app_uri get_device_id
        get_remote_host is_mobile_device
        ip ip_int msec now path_info query)
        )
    {
        no strict 'refs';
        *{"${pkg}::${method}"} = sub { $_[0]->{__orig}->$method };
    }
}

sub new {
    my ( $iClass, $iRequest ) = @_;
    bless { __orig => $iRequest, __param => {} }, $iClass;
}

sub signature { $_[0]->{__orig}->signature() }

*credit = \&signature;

sub init {
    my ( $iRequest, $iConfig ) = @_;
    $iRequest->{__orig}->init($iConfig);
    my $bbs = $iRequest->param('bbs');
    $bbs =~ /\A([\w\-]+)\z/xms;
    $iRequest->{__bbs} = $1 || '';
    my $key = $iRequest->param('key');
    $key =~ /\A(\d\d\d\d\d\d\d\d\d\d?)\z/xms;
    $iRequest->{__key} = $1 || '';
    return 1;
}

sub param {
    my ( $iRequest, $key, $unescape ) = @_;
    $unescape ||= 0;

    if ( !wantarray ) {
        my $value = $iRequest->{__param}->{$key};
        if ( !$unescape ) {
            $value = Img0ch::Kernel::escape_html_entities($value);
        }
        return $value;
    }
    elsif ( wantarray and !$key ) {
        return keys %{ $iRequest->{__param} };
    }
    else {
        my $value = $iRequest->{__param}->{$key};
        return Img0ch::Kernel::escape_html_entities($value);
    }
}

sub get_header { shift->{__orig}->get_header(@_) }

sub set_header { shift->{__orig}->set_header(@_) }

sub is_uploadable {1}

sub fsize { $_[0]->{__fsize} }

sub cookie { shift->{__orig}->cookie(@_) }

sub send_http_header { shift->{__orig}->send_http_header(@_) }

sub print { shift->{__orig}->print(@_) }

sub set_param_internal {
    my ( $iRequest, $key, $value ) = @_;
    caller() eq 'Img0ch::App::MailPost' or return;
    $iRequest->{__param}->{$key} = $value;
    return;
}

sub upload_internal {
    my ( $iRequest, $tempfile, $filename ) = @_;
    caller() eq 'Img0ch::App::MailPost' or return;
    $iRequest->{__file}  = $filename;
    $iRequest->{__fsize} = -s $tempfile || 0;
    $iRequest->{__tmp}   = $tempfile;
    return;
}

1;
__END__
