Tiny imap message appender written in perl different attachment
Krzysztof Nikiel
knik00 at gmail.com
Sun Feb 13 05:25:27 CST 2011
This attachment may be better:
#!/usr/bin/perl
# SSL IMAP message appender
# Copyright (C) 2011 Krzysztof Nikiel
use Socket;
use Net::SSLeay qw(die_now die_if_ssl_error);
Net::SSLeay::load_error_strings();
Net::SSLeay::SSLeay_add_ssl_algorithms();
Net::SSLeay::randomize();
$g_port=993;
$g_tag=1;
$g_ret="";
if ($#ARGV < 3) {
print "usage: $0 server user box pass file1 ...\n",
"\tAppends files to the specified IMAP box.\n\n";
exit;
}
$g_serv=shift @ARGV;
$g_user=shift @ARGV;
$g_box=shift @ARGV;
$g_pass=shift @ARGV;
sub imapclient
{
my $dest_serv, $port, $dest_ip, $dest_serv_params;
my $ctx, $res;
my $res;
my @boxlist;
my $boxok = 0;
$port = $g_port;
$port = getservbyname($port, 'tcp') unless $port =~ /^\d+$/;
$dest_ip = gethostbyname($g_serv);
$dest_serv_params = sockaddr_in($port, $dest_ip);
socket(S, &AF_INET, &SOCK_STREAM, 0) or die "socket: $!";
connect(S, $dest_serv_params) or die "connect: $!";
select(S); $| = 1; select(STDOUT);
# The network connection is now open, lets fire up SSL
$ctx = Net::SSLeay::CTX_new() or die_now("Failed to create SSL_CTX $!");
$g_ssl = Net::SSLeay::new($ctx) or die_now("Failed to create SSL $!");
Net::SSLeay::set_fd($g_ssl, fileno(S)); # Must use fileno
$res = Net::SSLeay::connect($g_ssl);
print "Cipher '" . Net::SSLeay::get_cipher($g_ssl) . "'\n";
# IMAP client starts here
print "\nconnecting to $g_serv\n";
imapread();
showresp();
unless ($g_ret =~ /^\* OK/) {return};
print "logging in as $g_user\n";
$res = imapcmd("LOGIN $g_user $g_pass");
imapread();
showresp();
print "reading mailbox list\n";
$res = imapcmd("LIST \"\" \*");
imapread();
unless (testresp($g_ret)) {
print "LIST failed\n";
goto logout;
}
#print "list ret: '$g_ret'\n";
@boxlist=();
foreach (split /\n/,$g_ret) {
if (/^* LIST [^"]*"[^"]*"[^"]*"([^"]*)"/) {
push @boxlist,$1;
}
}
foreach (@boxlist) {
print "$_\n";
if ("$_" eq "$g_box") {$boxok = 1}
}
if (!$boxok) {print "Warning: can't find '$g_box' in mailbox names\n"}
foreach (@ARGV) {
imapappend("$g_box", $_);
}
logout:
print "logging out\n";
$res = imapcmd("LOGOUT");
imapread();
showresp();
if ($g_ret =~ /^\* BYE/) {print "LOGOUT OK\n"};
do {
imapread();
showresp();
} while ($g_ret ne "");
#end of IMAP code
shutdown S, 1; # Half close --> No more output, sends EOF to server
$res = Net::SSLeay::read($g_ssl); # Perl returns undef on failure
print $res;
Net::SSLeay::free($g_ssl); # Tear down connection
Net::SSLeay::CTX_free($ctx);
close S;
}
sub imapappend
{
my $res, $resp;
my $box = @_[0];
my $file = @_[1];
my @msg = ();
print "reading from '$file'...";
if (!open(MSG,"<",$file)) {
print "Warning: can't open $file\n";
return;
}
$size = 0;
while(<MSG>)
{
chomp;
push @msg,$_;
$size += length;
$size += 2;
}
close MSG;
print $#msg + 1, " lines; $size bytes\n";
print "appending to \"$box\"\n";
$res = imapcmd("APPEND \"$box\" {$size}");
imapread();
showresp();
unless ($g_ret =~ /^+/) {return};
foreach (@msg) {
$res = sslwrite("$_");
}
$res = sslwrite("");
imapread();
showresp();
}
sub showresp
{
print $g_ret;
}
sub imapread
{
$g_ret = Net::SSLeay::read($g_ssl);
$g_ret =~ s/\r//g;
}
sub imapcmd
{
my ($msg) = @_;
my $res;
$g_tag += 1;
return sslwrite("TAG$g_tag $msg");
}
sub sslwrite
{
my ($msg) = @_;
my $res;
$res = Net::SSLeay::ssl_write_all($g_ssl, "$msg\r\n");
return $res;
}
sub testresp
{
if (@_[0] =~ /TAG(\d+) OK/)
{
if ($1 == $g_tag) {return 1}
}
return 0;
}
imapclient();
More information about the wine-devel
mailing list