MBS/PROYECTO/otrodir/generaEmail.4gl

IMPORT os
IMPORT util

DEFINE rv INTEGER

DEFINE logtext STRING
DEFINE smtplog base.StringBuffer
DEFINE ext2mime DYNAMIC ARRAY OF RECORD
    ext STRING,
    mime STRING,
    encoding STRING
END RECORD
TYPE cnf_t RECORD 
    hostname STRING,
    smtphost STRING,
    smtpport INTEGER,
    senderemail STRING,
    clave   STRING,
    cnxtimeout INTEGER
END RECORD
DEFINE cnf cnf_t

&define MB(array, idx, line)  \
    LET array[idx] = line     \
    LET idx = idx + 1

FUNCTION genmail(senderemail, recipients, subject, mailtext, attachments, mailbody, rcpt)
    DEFINE senderemail STRING
    DEFINE subject STRING
    DEFINE recipients DYNAMIC ARRAY OF RECORD mode STRING, recipient STRING END RECORD
    DEFINE mailtext STRING
    DEFINE sbmt base.StringBuffer
    DEFINE i, found INTEGER
    DEFINE rcpt DYNAMIC ARRAY OF STRING
    DEFINE attachments DYNAMIC ARRAY OF RECORD fname, sname STRING END RECORD
    DEFINE nl INTEGER
    DEFINE nrcpt INTEGER
    DEFINE nr INTEGER
    DEFINE extension STRING
    DEFINE mimeid INTEGER
    DEFINE tz STRING
    DEFINE boundary STRING

    DEFINE mailbody DYNAMIC ARRAY OF STRING

    LET nl = 1
    LET nr = 1
    LET nrcpt = 0

    # Add mail date
    MB(mailbody, nl, SFMT("Date: %1 %2 %3\r", TODAY USING "ddd, dd mmm yyyy", TIME(CURRENT), tz))

    # First add headers
    MB(mailbody, nl, SFMT("From: %1\r", senderemail))

    # Add user agent
    MB(mailbody, nl, "User-Agent: maildemo sample program.\r")

    # Add MIME version
    MB(mailbody, nl, "MIME-Version: 1.0\r")

    # Add To: recipients
    LET found = 0
    FOR i = 1 TO recipients.getLength()
        IF recipients[i].mode == "To" THEN
            IF found THEN
                LET mailbody[nl] = mailbody[nl].append(SFMT(", %1", recipients[i].recipient))
            ELSE
                LET mailbody[nl]=SFMT("To: %1", recipients[i].recipient)
                LET found = 1
            END IF
            MB(rcpt, nr, SFMT("RCPT TO: %1", extract_email(recipients[i].recipient)))
        END IF
    END FOR
    IF found == 1 THEN
        LET mailbody[nl] = mailbody[nl].append("\r")
        LET nl = nl + 1
    END IF

    # Add CC: recipients
    LET found = 0
    FOR i = 1 TO recipients.getLength()
        IF recipients[i].mode == "CC" THEN
            IF found THEN
                LET mailbody[nl] = mailbody[nl].append(SFMT(", %1", recipients[i].recipient))
            ELSE
                LET mailbody[nl]=SFMT("CC: %1", recipients[i].recipient)
                LET found = 1
            END IF
            MB(rcpt, nr, SFMT("RCPT TO: %1", extract_email(recipients[i].recipient)))
        END IF
    END FOR
    IF found == 1 THEN
        LET mailbody[nl] = mailbody[nl].append("\r")
        LET nl = nl + 1
    END IF

    # Add CC: recipients
    LET found = 0
    FOR i = 1 TO recipients.getLength()
        IF recipients[i].mode == "BCC" THEN
            IF found THEN
                LET mailbody[nl] = mailbody[nl].append(SFMT(", %1", recipients[i].recipient))
            ELSE
                LET mailbody[nl]=SFMT("BCC: %1", recipients[i].recipient)
                LET found = 1
            END IF
            MB(rcpt, nr, SFMT("RCPT TO: %1", extract_email(recipients[i].recipient)))
        END IF
    END FOR
    IF found == 1 THEN
        LET mailbody[nl] = mailbody[nl].append("\r")
        LET nl = nl + 1
    END IF

    MB(mailbody, nl, SFMT("Subject: %1\r", subject))

    # Now add the message content
    # Multipart message not handled
    # Should check the body is really 7bit and not line starts with ., ...
    # To be conformant with 7bit encoding. See RFC for details.

    # \n.\n is the DATA section end mark.
    # Should be replaced by \n..\n
    LET sbmt = base.StringBuffer.create()
    CALL sbmt.append(mailtext)

    # Need to do it twice to properly handle following case: \n.\n.\n.\n.\n.\n
    CALL sbmt.replace("\n.\n", "\n..\n", 0)
    CALL sbmt.replace("\n.\n", "\n..\n", 0) 
    LET mailtext=sbmt.toString()
    IF attachments.getLength() == 0 THEN
        MB(mailbody, nl, SFMT("Content-Type: text/plain; charset=%1\r", "ISO-8859-1"))
        MB(mailbody, nl, SFMT("Content-Transfer-Encoding: %1\r", "7bit"))

        MB(mailbody, nl, "\r")
        MB(mailbody, nl, mailtext)
        MB(mailbody, nl, "\r")
    ELSE
        MB(mailbody, nl, "Content-Type: multipart/mixed;\r")
        MB(mailbody, nl, ' boundary="' || boundary || '"\r')
        MB(mailbody, nl, "\r")
        MB(mailbody, nl, "This is a multi-part message in MIME format.\r")
        
        # Add message text
        MB(mailbody, nl, "--" || boundary || "\r")
        MB(mailbody, nl, SFMT("Content-Type: text/plain; charset=%1; format=flowed\r", "ISO-8859-1"))
        MB(mailbody, nl, SFMT("Content-Transfer-Encoding: %1\r", "7bit"))
        MB(mailbody, nl, "\r")
        MB(mailbody, nl, mailtext)
        MB(mailbody, nl, '\r')

        FOR i = 1 TO attachments.getLength()
            MB(mailbody, nl, "--" || boundary || "\r")

            LET extension = os.Path.extension(attachments[i].fname)
            LET mimeid = getmime(extension)
            IF mimeid == -1 THEN
                # Unknown extension.
                # Default to application/octet-stream, base64 encoded
                LET mimeid = 1
            END IF
            CASE ext2mime[mimeid].encoding
              WHEN "base64"
               MB(mailbody, nl, SFMT("Content-Type: %1;\r", ext2mime[mimeid].mime))
               MB(mailbody, nl, ' name="'|| attachments[i].fname || '"\r')
               MB(mailbody, nl, 'Content-Transfer-Encoding: base64\r')
               MB(mailbody, nl, 'Content-Disposition: inline;\r')
               MB(mailbody, nl, ' filename="'|| os.Path.basename(attachments[i].fname) || '"\r')
               MB(mailbody, nl, '\r')

               LET nl = file_to_base64(attachments[i].sname, mailbody, nl)
              WHEN "7bit"
               MB(mailbody, nl, SFMT("Content-Type: %1;\r", ext2mime[mimeid].mime))
               MB(mailbody, nl, ' name="'|| attachments[i].fname || '"\r')
               MB(mailbody, nl, 'Content-Transfer-Encoding: 7bit\r')
               MB(mailbody, nl, 'Content-Disposition: inline;\r')
               MB(mailbody, nl, ' filename="'|| os.Path.basename(attachments[i].fname) || '"\r')
               MB(mailbody, nl, '\r')

               LET nl = file_to_7bit(attachments[i].sname, mailbody, nl)
            #  OTHERWISE
            #   CALL mbox_ok("Attachment encoding", SFMT("Unsupported encoding %1.", ext2mime[mimeid].encoding), "stop")
               EXIT PROGRAM 1
            END CASE
        END FOR
        MB(mailbody, nl, "--" || boundary || "--\r")
    END IF

    # Add end of message marker
    MB(mailbody, nl, ".\r")
