POP

下のPerlのスクリプトで、POPのメールのソフト（Outlook Express、Mozilla Thunderbirdなど）でミクシィのメールをアクセス出来ます。

http://www.donzoko.net/source/mixi_pop3/mixi_pop3.pl.txt


#!/usr/bin/perl -T
$| = 1;
##############################################################################
# This is POP3 gateway server which retrieves your messages from mixi.
# http://mixi.jp/
#
# require : Perl 5.6 or later.
# Depend : Net::Server, Net::Server::POP3, DateTime,
# DateTime::Format::Mail, WWW::Mixi, Jcode, Digest::MD5
# author : makamaka [at] donzoko.net
# license : same as Perl's
#
# original code from Net-Server-POP3's scripts/simpletest.pl
# See : http://search.cpan.org/~jonadab/Net-Server-POP3-0.0009/
#
# See Also : http://search.cpan.org/dist/WWW-Mixi/
##############################################################################
# (default example)
#-----------------------------------------------------------------------------
# $ su
# # cd your_favorite_dir
# # mkdir tmp
# # chown nobody: tmp
# # ./mixi_pop3.pl
#-----------------------------------------------------------------------------
# If you want to stop the server, please use kill.
##############################################################################
use strict;
use warnings;
use lib qw(./lib);

use Net::Server::POP3;
use DateTime;
use DateTime::Format::Mail;
use Jcode;
use Digest::MD5;

use WWW::Mixi;
##############################################################################
# Set your server options
##############################################################################
my $Tempdir = './tmp'; # message digests
my $Port = 110; # by default 110
my $Welcome = 'Welcome to mixi_pop3 gateway (based on Net::Server::POP3)';
# (perldoc Net::Server::POP3)
my $Serveropts = { user => 'nobody', group => 'nobody', log_level => 3 };
##############################################################################
our $VERSION = 0.11;
our $DEBUG = 0;

my $newmsgnum;
my $Inbox = { mail => [] };

my $server = Net::Server::POP3->new(
port => $Port,
serveropts => $Serveropts,
authenticate => \&authenticate,
list => \&list,
retrieve => \&retrieve,
size => \&size,
delete => \&delete,
EOL => "\r\n",
welcome => $Welcome,
 );

$server->startserver();

##############################################################################

sub authenticate {
my ($user, $pass, $ip) = @_;
my $mixi = WWW::Mixi->new($user,$pass, -abort => sub { 0; });

if(!$mixi->login){
return 0;
 }

if(! @{$Inbox->{mail}}){
my $rv = _get_mixi_messages($mixi, $user, $pass, $ip);

$Inbox->{user_digest} = Digest::MD5::md5_hex($user);

%{$Inbox->{msgid}} = map{ ($_->[0] => $_) } @{$rv->[0]};
%{$Inbox->{digest}} = %{$rv->[1]};

push @{$Inbox->{mail}}, @{$rv->[0]};
 }

return 1;
 }

sub list {
my ($username) = @_;
return map { $_->[0] } @{$Inbox->{mail}};
 }

sub retrieve {
warn "Attempting to retrieve @_\n" if $DEBUG;
my ($username, $msgid) = @_;
my $mail = $Inbox->{msgid}->{$msgid};
my $msg = $mail->[1];
warn "$msg\n" if $DEBUG;
return $msg;
 }

sub size {
warn "Attempting to find size of @_\n" if $DEBUG;
my ($username, $msgid) = @_;
my $mail = $Inbox->{msgid}->{$msgid};
my $len = length $mail->[1];
warn "Found size: $len\n" if $DEBUG;
return $len;
 }

