=head1 NAME

skximap::core - The main IMAP server code.

=head1 SYNOPSIS

=cut

=head1 DESCRIPTION

This module provides the main driver for an IMAP server which can
be easily modified to present messages/folders for viewing.

=cut


package skximap::core;

use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);


#
#  Modules we use
#
use Email::Simple;

require Exporter;
require AutoLoader;

@ISA    = qw(Exporter AutoLoader);
@EXPORT = qw();

($VERSION) = '0.1';




=head2 new

  Create a new instance of this object.

=cut

sub new
{
    my ( $proto, %supplied ) = (@_);
    my $class = ref($proto) || $proto;

    my $self = {};

    #
    #  The helper for working with classes, etc.
    #
    $self->{ 'helper' } = $supplied{ 'helper' } ||
      die "No helper class supplied";

    #
    #  Logfile, if any
    #
    $self->{ 'logfile' } = $supplied{ 'logfile' } || undef;

    #
    #  Default folder is "INBOX".  Default username is unset.
    #
    $self->{'folder'} = "INBOX";
    $self->{'login'}  = undef;

    #
    #  Exit the runloop when zero.
    #
    $self->{ 'run' } = 1;

    bless( $self, $class );
    return $self;

}


=head2 logLine

  Log a line of input.

=end doc

=cut

sub logLine
{
    my( $self, $line ) = ( @_ );

    #
    #  Log the line if we're supposed to.
    #
    if ( $self->{ 'logfile' } )
    {
        if ( open( LOG, ">>", $self->{ 'logfile' } ) )
        {
            print LOG $line . "\n";
            close(LOG);
        }
    }
}



=head2 run

  Print our opening banner and continuously run until
 we're done.

=end doc

=cut

sub run
{
    my ($self) = (@_);

    print "* OK IMAP4 READY\n";

    #
    #  Command loop
    #
    while ( $self->{ 'run' } && ( my $line = <> ) )
    {
        # strip newline.
        $line =~ s/[\r\n]//g;

        # log the input, if we should
        $self->logLine( $line );

        # process the line of text.
        $self->handle_input($line);
    }
}


=begin doc

  Handle a complete line of input from the client, dispatching
 appropriately.

=end doc

=cut