END FUNCTION


# Convert a file to a base64 string
REPORT gen_base64(l)
    DEFINE l BYTE
    OUTPUT
        PAGE LENGTH 1
        TOP MARGIN 0
        BOTTOM MARGIN 0
        LEFT MARGIN 0
    FORMAT
      ON EVERY ROW
          PRINTX name=base64_l l
END REPORT

# Convert a file to 7bit encoding (fake)
FUNCTION file_to_7bit(fname, mailbody, nl)
    DEFINE fname STRING
    DEFINE mailbody DYNAMIC ARRAY OF STRING
    DEFINE ac base.Channel
    DEFINE line STRING
    DEFINE nl INTEGER

    LET ac = base.Channel.create()
    CALL ac.openFile(fname, "rb")
    WHILE NOT ac.isEof()
        LET line = ac.readLine()
        MB(mailbody, nl, line)
    END WHILE
    CALL ac.close()
    RETURN nl
END FUNCTION

FUNCTION smtpSend(ch, command)
    DEFINE ch base.Channel
    DEFINE command STRING

    DEFINE smtpStatus INTEGER
    DEFINE smtpMessage STRING

    CALL clientWrite(ch, command)
    CALL readSmtpAnswer(ch) RETURNING smtpStatus, smtpMessage

    RETURN smtpStatus, smtpMessage
