Tiny imap message appender written in perl different attachment

[Krzysztof Nikiel]

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();