sub handle_input
{
    my ( $self, $line ) = (@_);

    #
    # tokenize input
    #
    my ( $tag, $cmd, @args ) = split( /[ ]/, $line );


    if ( !defined($tag) ||
         !length($tag) ||
         !defined($cmd) ||
         !length($cmd) )
    {
        print ". BAD missing command\n";
        return;
    }

    #
    #  Logout.
    #
    if ( $cmd =~ /^logout$/i )
    {
        print "$tag OK LOGOUT\n";
        $self->{ 'run' } = 0;
        return;
    }

    #
    #  NOOP.
    #
    elsif ( $cmd =~ /^noop$/i )
    {
        print "$tag OK NOOP\n";
        return;
    }

    #
    #  Login
    #
    elsif ( $cmd =~ /^login/i )
    {
        if ( $self->{ 'helper' }->login( $args[0], $args[1] ) )
        {

            # save logged in username
            $self->{ 'login' } = $args[0];

            print "$tag OK LOGIN $args[0]\n";
        }
        else
        {
            print "$tag BAD LOGIN FAILED FOR $args[0]\n";
        }
        return;
    }

    #
    #  List folders / subscriptions
    #
    elsif ( ( $cmd =~ /^list$/i ) ||
            ( $cmd =~ /^lsub$/i ) )
    {

        #
        #  Make sure user is logged in.
        #
        if ( !$self->{ 'login' } )
        {
            print "$tag BAD LOGIN REQUIRED\n";
            return;
        }

        my @folders = $self->{ 'helper' }->get_folders( $self->{ 'login' } );

        if ( scalar(@folders) )
        {
            foreach my $f (@folders)
            {
                print "* $cmd (\\HasNoChildren) \"|\" $f\n";
            }
            print "$tag OK\n";
        }
        else
        {
            print "$tag BAD FOLDER LIST FAILED\n";
        }
        return;
    }

    #
    #  select folder
    #
    elsif ( $cmd =~ /^select$/i )
    {
        my $folder = $args[0];

        #
        #  Remove quotes, if present.
        #
        if ( $folder =~ /^['"](.*)['"]$/ )
        {
            $folder = $1;
        }

        #
        #  Make sure user is logged in.
        #
        if ( !$self->{ 'login' } )
        {
            print "$tag BAD LOGIN REQUIRED\n";
            return;
        }

        #
        #  Record the folder.
        #
        $self->{ 'folder' } = $folder;

        my ($total,$unread) =
          $self->{ 'helper' }->count_messages( $self->{ 'login' }, $folder );
        print <<EOF;
* FLAGS (\\Recent \\Seen)
* OK [PERMANENTFLAGS (\\Seen \\Recent)]
* $total EXISTS
* $unread RECENT
$tag OK [READ-WRITE] Completed
EOF
        return;
    }

    #
    #  Store - we pretend it was ok
    #
    if ( ( ( $cmd =~ /^uid$/i ) && ( $args[0] =~ /store/i ) ) ||
         ( $cmd =~ /^store$/i ) )
    {

        #
        #  Make sure user is logged in.
        #
        if ( !$self->{ 'login' } )
        {
            print "$tag BAD LOGIN REQUIRED\n";
            next;
        }

        print "$tag OK STORE COMPLETED (haha)\n";
        return;
    }

    #
    #  Fetch - this is a real pain....
    #
    if ( ( ( $cmd =~ /^uid$/i ) && ( $args[0] =~ /fetch/i ) ) ||
         ( $cmd =~ /^fetch$/i ) )
    {

        #
        #  Make sure user is logged in.
        #
        if ( !$self->{ 'login' } )
        {
            print "$tag BAD LOGIN REQUIRED\n";
            return;
        }


        #
        #  The complete line.
        #
        my $line = $cmd . " " . join( " ", @args );

        #
        #  Split into the range to fetch and the type of fetch.
        #
        my $start = undef;
        my $end   = undef;
        my $type  = undef;

        if ( $line =~ /fetch ([^ ]+) (.*)$/i )
        {
            $type = $2;
            my $range = $1;

            #
            #  The type of fetch.
            #
            if ( $type =~ /^\((.*)\)$/ )
            {
                $type = $1;
            }


            if ( $range =~ /([0-9]+):([0-9]+)/ )
            {

                #
                #  Explicit start & end.
                #
                $start = $1;
                $end   = $2;
            }
            elsif ( $range =~ /([0-9]+):\*/ )
            {

                #
                #  From the start to the end.
                #
                $start = $1;
                ($end,undef) =
                  $self->{ 'helper' }
                  ->count_messages( $self->{ 'login' }, $self->{ 'folder' } );
            }
            elsif ( $range =~ /([0-9]+)/ )
            {

                #
                #  Start only.
                #
                $start = $1;
                $end   = $start;
            }

        }
        else
        {
            print "$tag FAILED TO PARSE: $line\n";
            return;
        }


        #
        #  OK we have a range of either "N", "N:M", "N:*" and we now
        # need to determine what to return from the input flags.
        #
        #
        #  For example we might receive:
        #
        #  1 UID FETCH 1:* (FLAGS)
        #
        #   -> Fetch only "FLAGS" for all messages.
        #
        #  Or:
        #
        #  BLAH FETCH 1:1 (UID FLAGS INTERNALDATE RFC822.SIZE BODY.PEEK[HEADER.FIELDS (DATE FROM SUBJECT TO CC MESSAGE-ID REFERENCES CONTENT-TYPE CONTENT-DESCRIPTION IN-REPLY-TO REPLY-TO LINES LIST-POST X-LABEL)])
        #
        #  Which means we need to return "UID", "FLAGS", "DATE", "Size",
        # and some headers from the message.
        #
        #  The code here is designed to tokenize the input and do a *reasonable*
        # job of handling it it is not complete, but seems sufficient to
        # make mutt+icedove happy.
        #
        #
        my $i = $start;


        #
        #  For each message we've been given.
        #
        while ( $i <= $end )
        {

            # the line we'll output
            my $out  = "* $i FETCH (";
            my $msg  = "";
            my $safe = $type;

            #
            #  We take a copy of the flags to fetch because we dont know
            # if we're gonna do one message or N messages.
            #
            #  Split the "what to fetch" on spaces, and push output
            # which can be recognised.
            #
            #
            #  NOTE:  Potential for infinite loop here - if we still
            #        have tokens we don't handle or recognise.
            #
            my $c = 0;
            while ( length($safe) && ( $c < 50 ) )
            {
                    $c+=1;
                $safe =~ s/^\s+|\s+$//g;


                # SIZE
                if ( $safe =~ /RFC822.SIZE(.*)/i )
                {
                    $safe = $1;

                    my $email =
                      $self->{ 'helper' }
                      ->get_message( $self->{ 'folder' }, $i );
                    my $size = length( $email->as_string() );
                    $out .= "RFC822.SIZE $size ";
                    next;
                }

                # FLAGS
                if ( $safe =~ /FLAGS(.*)/i )
                {
                    $safe = $1;

                    $out .= "FLAGS (\\Recent) UID $i ";
                    next;
                }

                #
                #  Header fields
                #
                if ( $safe =~ /BODY.PEEK\[HEADER.FIELDS \((.*)\)\](.*)/i )
                {
                    $safe = $2;

                    my $header = $1;
                    my $email =
                      $self->{ 'helper' }
                      ->get_message( $self->{ 'folder' }, $i );

                    $out .= " BODY[HEADER.FIELDS ($header)]";
                    foreach my $h ( split( / /, $header ) )
                    {
                        $msg .=
                          "$h: " . ( $email->header($h) || "none" ) . "\n";
                    }
                    next;
                }

                #
                #  Complete body
                #
                if (( $safe =~ /BODY\[\](.*)/ ) ||
                    ( $safe =~ /BODY\.PEEK\[\](.*)/ ) )
                {
                    $safe = $1;

                    my $email =
                      $self->{ 'helper' }
                      ->get_message( $self->{ 'folder' }, $i );

                    $out .= "BODY[]";
                    $msg = $email->as_string() . "\n";
                    next;
                }
            }

            #
            #  Move on to the next message.
            #
            $i += 1;

            # remove trailing space - icedove doesn't like it.  Sigh.
            $out =~ s/[ \t]+$//g;

            print $out;

            if ($msg)
            {
                $msg =~ s/\r//g;
                my $len = length($msg);
                print " {$len}\n";
                print $msg . "\n" . ")";
            }
            else
            {
                print ")";
            }
            print "\n";
        }
        print "$tag OK Fetch Completed\n";
        return;
    }

    #
    #  Explicitly not supported
    #
    elsif ( $cmd =~ /^(delete|rename|create)$/i )
    {

        #
        #  Make sure user is logged in.
        #
        if ( !$self->{ 'login' } )
        {
            print "$tag BAD LOGIN REQUIRED\n";
            next;
        }

        print "$tag OK not supported: $cmd\n";
        return;
    }

    #
    #  list capabilities
    #
    elsif ( $cmd =~ /^capability$/i )
    {
        print "* CAPABILITY IMAP4rev1 AUTH=LOGIN\n";
        print "$tag OK\n";
        return;
    }

    #
    #  Unknown
    #
    else
    {
        print $tag . " BAD Unknown cmd $cmd\n";
    }
}

1;