END FUNCTION

FUNCTION extract_email(email)
    DEFINE email STRING
    DEFINE s, e INTEGER

    LET s = email.getIndexOf("<", 1)
    LET e = email.getIndexOf(">", 1)
    IF s == 0 OR e == 0 OR s >= e THEN
        RETURN email
    END IF
    RETURN email.subString(s + 1, e - 1)
END FUNCTION    

# Returns the mime entry index for the extension `ext'
# -1 if not entry matching the extension is found.
FUNCTION getmime(ext)
    DEFINE ext STRING
    DEFINE j INTEGER
    FOR j = 1 TO ext2mime.getLength()
        IF ext2mime[j].ext == ext THEN
            RETURN j
        END IF
    END FOR
    RETURN -1
END FUNCTION

FUNCTION file_to_base64(fname, mailbody, nl)
    DEFINE mailbody DYNAMIC ARRAY OF STRING
    DEFINE fname STRING
    DEFINE nl INTEGER
    DEFINE l BYTE
    DEFINE lfn STRING
    DEFINE doc om.DomDocument
    DEFINE node om.DomNode
    DEFINE lnode om.NodeList

    LET lfn = fname || ".xml"

    LOCATE l IN FILE fname
    CALL fgl_report_set_document_handler(om.XmlWriter.createFileWriter(lfn))
    START REPORT gen_base64 TO FILE "dummy_report_file"
    OUTPUT TO REPORT gen_base64(l)
    FINISH REPORT gen_base64

    # Load the generated XML file
    LET doc = om.DomDocument.createFromXmlFile(lfn)
    LET node = doc.getDocumentElement()
    LET lnode = node.selectByTagName("Item")
    LET node = lnode.item(1)
    MB(mailbody, nl, node.getAttribute("value"))
 #   IF NOT os.Path.delete(lfn) THEN
 #       CALL mbox_ok("Warning", SFMT("The temporary file %1 could not be removed.", lfn), "stop")
 #   END IF
    RETURN nl
END FUNCTION

FUNCTION readSmtpAnswer(ch)
    DEFINE ch base.Channel
    DEFINE line STRING

    DEFINE smtpStatus INTEGER
    DEFINE smtpMessage STRING

    LET smtpMessage = ""
    WHILE 1
        LET line = serverRead(ch)
        IF line IS NULL THEN
            RETURN -1, "COULD NOT READ SMTP ANSWER"
        END IF
        IF line MATCHES "[0-9][0-9][0-9] *" THEN
            IF smtpMessage.getLength() != 0 THEN
                LET smtpMessage=smtpMessage || "\n"
            END IF
            LET smtpMessage=smtpMessage.append(line.subString(4, line.getLength()))
            LET smtpStatus = line.subString(1,3)
            RETURN smtpStatus, smtpMessage
        END IF
        IF line MATCHES "[0-9][0-9][0-9]-*" THEN
            IF smtpMessage.getLength() != 0 THEN
                LET smtpMessage=smtpMessage || "\n"
            END IF
            LET smtpMessage=smtpMessage.append(line.subString(4, line.getLength()))
        END IF
    END WHILE
END FUNCTION

FUNCTION clientWrite(mc, line)
    DEFINE mc base.Channel
    DEFINE line STRING
    CALL smtplog.append('<FONT COLOR="#339933"><B>C&gt; </B>')
    CALL smtplog.append(line)
    CALL smtplog.append("<BR></FONT>")
    LET logtext=smtplog.toString()
    CALL mc.writeLine(line)
    DISPLAY "log:> ",line
END FUNCTION

FUNCTION serverRead(mc)
    DEFINE line STRING
    DEFINE mc base.Channel
    LET line = mc.readLine()
    CALL smtplog.append("<FONT COLOR=red><B>S&gt; </B>")
    CALL smtplog.append(line)
    CALL smtplog.append("<BR></FONT>")
    LET logtext=smtplog.toString()
    RETURN line
