Skip to content

Instantly share code, notes, and snippets.

/testimap.py

Created November 30, 2014 01:01
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save anonymous/940ba305737195e0682b to your computer and use it in GitHub Desktop.
Save anonymous/940ba305737195e0682b to your computer and use it in GitHub Desktop.
Download ZIP
trivial-serverB.pl & testimap.py
Raw
testimap.py
import sys
import imaplib
import email
# script tested w/ Python 2.7 and 3.2
# http://stackoverflow.com/questions/351656/how-do-i-mock-an-imap-server-in-python-despite-extreme-laziness
# http://stackoverflow.com/questions/13210737/get-only-new-emails-imaplib-and-python
# http://stackoverflow.com/questions/18678827/undoing-marked-as-read-status-of-emails-fetched-with-imaplib/27201941#27201941
# http://www.skytale.net/blog/archives/23-Manual-IMAP.html
if sys.version_info[0] < 3: # python 2.7
def uttc(x):
return x
else: # python 3+
def uttc(x):
return x.decode("utf-8")
imap_user = 'nobody'
imap_password = 'whatever'
# "If host is not specified, '' (the local host) is used"
imap_server = 'localhost'
# '127.0.0.1' may give "Connection refused";
# '' may give "socket.gaierror: [Errno -2] Name or service not known"
#~ conn = imaplib.IMAP4_SSL(imap_server)
conn = imaplib.IMAP4(imap_server)
conn.debug = 4
try:
(retcode, capabilities) = conn.login(imap_user, imap_password)
except:
print(sys.exc_info()[1])
sys.exit(1)
# http://stackoverflow.com/questions/12490648/imap-fetch-subject
# https://mail.python.org/pipermail/python-list/2009-March/527020.html
# http://www.thecodingforums.com/threads/re-imaplib-fetch-message-flags.673872/
#~ conn.select(readonly=1) # Select inbox or default namespace
# not readonly, else we cannot modify the \Seen flag later
import pprint
conn.select() # Select inbox or default namespace
(retcode, messages) = conn.search(None, '(UNSEEN)')
if retcode == 'OK':
for num in uttc(messages[0]).split(' '):
if not(num):
print("No messages available: num is `{0}`!".format(num))
break
print('Processing message: {0}'.format(num))
typ, data = conn.fetch(num,'(FLAGS)')
isSeen = ( "Seen" in uttc(data[0]) )
print('Got flags: {2}: {0} .. {1}'.format(typ,data, # NEW: OK .. ['1 (FLAGS ())']
"Seen" if isSeen else "NEW"))
print('Peeking headers, message: {0} '.format(num))
typ, data = conn.fetch(num,'(BODY.PEEK[HEADER])')
pprint.pprint(data)
typ, data = conn.fetch(num,'(FLAGS)')
isSeen = ( "Seen" in uttc(data[0]) )
print('Got flags: {2}: {0} .. {1}'.format(typ,data, # NEW: OK .. ['1 (FLAGS ())']
"Seen" if isSeen else "NEW"))
print('Get RFC822 body, message: {0} '.format(num))
typ, data = conn.fetch(num,'(RFC822)')
msg = email.message_from_string(uttc(data[0][1]))
typ, data = conn.fetch(num,'(FLAGS)')
isSeen = ( "Seen" in uttc(data[0]) )
print('Got flags: {2}: {0} .. {1}'.format(typ,data, # NEW: OK .. ['1 (FLAGS ())']
"Seen" if isSeen else "NEW"))
print('Get headers, message: {0} '.format(num))
typ, data = conn.fetch(num,'(BODY[HEADER])') # note, FLAGS (\\Seen) is now in data, even if not explicitly requested!
pprint.pprint(data)
typ, data = conn.fetch(num,'(FLAGS)')
isSeen = ( "Seen" in uttc(data[0]) )
print('Got flags: {2}: {0} .. {1}'.format(typ,data, # Seen: OK .. ['1 (FLAGS (\\Seen))']
"Seen" if isSeen else "NEW"))
conn.select() # select again, to see flags server side
# * OK [UNSEEN 0] # no more unseen messages (if there was only one msg in folder)
print('Restoring flag to unseen/new, message: {0} '.format(num))
ret, data = conn.store(num,'-FLAGS','\\Seen')
if ret == 'OK':
###########
## the very act of reading the flags changes the flag to seen!?
## No, BODY[] does that, while BODY.PEEK can avoid it...
## so if the below code is uncommented, then upon first run, it will print:
## `Got flags: OK .. ['1 (FLAGS (\\Seen) BODY[HEADER.FIELDS] "")']` ;
## and upon second and subsequent runs of the script, this part will
## not even eneter here, because above "No messages available" will break/exit!
## without these two lines, one can re-run this script indefinitely;
## as the last command ran will set Seen back to UNSEEN...
#typ, data = conn.fetch(num,'(FLAGS BODY[HEADER.FIELDS])')
#print('Got flags: {0} .. {1}'.format(typ,data))
###########
print("Set back to unseen; Got OK: {0}{1}{2}".format(data,'\n',30*'-'))
print(msg)
typ, data = conn.fetch(num,'(FLAGS)')
isSeen = ( "Seen" in uttc(data[0]) )
print('Got flags: {2}: {0} .. {1}'.format(typ,data, # NEW: OK .. [b'1 (FLAGS ())']
"Seen" if isSeen else "NEW"))
conn.close()
"""
Transcript with:
sudo perl trivial-serverB.pl
This script output:
$ python3.2 testimap.py
49:00.60 > b'CBAO1 LOGIN nobody "whatever"'
49:00.61 < b'* BAD [ALERT] Plaintext authentication not over SSL is insecure -- your password was just exposed.'
49:00.65 < b'CBAO1 OK LOGIN COMPLETED'
49:00.65 > b'CBAO2 SELECT INBOX'
49:00.66 < b'* FLAGS (\\Answered \\Flagged \\Deleted \\Seen \\Draft)'
49:00.70 < b'* 1 EXISTS'
49:00.70 < b'* 0 RECENT'
49:00.70 < b'* OK [UNSEEN 1]'
49:00.70 < b'* OK [UIDVALIDITY 1417308540]'
49:00.70 < b'* OK [UIDNEXT 1001]'
49:00.70 < b'* OK [PERMANENTFLAGS (\\Answered \\Flagged \\Deleted \\Seen \\Draft)]'
49:00.70 < b'CBAO2 OK [READ-WRITE] Completed'
49:00.70 > b'CBAO3 SEARCH (UNSEEN)'
49:00.73 < b'* SEARCH 1'
49:00.77 < b'CBAO3 OK SEARCH COMPLETED'
Processing message: 1
49:00.77 > b'CBAO4 FETCH 1 (FLAGS)'
49:00.78 < b'* 1 FETCH (FLAGS ())'
49:00.82 < b'CBAO4 OK FETCH COMPLETED'
Got flags: NEW: OK .. [b'1 (FLAGS ())']
Peeking headers, message: 1
49:00.82 > b'CBAO5 FETCH 1 (BODY.PEEK[HEADER])'
49:00.83 < b'* 1 FETCH (BODY[HEADER] {80}'
49:00.83 read literal size 80
49:00.83 < b')'
49:00.87 < b'CBAO5 OK FETCH COMPLETED'
[(b'1 (BODY[HEADER] {80}',
b'From: jesse@example.com\nTo: user@example.com\nSubject: This is a test message!\n\r\n'),
b')']
49:00.87 > b'CBAO6 FETCH 1 (FLAGS)'
49:00.87 < b'* 1 FETCH (FLAGS ())'
49:00.91 < b'CBAO6 OK FETCH COMPLETED'
Got flags: NEW: OK .. [b'1 (FLAGS ())']
Get RFC822 body, message: 1
49:00.91 > b'CBAO7 FETCH 1 (RFC822)'
49:00.92 < b'* 1 FETCH (RFC822 {206}'
49:00.92 read literal size 206
49:00.92 < b')'
49:00.96 < b'CBAO7 OK FETCH COMPLETED'
49:01.04 > b'CBAO8 FETCH 1 (FLAGS)'
49:01.04 < b'* 1 FETCH (FLAGS ())'
49:01.04 < b'CBAO8 OK FETCH COMPLETED'
Got flags: NEW: OK .. [b'1 (FLAGS ())']
Get headers, message: 1
49:01.04 > b'CBAO9 FETCH 1 (BODY[HEADER])'
49:01.05 < b'* 1 FETCH (FLAGS (\\Seen) BODY[HEADER] {80}'
49:01.05 read literal size 80
49:01.05 < b')'
49:01.09 < b'CBAO9 OK FETCH COMPLETED'
[(b'1 (FLAGS (\\Seen) BODY[HEADER] {80}',
b'From: jesse@example.com\nTo: user@example.com\nSubject: This is a test message!\n\r\n'),
b')']
49:01.09 > b'CBAO10 FETCH 1 (FLAGS)'
49:01.10 < b'* 1 FETCH (FLAGS (\\Seen))'
49:01.13 < b'CBAO10 OK FETCH COMPLETED'
Got flags: Seen: OK .. [b'1 (FLAGS (\\Seen))']
49:01.13 > b'CBAO11 SELECT INBOX'
49:01.14 < b'* FLAGS (\\Answered \\Flagged \\Deleted \\Seen \\Draft)'
49:01.18 < b'* 1 EXISTS'
49:01.18 < b'* 0 RECENT'
49:01.18 < b'* OK [UNSEEN 0]'
49:01.18 < b'* OK [UIDVALIDITY 1417308540]'
49:01.18 < b'* OK [UIDNEXT 1001]'
49:01.18 < b'* OK [PERMANENTFLAGS (\\Answered \\Flagged \\Deleted \\Seen \\Draft)]'
49:01.18 < b'CBAO11 OK [READ-WRITE] Completed'
Restoring flag to unseen/new, message: 1
49:01.18 > b'CBAO12 STORE 1 -FLAGS (\\Seen)'
49:01.20 < b'* 1 FETCH (FLAGS ())'
49:01.23 < b'CBAO12 OK STORE COMPLETED'
Set back to unseen; Got OK: [b'1 (FLAGS ())']
------------------------------
From: jesse@example.com
To: user@example.com
Subject: This is a test message!
Hello. I am executive assistant to the director of
Bear Stearns, a failed investment Bank. I have
access to USD6,000,000. ...
49:01.24 > b'CBAO13 FETCH 1 (FLAGS)'
49:01.25 < b'* 1 FETCH (FLAGS ())'
49:01.29 < b'CBAO13 OK FETCH COMPLETED'
Got flags: NEW: OK .. [b'1 (FLAGS ())']
49:01.29 > b'CBAO14 CLOSE'
49:01.29 < b'CBAO14 OK CLOSE COMPLETED'
Output log of trivial-serverB.pl:
2014/11/30-01:48:45 Net::IMAP::Server (type Net::Server) starting! pid(4730)
Resolved [*]:143 to [0.0.0.0]:143, IPv4
Resolved [*]:993 to [0.0.0.0]:993, IPv4
Binding to TCP port 143 on host 0.0.0.0 with IPv4
Binding to TCP port 993 on host 0.0.0.0 with IPv4
Group Not Defined. Defaulting to EGID '0 0'
Setting uid to "65534"
2014/11/30-01:49:00 CONNECT TCP Peer: "[127.0.0.1]:39472" Local: "[127.0.0.1]:143"
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),???,unselected): * OK IMAP4rev1 Server
C(Net::IMAP::Server::Connection=HASH(0xa7988c0),???,unselected): CBAO0 CAPABILITY
Capabilitin'
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),???,unselected): * CAPABILITY IMAP4rev1 STARTTLS CHILDREN LITERAL+ UIDPLUS ID NAMESPACE AUTH=PLAIN
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),???,unselected): CBAO0 OK CAPABILITY COMPLETED
C(Net::IMAP::Server::Connection=HASH(0xa7988c0),???,unselected): CBAO1 LOGIN nobody "whatever"
Subroutine validate redefined at /usr/local/share/perl/5.10.1/Net/IMAP/Server/Command/Login.pm line 8.
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),???,unselected): * BAD [ALERT] Plaintext authentication not over SSL is insecure -- your password was just exposed.
Capabilitin'
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,unselected): CBAO1 OK LOGIN COMPLETED
C(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,unselected): CBAO2 SELECT INBOX
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): * FLAGS (\Answered \Flagged \Deleted \Seen \Draft)
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): * 1 EXISTS
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): * 0 RECENT
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): * OK [UNSEEN 1]
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): * OK [UIDVALIDITY 1417308540]
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): * OK [UIDNEXT 1001]
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): * OK [PERMANENTFLAGS (\Answered \Flagged \Deleted \Seen \Draft)]
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): CBAO2 OK [READ-WRITE] Completed
C(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): CBAO3 SEARCH (UNSEEN)
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): * SEARCH 1
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): CBAO3 OK SEARCH COMPLETED
C(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): CBAO4 FETCH 1 (FLAGS)
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): * 1 FETCH (FLAGS ())
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): CBAO4 OK FETCH COMPLETED
C(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): CBAO5 FETCH 1 (BODY.PEEK[HEADER])
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): * 1 FETCH (BODY[HEADER] {80}%0D
From: jesse@example.com
To: user@example.com
Subject: This is a test message!
%0D
)
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): CBAO5 OK FETCH COMPLETED
C(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): CBAO6 FETCH 1 (FLAGS)
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): * 1 FETCH (FLAGS ())
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): CBAO6 OK FETCH COMPLETED
C(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): CBAO7 FETCH 1 (RFC822)
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): * 1 FETCH (RFC822 {206}%0D
From: jesse@example.com
To: user@example.com
Subject: This is a test message!
Hello. I am executive assistant to the director of
Bear Stearns, a failed investment Bank. I have
access to USD6,000,000. ...
)
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): CBAO7 OK FETCH COMPLETED
C(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): CBAO8 FETCH 1 (FLAGS)
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): * 1 FETCH (FLAGS ())
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): CBAO8 OK FETCH COMPLETED
C(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): CBAO9 FETCH 1 (BODY[HEADER])
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): * 1 FETCH (FLAGS (\Seen) BODY[HEADER] {80}%0D
From: jesse@example.com
To: user@example.com
Subject: This is a test message!
%0D
)
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): CBAO9 OK FETCH COMPLETED
C(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): CBAO10 FETCH 1 (FLAGS)
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): * 1 FETCH (FLAGS (\Seen))
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): CBAO10 OK FETCH COMPLETED
C(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): CBAO11 SELECT INBOX
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): * FLAGS (\Answered \Flagged \Deleted \Seen \Draft)
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): * 1 EXISTS
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): * 0 RECENT
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): * OK [UNSEEN 0]
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): * OK [UIDVALIDITY 1417308540]
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): * OK [UIDNEXT 1001]
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): * OK [PERMANENTFLAGS (\Answered \Flagged \Deleted \Seen \Draft)]
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): CBAO11 OK [READ-WRITE] Completed
C(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): CBAO12 STORE 1 -FLAGS (\Seen)
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): * 1 FETCH (FLAGS ())
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): CBAO12 OK STORE COMPLETED
C(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): CBAO13 FETCH 1 (FLAGS)
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): * 1 FETCH (FLAGS ())
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): CBAO13 OK FETCH COMPLETED
C(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,INBOX): CBAO14 CLOSE
S(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,unselected): CBAO14 OK CLOSE COMPLETED
-(Net::IMAP::Server::Connection=HASH(0xa7988c0),nobody,unselected): Connection closed by remote host
"""
Raw
trivial-serverB.pl
#!/usr/bin/perl
# https://github.com/bestpractical/net-imap-server/blob/master/ex/trivial-server.pl
# has plenty of dependencies - takes a while
# sudo perl -MCPAN -e 'install Net::IMAP::Server'
# mkdir certs
# this may cause "SSL accept error: 1, error:00000001:lib(0):func(0):reason(1)":
# openssl req -newkey rsa:2048 -new -nodes -keyout certs/server-key.pem -out certs/server-cert.pem -subj '/CN=localhost/O=My Company Name LTD./C=US'
# this works fine, though! https://www.madboa.com/geek/openssl/ ... Note it will say "unable to write 'random state'"
#~ openssl req \
#~ -x509 -nodes -days 365 \
#~ -subj '/C=US/ST=Oregon/L=Portland/CN=localhost' \
#~ -newkey rsa:1024 -keyout certs/server-key.pem -out certs/server-cert.pem
# covers both port :143 and :993
# sudo perl trivial-serverB.pl
use v5.10.1;
use feature qw(say);
use Net::IMAP::Server;
package Demo::IMAP::Hack;
$INC{'Demo/IMAP/Hack.pm'} = 1;
# the overloads must be in a clearly defined package!
# to disable: * BAD [ALERT] Plaintext authentication not over SSL is insecure -- your password was just exposed.; NO Login is disabled
sub validateb {
my $self = shift;
print STDERR "Authenticatin'\n";
#~ return $self->bad_command("Already logged in")
#~ unless $self->connection->is_unauth;
#~ my @options = $self->parsed_options;
#~ return $self->bad_command("Not enough options") if @options < 1;
#~ return $self->bad_command("Too many options") if @options > 2;
#~ $self->untagged_response("BAD [ALERT] Plaintext authentication not over SSL is insecure -- your password was just exposed.")
#~ if $options[0] eq "PLAIN" and not $self->connection->is_encrypted;
#~ return $self->no_command("Authentication type not supported")
#~ unless $self->connection->capability =~ /\bAUTH=$options[0]\b/i;
return 1;
};
sub capabilityb {
my $self = shift;
print STDERR "Capabilitin'\n";
my $base = $self->server->capability;
my @words = split " ", $base;
# Skip STARTTLS if we're encrpyted
@words = grep {$_ ne "STARTTLS"} @words
if $self->is_encrypted;
# If we're auth'd, no need to list any AUTH or LOGINDISABLED
unless ($self->auth) {
my $auth = $self->auth || $self->server->auth_class->new;
my @auth = $auth->sasl_provides;
# hack:
#unless ($self->is_encrypted) {
# # Lack of encrpytion makes us turn off all plaintext auth
# push @words, "LOGINDISABLED";
# @auth = grep {$_ ne "PLAIN"} @auth;
#}
push @words, map {"AUTH=$_"} @auth;
}
return join(" ", @words);
}
# http://stackoverflow.com/questions/27206371/printing-addresses-of-perl-object-methods
say join " ", \&Net::IMAP::Server::Command::Authenticate::validate, \&Net::IMAP::Server::Connection::capability, \&validateb, \&capabilityb;
package Demo::IMAP::Auth;
$INC{'Demo/IMAP/Auth.pm'} = 1;
use base 'Net::IMAP::Server::DefaultAuth';
sub auth_plain {
my ( $self, $user, $pass ) = @_;
# XXX DO AUTH CHECK
$self->user($user);
return 1;
}
#~ sub provides_plain { return 1; }
package Demo::IMAP::Model;
$INC{'Demo/IMAP/Model.pm'} = 1;
use base 'Net::IMAP::Server::DefaultModel';
sub init {
my $self = shift;
$self->root( Demo::IMAP::Mailbox->new() );
$self->root->add_child( name => "INBOX" );
}
#############################################################
package Demo::IMAP::Mailbox;
use base qw/Net::IMAP::Server::Mailbox/;
use Data::Dumper;
use Devel::Peek;
my $data = <<'EOF';
From: jesse@example.com
To: user@example.com
Subject: This is a test message!
Hello. I am executive assistant to the director of
Bear Stearns, a failed investment Bank. I have
access to USD6,000,000. ...
EOF
my $msg = Net::IMAP::Server::Message->new($data);
sub load_data {
my $self = shift;
$self->add_message($msg);
}
my %ports = ( port => 143, ssl_port => 993 );
$ports{$_} *= 10 for grep {$> > 0} keys %ports;
# here address of \&validateb, \&capabilityb is changed (if packages are incorectly referenced)!
say join " ", \&Net::IMAP::Server::Command::Authenticate::validate, \&Net::IMAP::Server::Connection::capability, \&Demo::IMAP::Hack::validateb, \&Demo::IMAP::Hack::capabilityb;
{
no strict 'refs';
#~ *Net::IMAP::Server::Command::Authenticate::validate = *validateb; # overloads without message
*Net::IMAP::Server::Command::Authenticate::validate = \&Demo::IMAP::Hack::validateb; # should overload w/ message, but doesn't?!
*Net::IMAP::Server::Connection::capability = \&Demo::IMAP::Hack::capabilityb; # overloads w/ "Subroutine .. redefined" message; not this one
}
say join " ", \&Net::IMAP::Server::Command::Authenticate::validate, \&Net::IMAP::Server::Connection::capability, \&Demo::IMAP::Hack::validateb, \&Demo::IMAP::Hack::capabilityb;
$myserv = Net::IMAP::Server->new(
auth_class => "Demo::IMAP::Auth",
model_class => "Demo::IMAP::Model",
user => 'nobody',
log_level => 4, # at least 3 to output 'CONNECT TCP Peer: ...' message; 4 to output IMAP commands too
%ports,
);
# "Subroutine capability redefined at /usr/local/share/perl/5.10.1/Net/IMAP/Server/Connection.pm line 575." occurs "here" (in Server->new!)
# Net/IMAP/Server/Connection.pm: mk_accessors( ... ) # - no capability!
# calls $handler->validate; where $handler = $self->class_for($cmd)->new(...
# Net/IMAP/Server/Command.pm: mk_accessors( ... ) # nothing of interest
# Net/IMAP/Server/Command/Authenticate.pm: mk_accessors( ) # no validate ?!
# Net/IMAP/Server.pm: has sub capability; but not sub validate
# apparently, this overload MUST be after the new?! here:
{
no strict 'refs';
#~ *Net::IMAP::Server::Command::Authenticate::validate = *validateb; # overloads without message
#~ *Net::IMAP::Server::Command::Authenticate::validate = \&Demo::IMAP::Hack::validateb; # should overload w/ message, but doesn't?! never gets overloaded?
*Net::IMAP::Server::Connection::capability = \&Demo::IMAP::Hack::capabilityb; # overloads w/ "Subroutine .. redefined" message;
# this one fires "Subroutine .. redefined" message after "LOGIN nobody "whatever"":
*Net::IMAP::Server::Command::Login::validate = \&Demo::IMAP::Hack::validateb;
}
say Dumper(\$myserv);
#~ 'connection_class' => 'Net::IMAP::Server::Connection',
#~ 'model_class' => 'Demo::IMAP::Model',
#~ 'connection' => {},
#~ 'command_class' => {},
# here \&Net::IMAP::Server::Connection::capability is changed unexpectedly, too?! will not be \&capabilityb if the overload is before the ->new() !!
# $myserv->can('validate') is "" here!
# $myserv->command_class->can('validate') - Can't call method "can" on unblessed reference
# Connection::handle_command
say " -", $myserv->can('validate'), " -", , " -", $myserv->can('capability'), " -", \&Net::IMAP::Server::Connection::capability, " -", \&Demo::IMAP::Hack::capabilityb;
#~ {$myserv->connection_class}::handle_command(Net::IMAP::Server::Command::Login); # Undefined subroutine &main::handle_command
#~ Net::IMAP::Server::Connection::handle_command(Net::IMAP::Server::Command::Login); # Can't locate object method "auth" via package
$myserv->run();
__END__
# Here is a transcript for a basic telnet session with this program.
# (see also http://www.skytale.net/blog/archives/23-Manual-IMAP.html)
# comments will be indicated with # - at end of telnet commands, means that command is typed (without the terminating #)
# Run the server in one terminal:
$ sudo perl trivial-serverB.pl
CODE(0x8a7a6f8) CODE(0x8a94d10) CODE(0x8a94e40) CODE(0x8a9cb90)
CODE(0x8a7a6f8) CODE(0x8a94d10) CODE(0x8a94e40) CODE(0x8a9cb90)
CODE(0x8a94e40) CODE(0x8a9cb90) CODE(0x8a94e40) CODE(0x8a9cb90)
Subroutine capability redefined at /usr/local/share/perl/5.10.1/Net/IMAP/Server/Connection.pm line 575.
$VAR1 = \bless( {
'connection_class' => 'Net::IMAP::Server::Connection',
'model_class' => 'Demo::IMAP::Model',
'connection' => {},
'unauth_commands' => 10,
'command_class' => {},
'port' => 143,
'auth_class' => 'Demo::IMAP::Auth',
'unauth_idle' => 300,
'poll_every' => 0,
'log_level' => 4,
'auth_idle' => 3600,
'user' => 'nobody',
'server' => {
'log_level' => 4,
'user' => 'nobody'
},
'ssl_port' => 993
}, 'Net::IMAP::Server' );
- - -CODE(0x8a9c810) -CODE(0x8a9cb90) -CODE(0x8a9cb90)
2014/11/30-00:32:46 Net::IMAP::Server (type Net::Server) starting! pid(11629)
Resolved [*]:143 to [0.0.0.0]:143, IPv4
Resolved [*]:993 to [0.0.0.0]:993, IPv4
Binding to TCP port 143 on host 0.0.0.0 with IPv4
Binding to TCP port 993 on host 0.0.0.0 with IPv4
Group Not Defined. Defaulting to EGID '0 0'
Setting uid to "65534"
# in another terminal run telnet
# use rlwrap to be able to go up/down with arrow keys, have command history (but don't press Ctrl-C)
# first typed command goes (with # at end - don't type), then telnet answer, then server log (indented), then vspace
$ rlwrap telnet localhost 143
Trying 127.0.0.1...
Connected to localhost.
Escape character is '^]'.
* OK IMAP4rev1 Server
foo login nobody password #
* BAD [ALERT] Plaintext authentication not over SSL is insecure -- your password was just exposed.
foo OK LOGIN COMPLETED
2014/11/30-00:34:45 CONNECT TCP Peer: "[127.0.0.1]:37244" Local: "[127.0.0.1]:143"
S(Net::IMAP::Server::Connection=HASH(0x94b68d0),???,unselected): * OK IMAP4rev1 Server
C(Net::IMAP::Server::Connection=HASH(0x94b68d0),???,unselected): foo login nobody password
Subroutine validate redefined at /usr/local/share/perl/5.10.1/Net/IMAP/Server/Command/Login.pm line 8.
S(Net::IMAP::Server::Connection=HASH(0x94b68d0),???,unselected): * BAD [ALERT] Plaintext authentication not over SSL is insecure -- your password was just exposed.
Capabilitin'
S(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,unselected): foo OK LOGIN COMPLETED
foo namespace #
* NAMESPACE (("" "/")) NIL NIL
foo OK NAMESPACE COMPLETED
C(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,unselected): foo namespace
S(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,unselected): * NAMESPACE (("" "/")) NIL NIL
S(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,unselected): foo OK NAMESPACE COMPLETED
foo list "" "%" #
* LIST (\HasNoChildren) "/" "INBOX"
foo OK LIST COMPLETED
C(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,unselected): foo list "" "%"
S(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,unselected): * LIST (\HasNoChildren) "/" "INBOX"
S(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,unselected): foo OK LIST COMPLETED
foo select INBOX #
* FLAGS (\Answered \Flagged \Deleted \Seen \Draft)
* 1 EXISTS
* 0 RECENT
* OK [UNSEEN 1]
* OK [UIDVALIDITY 1417304115]
* OK [UIDNEXT 1001]
* OK [PERMANENTFLAGS (\Answered \Flagged \Deleted \Seen \Draft)]
foo OK [READ-WRITE] Completed
C(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,unselected): foo select INBOX
S(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,INBOX): * FLAGS (\Answered \Flagged \Deleted \Seen \Draft)
S(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,INBOX): * 1 EXISTS
S(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,INBOX): * 0 RECENT
S(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,INBOX): * OK [UNSEEN 1]
S(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,INBOX): * OK [UIDVALIDITY 1417304115]
S(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,INBOX): * OK [UIDNEXT 1001]
S(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,INBOX): * OK [PERMANENTFLAGS (\Answered \Flagged \Deleted \Seen \Draft)]
S(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,INBOX): foo OK [READ-WRITE] Completed
foo search (ALL) # getting only id 1 of the only message
* SEARCH 1
foo OK SEARCH COMPLETED
C(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,INBOX): foo search (ALL)
S(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,INBOX): * SEARCH 1
S(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,INBOX): foo OK SEARCH COMPLETED
foo search (UNSEEN) # getting only id 1 of the only message
* SEARCH 1
foo OK SEARCH COMPLETED
C(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,INBOX): foo search (UNSEEN)
S(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,INBOX): * SEARCH 1
S(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,INBOX): foo OK SEARCH COMPLETED
foo uid search ALL # getting only uid 1000 of the only message; note can do without braces
* SEARCH 1000
foo OK UID COMPLETED
C(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,INBOX): foo uid search ALL
S(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,INBOX): * SEARCH 1000
S(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,INBOX): foo OK UID COMPLETED
foo uid search UNSEEN # getting only uid 1000 of the only message
* SEARCH 1000
foo OK UID COMPLETED
C(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,INBOX): foo uid search UNSEEN
S(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,INBOX): * SEARCH 1000
S(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,INBOX): foo OK UID COMPLETED
foo uid fetch 1000 (FLAGS) # note: no flags are returned!
* 1 FETCH (UID 1000 FLAGS ())
foo OK UID COMPLETED
C(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,INBOX): foo uid fetch 1000 (FLAGS)
S(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,INBOX): * 1 FETCH (UID 1000 FLAGS ())
S(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,INBOX): foo OK UID COMPLETED
foo select INBOX # check flags by select: still UNSEEN 1:
* FLAGS (\Answered \Flagged \Deleted \Seen \Draft)
* 1 EXISTS
* 0 RECENT
* OK [UNSEEN 1]
* OK [UIDVALIDITY 1417304115]
* OK [UIDNEXT 1001]
* OK [PERMANENTFLAGS (\Answered \Flagged \Deleted \Seen \Draft)]
foo OK [READ-WRITE] Completed
C(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,INBOX): foo select INBOX
S(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,INBOX): * FLAGS (\Answered \Flagged \Deleted \Seen \Draft)
S(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,INBOX): * 1 EXISTS
S(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,INBOX): * 0 RECENT
S(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,INBOX): * OK [UNSEEN 1]
S(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,INBOX): * OK [UIDVALIDITY 1417304115]
S(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,INBOX): * OK [UIDNEXT 1001]
S(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,INBOX): * OK [PERMANENTFLAGS (\Answered \Flagged \Deleted \Seen \Draft)]
S(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,INBOX): foo OK [READ-WRITE] Completed
foo fetch 1 (FLAGS BODY.PEEK[HEADER]) # fetch header with body.PEEK - note, flags still empty
* 1 FETCH (FLAGS () BODY[HEADER] {80}
From: jesse@example.com
To: user@example.com
Subject: This is a test message!
)
foo OK FETCH COMPLETED
C(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,INBOX): foo fetch 1 (FLAGS BODY.PEEK[HEADER])
S(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,INBOX): * 1 FETCH (FLAGS () BODY[HEADER] {80}%0D
From: jesse@example.com
To: user@example.com
Subject: This is a test message!
%0D
)
S(Net::IMAP::Server::Connection=HASH(0x94b68d0),nobody,INBOX): foo OK FETCH COMPLETED
foo select INBOX # check flags again by select: still UNSEEN 1:
* FLAGS (\Answered \Flagged \Deleted \Seen \Draft)
* 1 EXISTS
* 0 RECENT
* OK [UNSEEN 1]
* OK [UIDVALIDITY 1417304115]
* OK [UIDNEXT 1001]
* OK [PERMANENTFLAGS (\Answered \Flagged \Deleted \Seen \Draft)]
foo OK [READ-WRITE] Completed
C(Net::IMAP::Server::Connection=HASH(0x8cc68a8),nobody,INBOX): foo select INBOX
S(Net::IMAP::Server::Connection=HASH(0x8cc68a8),nobody,INBOX): * FLAGS (\Answered \Flagged \Deleted \Seen \Draft)
S(Net::IMAP::Server::Connection=HASH(0x8cc68a8),nobody,INBOX): * 1 EXISTS
S(Net::IMAP::Server::Connection=HASH(0x8cc68a8),nobody,INBOX): * 0 RECENT
S(Net::IMAP::Server::Connection=HASH(0x8cc68a8),nobody,INBOX): * OK [UNSEEN 1]
S(Net::IMAP::Server::Connection=HASH(0x8cc68a8),nobody,INBOX): * OK [UIDVALIDITY 1417305115]
S(Net::IMAP::Server::Connection=HASH(0x8cc68a8),nobody,INBOX): * OK [UIDNEXT 1001]
S(Net::IMAP::Server::Connection=HASH(0x8cc68a8),nobody,INBOX): * OK [PERMANENTFLAGS (\Answered \Flagged \Deleted \Seen \Draft)]
S(Net::IMAP::Server::Connection=HASH(0x8cc68a8),nobody,INBOX): foo OK [READ-WRITE] Completed
foo fetch 1 (FLAGS BODY[HEADER]) # now try fetch body headers without .PEEK;
# note now flag \Seen appears here immediately!
* 1 FETCH (FLAGS (\Seen) BODY[HEADER] {80}
From: jesse@example.com
To: user@example.com
Subject: This is a test message!
)
foo OK FETCH COMPLETED
C(Net::IMAP::Server::Connection=HASH(0x8cc68a8),nobody,INBOX): foo fetch 1 (FLAGS BODY[HEADER])
S(Net::IMAP::Server::Connection=HASH(0x8cc68a8),nobody,INBOX): * 1 FETCH (FLAGS (\Seen) BODY[HEADER] {80}%0D
From: jesse@example.com
To: user@example.com
Subject: This is a test message!
%0D
)
S(Net::IMAP::Server::Connection=HASH(0x8cc68a8),nobody,INBOX): foo OK FETCH COMPLETED
foo select INBOX # check flags again by select: now is UNSEEN 0!:
* FLAGS (\Answered \Flagged \Deleted \Seen \Draft)
* 1 EXISTS
* 0 RECENT
* OK [UNSEEN 0]
* OK [UIDVALIDITY 1417305115]
* OK [UIDNEXT 1001]
* OK [PERMANENTFLAGS (\Answered \Flagged \Deleted \Seen \Draft)]
foo OK [READ-WRITE] Completed
C(Net::IMAP::Server::Connection=HASH(0x8cc68a8),nobody,INBOX): foo select INBOX
S(Net::IMAP::Server::Connection=HASH(0x8cc68a8),nobody,INBOX): * FLAGS (\Answered \Flagged \Deleted \Seen \Draft)
S(Net::IMAP::Server::Connection=HASH(0x8cc68a8),nobody,INBOX): * 1 EXISTS
S(Net::IMAP::Server::Connection=HASH(0x8cc68a8),nobody,INBOX): * 0 RECENT
S(Net::IMAP::Server::Connection=HASH(0x8cc68a8),nobody,INBOX): * OK [UNSEEN 0]
S(Net::IMAP::Server::Connection=HASH(0x8cc68a8),nobody,INBOX): * OK [UIDVALIDITY 1417305115]
S(Net::IMAP::Server::Connection=HASH(0x8cc68a8),nobody,INBOX): * OK [UIDNEXT 1001]
S(Net::IMAP::Server::Connection=HASH(0x8cc68a8),nobody,INBOX): * OK [PERMANENTFLAGS (\Answered \Flagged \Deleted \Seen \Draft)]
S(Net::IMAP::Server::Connection=HASH(0x8cc68a8),nobody,INBOX): foo OK [READ-WRITE] Completed
foo uid store 1000 -FLAGS (\Seen) # now reset/delete the \Seen flag for msg 1 = uid 1000
# note in the response, flags are empty!
* 1 FETCH (UID 1000 FLAGS ())
foo OK UID COMPLETED
C(Net::IMAP::Server::Connection=HASH(0x8cc68a8),nobody,INBOX): foo uid store 1000 -FLAGS (\Seen)
S(Net::IMAP::Server::Connection=HASH(0x8cc68a8),nobody,INBOX): * 1 FETCH (UID 1000 FLAGS ())
S(Net::IMAP::Server::Connection=HASH(0x8cc68a8),nobody,INBOX): foo OK UID COMPLETED
foo select INBOX # check flags again by select: now is back to UNSEEN 1:
* FLAGS (\Answered \Flagged \Deleted \Seen \Draft)
* 1 EXISTS
* 0 RECENT
* OK [UNSEEN 1]
* OK [UIDVALIDITY 1417305115]
* OK [UIDNEXT 1001]
* OK [PERMANENTFLAGS (\Answered \Flagged \Deleted \Seen \Draft)]
foo OK [READ-WRITE] Completed
C(Net::IMAP::Server::Connection=HASH(0x8cc68a8),nobody,INBOX): foo uid store 1000 -FLAGS (\Seen)
S(Net::IMAP::Server::Connection=HASH(0x8cc68a8),nobody,INBOX): * 1 FETCH (UID 1000 FLAGS ())
S(Net::IMAP::Server::Connection=HASH(0x8cc68a8),nobody,INBOX): foo OK UID COMPLETED
C(Net::IMAP::Server::Connection=HASH(0x8cc68a8),nobody,INBOX): foo select INBOX
S(Net::IMAP::Server::Connection=HASH(0x8cc68a8),nobody,INBOX): * FLAGS (\Answered \Flagged \Deleted \Seen \Draft)
S(Net::IMAP::Server::Connection=HASH(0x8cc68a8),nobody,INBOX): * 1 EXISTS
S(Net::IMAP::Server::Connection=HASH(0x8cc68a8),nobody,INBOX): * 0 RECENT
S(Net::IMAP::Server::Connection=HASH(0x8cc68a8),nobody,INBOX): * OK [UNSEEN 1]
S(Net::IMAP::Server::Connection=HASH(0x8cc68a8),nobody,INBOX): * OK [UIDVALIDITY 1417305115]
S(Net::IMAP::Server::Connection=HASH(0x8cc68a8),nobody,INBOX): * OK [UIDNEXT 1001]
S(Net::IMAP::Server::Connection=HASH(0x8cc68a8),nobody,INBOX): * OK [PERMANENTFLAGS (\Answered \Flagged \Deleted \Seen \Draft)]
S(Net::IMAP::Server::Connection=HASH(0x8cc68a8),nobody,INBOX): foo OK [READ-WRITE] Completed
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment