Overview | Index by: file name | procedure name | procedure call | annotation
email.tcl (annotations | original source)

#
#    Copyright (C) 2010 Alexandros Stergiakis <alsterg@gmail.com>
#
#    This program is free software: you can redistribute it and/or modify
#    it under the terms of the GNU Affero General Public License as
#    published by the Free Software Foundation, either version 3 of the
#    License, or (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU Affero General Public License for more details.
#
#    You should have received a copy of the GNU Affero General Public License
#    along with this program.  If not, see <http://www.gnu.org/licenses/>.
#

#//#
# Defines a procedure for sending (SMTP) and receiving (POP3) emails .
#//#

package require smtp 1.4.5
package require mime 1.5.4
package require pop3 1.7

namespace eval email {
    namespace export smtpSend popOpen popClose popRead popDelete popCount
    
# Send an email via SMTP.
#
# @param sender Self-documenting.
# @param recipients A list. Self-documenting.
# @param subject Self-documenting.
# @param body Self-documenting.
# @param server Self-documenting.
# @param username Optional. Self-documenting.
# @param password Optional. Self-documenting.
# @param port Self-documenting.
# @return Nothing on success. Otherwise an error is generated.
# @error From timeout or protocol error.
proc smtpSend {sender recipients subject body server port {username {}} {password {}}} {
    if {[llength $recipients] > 1} {
        set recipients [join $recipients {,}]
    }
    
    if {[catch {
        set token [mime::initialize -canonical text/plain -string $body]
        mime::setheader $token Subject $subject
        
        # Note: Using -recipients $recipients results in "Undisclosed recipient" in the sent email "To" field.
        
        if {[lempty $username]} {
            set res [smtp::sendmessage $token -servers $server -ports $port -originator $sender -header "To $recipients" -atleastone 1]
            #set res [smtp::sendmessage $token -servers $server -ports $port -originator $sender -recipients $recipients -atleastone 1]
        } else {
            set res [smtp::sendmessage $token -servers $server -ports $port -username $username -password $password -originator $sender -header "To $recipients" -atleastone 1]
            #set res [smtp::sendmessage $token -servers $server -ports $port -username $username -password $password -originator $sender -recipients $recipients -atleastone 1]
        }
        mime::finalize $token
    } errMsg errStack]} {
        return -options $errStack $errMsg
    }
    
    # {sterg@kth.se 554 {5.7.1 <athedsl-xxxxx.home.otenet.gr[85.73.40.xxxxx]>: Client host rejected: Access denied}}
    if {! [lempty $res]} {
        lassign [lindex $res 0] email errcode errmsg
        error "Failed to send to ${email}. Error ${errcode}: $errmsg"
    }
}

# Open a connection with a POP3 Server.
#
# @param server POP3 Server hostname or IP address.
# @param username Account name.
# @param password Password.
# @return A POP3 socket, that can be used with popRead popCount popDelete commands.
# @error
proc popOpen {server port username password} {
    return [pop3::open $server $username $password $port]
}

# Close an open connection with a POP3 Server.
#
# @param popsock An open POP3 socket as returned by the popOpen command.
# @error
proc popClose {popsock} {
    pop3::close $popsock
}

# Delete an email from the POP3 inbox.
#
# @param popsock An open POP3 socket as returned by the popOpen command.
# @param index The index of the email to delete.
# @error
proc popDelete {popsock index} {
    pop3::delete $popsock $index
}

# Retrieve all new emails via POP3.
#
# @param popsock An open POP3 socket as returned by the popOpen command.
# @return The list of new messages.
# @error
proc popRead {popsock} {
    set messages [list]
    lassign [pop3::status $popsock] msgcount size
    for {set i 1} {$i <= $msgcount} {incr i} {
        lappend messages [pop3::retrieve $popsock $i]
    }
    return $messages
}

# Return the number of new/unread emails in the mailbox.
#
# @param popsock An open POP3 socket as returned by the popOpen command.
# @return The number of new emails, and the total size of the emails.
proc popCount {popsock} {
    lassign [pop3::status $popsock] msgcount size
    return [list $msgcount $size]
}

} ;# Namespace Ends

Overview | Index by: file name | procedure name | procedure call | annotation
File generated 2010-03-13 at 22:28.