END FUNCTION

FUNCTION sendmail(rcpt, mailbody)
    DEFINE mailbody DYNAMIC ARRAY OF STRING
    DEFINE rcpt DYNAMIC ARRAY OF STRING

    DEFINE smtpStatus INTEGER
    DEFINE smtpMessage STRING

    DEFINE mc base.Channel
    DEFINE i INTEGER
    LET cnf.smtphost = 'smtp.office365.com'
    LET cnf.smtpport = 587
    LET cnf.hostname='smtp.office365.com'
    LET CNF.senderemail = 'nominas@marmotech.com.do'
    LET cnf.clave = 'Marmotech22'
    LET cnf.cnxtimeout=10
    
    LET smtplog = base.StringBuffer.create()
    LET mc = base.Channel.create()
    TRY
        DISPLAY "INICIO ",current
        CALL mc.openClientSocket(cnf.smtphost, cnf.smtpport, "ub", cnf.cnxtimeout)
    CATCH
       CALL fgl_winmessage("INFO","FALLO CONEXION","INFO")
       # CALL mbox_ok("Socket error", "The connection to the SMTP Server failed.\n", "stop")
        RETURN FALSE
    END TRY
    CALL readSmtpAnswer(mc) RETURNING smtpStatus, smtpMessage
    CALL smtpSend(mc, "HELO " || cnf.hostname || "\r") RETURNING smtpStatus, smtpMessage
    IF smtpStatus >= 400 THEN 
        CALL smtpError(mc, smtpMessage)
        RETURN FALSE
    END IF
    CALL smtpSend(mc, "STARTTLS \r") RETURNING smtpStatus, smtpMessage
    IF smtpStatus >= 400 THEN 
        CALL smtpError(mc, smtpMessage)
        RETURN FALSE
    END IF
    
    CALL smtpSend(mc, cnf.senderemail CLIPPED ||" "|| cnf.clave CLIPPED) RETURNING smtpStatus, smtpMessage
    IF smtpStatus >= 400 THEN 
        CALL smtpError(mc, smtpMessage)
        RETURN FALSE
    END IF
    
    CALL smtpSend(mc, SFMT("MAIL FROM: %1\r", extract_email(cnf.senderemail))) RETURNING smtpStatus, smtpMessage
    IF smtpStatus >= 400 THEN 
        CALL smtpError(mc, smtpMessage)
        RETURN FALSE
    END IF
DISPLAY "TERMINO ",current
    FOR i = 1 TO rcpt.getLength()
        CALL smtpSend(mc, rcpt[i]) RETURNING smtpStatus, smtpMessage
        IF smtpStatus >= 400 THEN
            CALL smtpError(mc, smtpMessage)
            RETURN FALSE
        END IF
    END FOR
      
    CALL smtpSend(mc, "DATA\r") RETURNING smtpStatus, smtpMessage
    IF smtpStatus >= 400 THEN
        CALL smtpError(mc, smtpMessage)
        RETURN FALSE
    END IF
    FOR i = 1 TO mailbody.getLength()
        CALL clientWrite(mc, mailbody[i])
    END FOR
    CALL readSmtpAnswer(mc) RETURNING smtpStatus, smtpMessage
    IF smtpStatus >= 400 THEN
        CALL smtpError(mc, smtpMessage)
        RETURN FALSE
    END IF
    CALL smtpSend(mc, "QUIT\r") RETURNING smtpStatus, smtpMessage
    IF smtpStatus >= 400 THEN
        CALL smtpError(mc, smtpMessage)
        RETURN FALSE
    END IF
    CALL mc.close()
    RETURN TRUE
END FUNCTION


# Deletes temporary attachment files
FUNCTION clear_attachments(attachments)
    DEFINE attachments DYNAMIC ARRAY OF RECORD fname, sname STRING END RECORD
    DEFINE i INTEGER

    FOR i = 1 TO attachments.getLength()
        LET rv = os.Path.delete(attachments[i].sname)
    END FOR
END FUNCTION

FUNCTION smtpError(mc, msg)
    DEFINE msg STRING
    DEFINE mc base.Channel
    DEFINE smtpStatus INTEGER
    DEFINE smtpMessage STRING

    CALL mbox_ok("SMTP Error", msg, "stop")
    CALL smtpSend(mc, "QUIT\r") RETURNING smtpStatus, smtpMessage
    CALL mc.close()
END FUNCTION