ginbox.pl

#!/usr/bin/perl
#
# Ginbox                                 (c) Andrew Flegg 2005
# ~~~~~~                                 Released under the Artistic Licence
#                                        mailto:andrew@bleb.org

use strict;
use warnings;

use Mail::Webmail::Gmail;
use Net::Server::POP3;
use Data::Dumper;

our $UID  = 65534;
our $GID  = 65534;
our $PORT = 110;

our $WELCOME = "ginbox v0.03 - http://www.bleb.org/tools/ginbox/";
our @LIST    = ();
our %DATA    = ();
our $GMAIL;

# -- Initialise server... --------------------------------------------------
#
my $server = Net::Server::POP3->new(
                    serveropts   => { user => $UID, group => $GID },
                    port         => $PORT,
                    authenticate => \&auth,
                    list         => \&list,
                    size         => \&size,
                    retrieve     => \&retr,
                    delete       => \&dele,
                    welcome      => $WELCOME,
                    uidl         => \&uidl,
             );

$server->startserver();
exit;


# -- Start a session against Gmail... --------------------------------------
#
sub auth {
  my ($username, $password, $ip) = @_;
  
  warn "$$ : Connection from $ip for $username\n";
 
  %DATA = map { (split(/=/, $_, 2), 'true')[0..1] } split /,/, $1 if $username =~ s/#(.*)$//;
  
  $GMAIL = Mail::Webmail::Gmail->new( username => $username,
                                      password => $password );
                              
  warn "$$: Got no gmail instance.\n" unless $GMAIL;
  return 0 unless $GMAIL;
  $GMAIL->login();
  warn "$$: Couldn't logon: ".$GMAIL->error_msg."\n" if $GMAIL->error();
  return 0 if $GMAIL->error();
  
  $DATA{label} ||= $Mail::Webmail::Gmail::FOLDERS{ 'INBOX' };
  $DATA{_user}   = $username;

  return 1;
}


# -- List the messages... --------------------------------------------------
#
sub list {
  @LIST = @{ $GMAIL->get_messages( label => $DATA{label} ) };

  #warn Dumper(\@LIST);

  my $base  = 0;#$$;
  my $start = 0 + $base;
  my $last  = $start + $#LIST;
  warn "$$ : List for $DATA{_user} returning $start -> $last\n";
  return $start..$last;
}


# -- Find a message's size... ----------------------------------------------
#
sub size {
   my ($username, $id) = @_;

   return int(rand(9999));
}


# -- Find a message's UID --------------------------------------------------
#
sub uidl {
   my ($id) = @_;

   my $msg = $LIST[$id];
   my $uidl = $msg->{id} || 0;

   warn "$$ : UIDL for $id is $uidl for $DATA{_user}\n";
   return $uidl;
}
  
  
# -- Retrieve a message... -------------------------------------------------
#
sub retr {
  my ($username, $id) = @_;
  warn "$$ : Retrieve message $id for $DATA{_user}\n";
  
  my $msg = $LIST[$id];
  $msg->{_source} ||= $GMAIL->get_mime_email( msg => $msg );

  return $msg->{_source};
}


# -- Delete a message... ---------------------------------------------------
#
sub dele {
  my ($username, $id) = @_;
  warn "$$ : Delete message $id for $DATA{_user}\n";
  
  $GMAIL->edit_archive( action => 'archive', 'msgid' => $LIST[$id]->{id} );
}