sub newmessage {
++$newmsgnum;
my ($username, $message) = @_;

my ($year,$mon,$day,$hour,$min)
= $message->{time} =~ m{(\d{4})/(\d{2})/(\d{2}) (\d{2}):(\d{2})};

my $dt = DateTime->new(
year => $year, month => $mon, day => $day, hour => $hour,
minute=> $min, second=> 0, time_zone => 'Asia/Tokyo',
 );

my $stamp = sprintf("%04d%02d%02d%02d%02d%02d%05d",
$dt->year(), $dt->month(), $dt->day(), $dt->hour(), $dt->min(),
$dt->sec(), $newmsgnum
 );

my ($mixi_id) = $message->{link} =~ /\?id=(\w+)/;
my $dateheader = DateTime::Format::Mail->format_datetime($dt);
my $newmsgid = "miximsg$mixi_id.$stamp\@test.mixi.example.com";

my $name = $message->{name};
my $subject = $message->{subject};
my $description = $message->{description};
my $reply = $message->{reply_action};

$description =~ s/\r/\n/g;

$name = jcode($name,'euc')->mime_encode;
$description = jcode($description,'euc')->iso_2022_jp;
$subject = jcode($subject,'euc')->mime_encode;

my $newmsgtext = <<"MESSAGE";
Received: from /dev/random by mixi_pop3
From: $name <$mixi_id\@mixi.pop3.localhost>
To: $username
Precedence: bulk
Message-ID: $newmsgid
Subject: $subject
Content-Type: text/plain; charset=iso-2022-jp
Date: $dateheader

$description
----
Reply : $reply
MESSAGE
return [$newmsgid, $newmsgtext];
 }

sub delete { # virtual dele
my ($username, $msgid) = @_;
my $mail = $Inbox->{msgid}->{$msgid};
my $user_digest = $Inbox->{user_digest};
my $digest = $Inbox->{digest}->{$msgid};

_mark_dele($user_digest,$digest);
 }

####

sub _get_mixi_messages { warn "ok get mixi message...\n" if($DEBUG);
my ($mixi, $user, $pass, $ip) = @_;
my @items = $mixi->get_list_message();
my (@box,%digest);

my $user_digest = Digest::MD5::md5_hex($user);
my $digest_list = _list_digest($user_digest); # return hashref

for my $item (reverse @items){
my $digest = Digest::MD5::md5_hex($item->{link});

# if exists, return message. dele marked, return 0. otherwise undef.
if( defined( my $content = _get_digest($user_digest,$digest)) ){
if($content){
my ($msgid,$message) = split/\n/,$content,2;
push @box, [$msgid,$message];
$digest{$msgid} = $digest;
}
delete $digest_list->{$digest};
}
else{
my $mail = $mixi->get_view_message($item->{link});
my %action
= map{ ($_->{command} => $_->{action}) } $mixi->parse_view_message_form();
$mail->{reply_action} = $action{reply_message};
my $data = newmessage($user, $mail);
push @box, $data;
$digest{$data->[0]} = $digest;
_make_digest($user_digest, $digest, $data);
}
 }

for my $must_del (keys %$digest_list){
_delete_digest($user_digest,$must_del);
 }

return [\@box,\%digest];
 }

sub _mark_dele {
my ($dir,$digest) = @_;

unless(-e "$Tempdir/$dir/$digest"){
warn "$Tempdir/$dir/$digest is already deleted.\n";
return;
 }

rename "$Tempdir/$dir/$digest","$Tempdir/$dir/.$digest";
 }

sub _delete_digest {
my ($dir,$digest) = @_;

if(-e "$Tempdir/$dir/$digest"){
unlink "$Tempdir/$dir/$digest" or warn $!;
}
elsif(-e "$Tempdir/$dir/.$digest"){
unlink "$Tempdir/$dir/.$digest" or warn $!;
}
 }

sub _get_digest {
my ($dir,$digest) = @_;

unless(-d "$Tempdir/$dir"){
mkdir "$Tempdir/$dir" or warn $!;
 }

my $normal = -e "$Tempdir/$dir/$digest";
my $dele = -e "$Tempdir/$dir/.$digest";

return undef if(!$normal and !$dele);
return 0 if($dele);

local $/ = undef;
open(FILE,"$Tempdir/$dir/$digest") or return;
my $content = ;
 close(FILE);

$content;
 }

sub _list_digest {
my ($dir) = @_;
my %hash;

return {} unless(-d "$Tempdir/$dir");

opendir(DIR,"$Tempdir/$dir") or warn $!;
while(my $file = readdir(DIR)){
next unless(-f "$Tempdir/$dir/$file");
($file) = $file =~ /\/?\.?(\w+)$/;
$hash{$file} = 1;
}
 closedir(DIR);

return \%hash;
 }

sub _make_digest {
my ($dir,$digest,$data) = @_;
my ($msgid,$message) = ($data->[0],$data->[1]);
open(FILE,">$Tempdir/$dir/$digest") or warn $!;
print FILE join("\n",$msgid,$message);
close(FILE);
}