jueves, 10 de noviembre de 2011

Envío de emails con ficheros adjuntos

Es posible que sepáis que desde hace bastante tiempo, concretamente desde la versión 8.1.7, Oracle nos brinda la posibilidad de hacer envíos de emails desde la base de datos gracias al paquete UTL_SMPT. En él tenemos implementadas las funcionalidades necesarias para establecer una conversación entre el servidor de base de datos y un servidor de correo SMTP que tengamos accesible.

No obstante, la implementación del protocolo de conversación requiere conocer bastante al detalle cómo funciona SMTP; por ello Oracle incluyó en sus distribuciones un paquete de demostración llamado DEMO_MAIL que nos facilitaba bastante las cosas. Más adelante, desde la versión 10g, tenemos a nuestra disposición el paquete UTL_MAIL que es aún nos lo pone más fácil.

Sin embargo, ninguna de estas implementaciones permite enviar un email de manera sencilla para el caso de emails con adjuntos, de manera que sólo haya que indicar el nombre del fichero y ocasionalmente su tipo mime; en la implementación que os presento es así, pero no hay que olvidar que el fichero debe estar almacenado en el propio servidor de base de datos.


Para la implementación he tomado como punto de partida el paquete DEMO_MAIL puesto que nos proporciona, salvo algunas excepciones, todas las primitivas necesarias. Cuando ha sido necesario añadir o cambiar alguna funcionalidad la he incorporado al paquete (los cambios y añadidos aparecen en negrita). También le he cambiado el nombre. La interfaz es la siguiente:


CREATE OR REPLACE PACKAGE Pkg_Mail_Base IS   


FUNCTION get_multipart_mime_type RETURN VARCHAR2;


FUNCTION get_max_base64_line_width RETURN PLS_INTEGER;


-- A simple email API for sending email in plain text in a single call.
-- The format of an email address is one of these:
--   someone@some-domain
--   "Someone at some domain" <someone@some-domain>
--   Someone at some domain <someone@some-domain>
-- The recipients is a list of email addresses  separated by
-- either a "," or a ";"
PROCEDURE mail(sender     IN VARCHAR2,
         recipients IN VARCHAR2,
         subject    IN VARCHAR2,
         message    IN VARCHAR2);

-- Extended email API to send email in HTML or plain text with no size limit.
-- First, begin the email by begin_mail(). Then, call write_text() repeatedly
-- to send email in ASCII piece-by-piece. Or, call write_mb_text() to send
-- email in non-ASCII or multi-byte character set. End the email with
-- end_mail().
FUNCTION begin_mail(sender     IN VARCHAR2,
              recipients IN VARCHAR2,
              subject    IN VARCHAR2,
              mime_type  IN VARCHAR2    DEFAULT 'text/plain',
              priority   IN PLS_INTEGER DEFAULT NULL) RETURN utl_smtp.connection;

-- Write email body in ASCII
PROCEDURE write_text(conn    IN OUT NOCOPY utl_smtp.connection,
               message IN VARCHAR2);

-- Write email body in non-ASCII (including multi-byte). The email body
-- will be sent in the database character set.
PROCEDURE write_mb_text(conn    IN OUT NOCOPY utl_smtp.connection,
              message IN            VARCHAR2);
  
-- Write email body in binary
PROCEDURE write_raw(conn    IN OUT NOCOPY utl_smtp.connection,
              message IN RAW);

-- APIs to send email with attachments. Attachments are sent by sending
-- emails in "multipart/mixed" MIME format. Specify that MIME format when
-- beginning an email with begin_mail().
  
-- Send a single text attachment.
PROCEDURE attach_text(
            conn         IN OUT NOCOPY utl_smtp.connection,
            DATA         IN VARCHAR2,
            mime_type    IN VARCHAR2 DEFAULT 'text/plain',
            inline       IN BOOLEAN  DEFAULT TRUE,
            filename     IN VARCHAR2 DEFAULT NULL,
            LAST         IN BOOLEAN  DEFAULT FALSE);
  
-- Send a binary attachment. The attachment will be encoded in Base-64
-- encoding format.
PROCEDURE attach_base64(
              conn         IN OUT NOCOPY utl_smtp.connection,
              DATA         IN RAW,
              mime_type    IN VARCHAR2 DEFAULT 'application/octet',
              inline       IN BOOLEAN  DEFAULT TRUE,
              filename     IN VARCHAR2 DEFAULT NULL,
              LAST         IN BOOLEAN  DEFAULT FALSE);
  
-- Send an attachment with no size limit. First, begin the attachment
-- with begin_attachment(). Then, call write_text repeatedly to send
-- the attachment piece-by-piece. If the attachment is text-based but
-- in non-ASCII or multi-byte character set, use write_mb_text() instead.
-- To send binary attachment, the binary content should first be
-- encoded in Base-64 encoding format using the demo package for 8i,
-- or the native one in 9i. End the attachment with end_attachment.
PROCEDURE begin_attachment(conn         IN OUT NOCOPY utl_smtp.connection,
                 mime_type    IN VARCHAR2 DEFAULT 'text/plain',
                 inline       IN BOOLEAN  DEFAULT TRUE,
                 filename     IN VARCHAR2 DEFAULT NULL,
                 transfer_enc IN VARCHAR2 DEFAULT NULL);
  
-- End the attachment.
PROCEDURE end_attachment(conn IN OUT NOCOPY utl_smtp.connection,
               LAST IN BOOLEAN DEFAULT FALSE);
  
-- End the email.
PROCEDURE end_mail(conn IN OUT NOCOPY utl_smtp.connection);

-- Extended email API to send multiple emails in a session for better
-- performance. First, begin an email session with begin_session.
-- Then, begin each email with a session by calling begin_mail_in_session
-- instead of begin_mail. End the email with end_mail_in_session instead
-- of end_mail. End the email session by end_session.
FUNCTION begin_session RETURN utl_smtp.connection;
  
-- Begin an email in a session.
PROCEDURE begin_mail_in_session(
                  conn       IN OUT NOCOPY utl_smtp.connection,
                  sender     IN VARCHAR2,
                  recipients IN VARCHAR2,
                  subject    IN VARCHAR2,
                  mime_type  IN VARCHAR2  DEFAULT 'text/plain',
                  priority   IN PLS_INTEGER DEFAULT NULL);
  
PROCEDURE begin_mail_in_session(
    conn        IN OUT NOCOPY utl_smtp.connection,
    sender        IN VARCHAR2,
    recipients    IN VARCHAR2,
    subject        IN VARCHAR2,
    mime_type    IN VARCHAR2  DEFAULT 'text/plain',
    priority    IN PLS_INTEGER DEFAULT NULL,
    replies        OUT UTL_SMTP.replies);

-- End an email in a session.
PROCEDURE end_mail_in_session(conn IN OUT NOCOPY utl_smtp.connection);
  
-- End an email session.
PROCEDURE end_session(conn IN OUT NOCOPY utl_smtp.connection);

 
END Pkg_Mail_Base;
/

Los únicos cambios en la especificación están en negrita y son dos funciones que se utilizarán para el envío de adjuntos. También he hecho una nueva versión de begin_mail_in_session que controla errores. Por otra parte, la implementación es la que sigue:

CREATE OR REPLACE PACKAGE BODY Pkg_Mail_Base IS
    

----------------------- Customizable Section -----------------------
   
-- Customize the SMTP host, port and your domain name below. SMTP_HOST   CONSTANT VARCHAR2(256) := 'mailserver.domain.org';
SMTP_PORT   CONSTANT PLS_INTEGER   := 25;
SMTP_DOMAIN CONSTANT VARCHAR2(256) := 'domain.org';


-- Customize the signature that will appear in the email's MIME header.
-- Useful for versioning.
MAILER_ID   CONSTANT VARCHAR2(256) := 'XXXXXXXXXXXXXXXXXXXXXXXXXXXX';
  
--------------------- End Customizable Section ---------------------
 
-- A unique string that demarcates boundaries of parts in a multi-part email
-- The string should not appear inside the body of any part of the email.
-- Customize this if needed or generate this randomly dynamically.
BOUNDARY        CONSTANT VARCHAR2(256) := '-----7D81B75CCC90D2974F7A1CBD';
 
FIRST_BOUNDARY  CONSTANT VARCHAR2(256) := '--' || BOUNDARY || utl_tcp.CRLF;
LAST_BOUNDARY   CONSTANT VARCHAR2(256) := '--' || BOUNDARY || '--' ||
                                              utl_tcp.CRLF;
 
-- A MIME type that denotes multi-part email (MIME) messages.
MULTIPART_MIME_TYPE CONSTANT VARCHAR2(256) := 'multipart/mixed; boundary="'||
                                                  BOUNDARY || '"';
MAX_BASE64_LINE_WIDTH CONSTANT PLS_INTEGER   := 76 / 4 * 3;
 
 
FUNCTION get_multipart_mime_type RETURN VARCHAR2 IS
 
BEGIN
    RETURN MULTIPART_MIME_TYPE;
END get_multipart_mime_type;
 
 
FUNCTION get_max_base64_line_width RETURN PLS_INTEGER IS
 
BEGIN
    RETURN MAX_BASE64_LINE_WIDTH;
END get_max_base64_line_width;

 
-- Return the next email address in the list of email addresses, separated
-- by either a "," or a ";".  The format of mailbox may be in one of these:
--   someone@some-domain
--   "Someone at some domain" <someone@some-domain>
--   Someone at some domain <someone@some-domain>
FUNCTION get_address(addr_list IN OUT VARCHAR2) RETURN VARCHAR2 IS
     addr VARCHAR2(256);
    i    PLS_INTEGER;
 
  FUNCTION lookup_unquoted_char(str  IN VARCHAR2,
                  chrs IN VARCHAR2) RETURN PLS_INTEGER AS
      c            VARCHAR2(5);
      i            PLS_INTEGER;
      len          PLS_INTEGER;
      inside_quote BOOLEAN;
 

  BEGIN
       inside_quote := FALSE;
       i := 1;
       len := LENGTH(str);
       WHILE (i <= len) LOOP
 
     c := SUBSTR(str, i, 1);
 
     IF (inside_quote) THEN
       IF (c = '"') THEN
         inside_quote := FALSE;
       ELSIF (c = '\') THEN
         i := i + 1; -- Skip the quote character
       END IF;
       GOTO next_char;
     END IF;
     
     IF (c = '"') THEN
       inside_quote := TRUE;
       GOTO next_char;
     END IF;
      
     IF (INSTR(chrs, c) >= 1) THEN
        RETURN i;
     END IF;
      
     <<next_char>>
     i := i + 1;
 
       END LOOP;
    
       RETURN 0;
    
    END;
 
BEGIN 
    addr_list := LTRIM(addr_list);
    i := lookup_unquoted_char(addr_list, ',;');
    IF (i >= 1) THEN
      addr      := SUBSTR(addr_list, 1, i - 1);
      addr_list := SUBSTR(addr_list, i + 1);
    ELSE
      addr := addr_list;
      addr_list := '';
    END IF;
   
    i := lookup_unquoted_char(addr, '<');
    IF (i >= 1) THEN
      addr := SUBSTR(addr, i + 1);
      i := INSTR(addr, '>');
      IF (i >= 1) THEN
    addr := SUBSTR(addr, 1, i - 1);
      END IF;
    END IF;
 
    RETURN addr;
END;
 
-- Write a MIME header
PROCEDURE write_mime_header(conn  IN OUT NOCOPY utl_smtp.connection,
                  NAME  IN VARCHAR2,
                  VALUE IN VARCHAR2) IS
BEGIN
    utl_smtp.write_data(conn, NAME || ': ' || VALUE || utl_tcp.CRLF);
END;
 
-- Mark a message-part boundary.  Set <last> to TRUE for the last boundary.
PROCEDURE write_boundary(conn  IN OUT NOCOPY utl_smtp.connection,
               LAST  IN            BOOLEAN DEFAULT FALSE) AS
BEGIN
    IF (LAST) THEN
      utl_smtp.write_data(conn, LAST_BOUNDARY);
    ELSE
      utl_smtp.write_data(conn, FIRST_BOUNDARY);
    END IF;
END;
 
------------------------------------------------------------------------
PROCEDURE mail(sender     IN VARCHAR2,
         recipients IN VARCHAR2,
         subject    IN VARCHAR2,
         message    IN VARCHAR2) IS
    conn utl_smtp.connection;
 

BEGIN
    conn := begin_mail(sender, recipients, subject);
    write_text(conn, message);
    end_mail(conn);
END;
 
 
------------------------------------------------------------------------
FUNCTION begin_mail(sender     IN VARCHAR2,
              recipients IN VARCHAR2,
              subject    IN VARCHAR2,
              mime_type  IN VARCHAR2    DEFAULT 'text/plain',
              priority   IN PLS_INTEGER DEFAULT NULL)
              RETURN utl_smtp.connection IS
    conn utl_smtp.connection;
BEGIN
    conn := begin_session;
    begin_mail_in_session(conn, sender, recipients, subject, mime_type, priority);
    RETURN conn;
END;
 
------------------------------------------------------------------------
FUNCTION begin_mail(
    pe_sender        IN VARCHAR2,
    pe_recipients    IN VARCHAR2,
    pe_subject        IN VARCHAR2,
    pe_mimetype        IN VARCHAR2    DEFAULT 'text/plain',
    pe_priority        IN PLS_INTEGER DEFAULT NULL,
    ps_replies        OUT UTL_SMTP.replies) RETURN utl_smtp.connection IS
    v_conn utl_smtp.connection;
    v_rep            UTL_SMTP.replies;
 
BEGIN
    v_conn := begin_session;
    begin_mail_in_session(
        conn        => v_conn,
        sender         => pe_sender,
        recipients    => pe_recipients,
        subject     => pe_subject,
        mime_type    => pe_mimetype,
        priority    => pe_priority,
        replies        => ps_replies);
    RETURN v_conn;
END begin_mail;
 
------------------------------------------------------------------------
PROCEDURE write_text(conn    IN OUT NOCOPY utl_smtp.connection,
               message IN VARCHAR2) IS
BEGIN
    utl_smtp.write_data(conn, message);
END;
 
------------------------------------------------------------------------
PROCEDURE write_mb_text(conn    IN OUT NOCOPY utl_smtp.connection,
              message IN            VARCHAR2) IS
BEGIN
    utl_smtp.write_raw_data(conn, utl_raw.cast_to_raw(message));
END;
 
------------------------------------------------------------------------
PROCEDURE write_raw(conn    IN OUT NOCOPY utl_smtp.connection,
              message IN RAW) IS
BEGIN
    utl_smtp.write_raw_data(conn, message);
END;
 
------------------------------------------------------------------------
PROCEDURE attach_text(conn         IN OUT NOCOPY utl_smtp.connection,
            DATA         IN VARCHAR2,
            mime_type    IN VARCHAR2 DEFAULT 'text/plain',
            inline       IN BOOLEAN  DEFAULT TRUE,
            filename     IN VARCHAR2 DEFAULT NULL,
                LAST         IN BOOLEAN  DEFAULT FALSE) IS
BEGIN
    begin_attachment(conn, mime_type, inline, filename);
    write_text(conn, DATA);
    end_attachment(conn, LAST);
END;
 
------------------------------------------------------------------------
PROCEDURE attach_base64(conn         IN OUT NOCOPY utl_smtp.connection,
              DATA         IN RAW,
              mime_type    IN VARCHAR2 DEFAULT 'application/octet',
              inline       IN BOOLEAN  DEFAULT TRUE,
              filename     IN VARCHAR2 DEFAULT NULL,
              LAST         IN BOOLEAN  DEFAULT FALSE) IS
    i   PLS_INTEGER;
    len PLS_INTEGER;
BEGIN
    
    begin_attachment(conn, mime_type, inline, filename, 'base64');
 
    -- Split the Base64-encoded attachment into multiple lines
    i   := 1;
    len := utl_raw.LENGTH(DATA);
    WHILE (i < len) LOOP
       IF (i + MAX_BASE64_LINE_WIDTH < len) THEN
     utl_smtp.write_raw_data(conn,
        utl_encode.base64_encode(utl_raw.SUBSTR(DATA, i,
        MAX_BASE64_LINE_WIDTH)));
       ELSE
     utl_smtp.write_raw_data(conn,
       utl_encode.base64_encode(utl_raw.SUBSTR(DATA, i)));
       END IF;
       utl_smtp.write_data(conn, utl_tcp.CRLF);
       i := i + MAX_BASE64_LINE_WIDTH;
    END LOOP;
    
    end_attachment(conn, LAST);
 
END;
 
------------------------------------------------------------------------
PROCEDURE begin_attachment(conn         IN OUT NOCOPY utl_smtp.connection,
                 mime_type    IN VARCHAR2 DEFAULT 'text/plain',
                 inline       IN BOOLEAN  DEFAULT TRUE,
                 filename     IN VARCHAR2 DEFAULT NULL,
                 transfer_enc IN VARCHAR2 DEFAULT NULL) IS
BEGIN
    write_boundary(conn);
    write_mime_header(conn, 'Content-Type', mime_type);
 
    IF (filename IS NOT NULL) THEN
       IF (inline) THEN
      write_mime_header(conn, 'Content-Disposition',
        'inline; filename="'||filename||'"');
       ELSE
      write_mime_header(conn, 'Content-Disposition',
        'attachment; filename="'||filename||'"');
       END IF;
    END IF;
 
    IF (transfer_enc IS NOT NULL) THEN
      write_mime_header(conn, 'Content-Transfer-Encoding', transfer_enc);
    END IF;
    
    utl_smtp.write_data(conn, utl_tcp.CRLF);
END;
 
------------------------------------------------------------------------
PROCEDURE end_attachment(conn IN OUT NOCOPY utl_smtp.connection,
               LAST IN BOOLEAN DEFAULT FALSE) IS
BEGIN
    utl_smtp.write_data(conn, utl_tcp.CRLF);
    IF (LAST) THEN
      write_boundary(conn, LAST);
    END IF;
END;
 
------------------------------------------------------------------------
PROCEDURE end_mail(conn IN OUT NOCOPY utl_smtp.connection) IS
BEGIN
    end_mail_in_session(conn);
    end_session(conn);
END;
 
------------------------------------------------------------------------
FUNCTION begin_session RETURN utl_smtp.connection IS
    conn utl_smtp.connection;
BEGIN
    -- open SMTP connection
    conn := utl_smtp.open_connection(smtp_host, smtp_port);
    utl_smtp.helo(conn, smtp_domain);
    RETURN conn;
END;
 
------------------------------------------------------------------------
PROCEDURE begin_mail_in_session(
    conn       IN OUT NOCOPY utl_smtp.connection,
    sender     IN VARCHAR2,
    recipients IN VARCHAR2,
    subject    IN VARCHAR2,
    mime_type  IN VARCHAR2  DEFAULT 'text/plain',
    priority   IN PLS_INTEGER DEFAULT NULL) IS
    v_replies    UTL_SMTP.replies;
 
BEGIN
    begin_mail_in_session(
          conn        => conn,
        sender        => sender,
        recipients    => recipients,
        subject        => subject,
        mime_type    => mime_type,
        priority    => priority,
        replies        => v_replies);
END;
 
------------------------------------------------------------------------
PROCEDURE begin_mail_in_session(
      conn        IN OUT NOCOPY utl_smtp.connection,
    sender        IN VARCHAR2,
    recipients    IN VARCHAR2,
    subject        IN VARCHAR2,
    mime_type    IN VARCHAR2  DEFAULT 'text/plain',
    priority    IN PLS_INTEGER DEFAULT NULL,
    replies        OUT UTL_SMTP.replies) IS

 
    my_recipients VARCHAR2(32767) := recipients;
    my_sender     VARCHAR2(32767) := sender;
 
BEGIN
 
    -- Specify sender's address (our server allows bogus address
    -- as long as it is a full email address (xxx@yyy.com).
    utl_smtp.mail(conn, get_address(my_sender));
 
    -- Specify recipient(s) of the email.
    WHILE (my_recipients IS NOT NULL) LOOP
        BEGIN
            utl_smtp.rcpt(conn, get_address(my_recipients));
 
        EXCEPTION WHEN Utl_SMTP.permanent_error THEN
            NULL;
        

        END;
    END LOOP;
 
    -- Start body of email
    utl_smtp.open_data(conn);
 
    -- Set "From" MIME header
    write_mime_header(conn, 'From', sender);
 
    -- Set "To" MIME header
    write_mime_header(conn, 'To', recipients);
 
    -- Set "Subject" MIME header
    write_mime_header(conn, 'Subject', subject);
 
    -- Set "Content-Type" MIME header
    write_mime_header(conn, 'Content-Type', mime_type);
 
    -- Set "X-Mailer" MIME header
    write_mime_header(conn, 'X-Mailer', MAILER_ID);
 
    -- Set priority:
    --   High      Normal       Low
    --   1     2     3     4     5
    IF (priority IS NOT NULL) THEN
      write_mime_header(conn, 'X-Priority', priority);
    END IF;
 
    -- Send an empty line to denotes end of MIME headers and
    -- beginning of message body.
    utl_smtp.write_data(conn, utl_tcp.CRLF);
 
    IF (mime_type LIKE 'multipart/mixed%') THEN
      write_text(conn, 'This is a multi-part message in MIME format.' ||
    utl_tcp.crlf);
    END IF;
END begin_mail_in_session;
 
------------------------------------------------------------------------
PROCEDURE end_mail_in_session(conn IN OUT NOCOPY utl_smtp.connection) IS
BEGIN
    utl_smtp.close_data(conn);
END;
    
------------------------------------------------------------------------
PROCEDURE end_session(conn IN OUT NOCOPY utl_smtp.connection) IS
BEGIN
    utl_smtp.quit(conn);
END;
 
END Pkg_Mail_Base;
/


La nueva versión de begin_mail_in_session tiene un pequeño cambio bastante sutil: cuando se trata de añadir un destinatario, si este no existe, se eleva un error pero es ignorado, por lo que el email aún así se trata de enviar a los otros destinatarios. En la implementación original este error impide que se envíe el email.

Vamos ahora con la implementación del paquete. En la definición se incluyen dos tipos para manejar los adjuntos y tres funciones: una para validar una dirección de email y otras dos para el envío de emails, con y sin ficheros adjuntos:


CREATE OR REPLACE PACKAGE Pkg_Emails AS

TYPE r_attachment IS RECORD (
    filename    VARCHAR2(255),
    mimetype    VARCHAR2(64) DEFAULT 'text/plain'
);
TYPE t_attachments IS TABLE OF r_attachment INDEX BY BINARY_INTEGER;

-- Determina si un email tiene un formato válido 
FUNCTION is_valid_mail_address(Pe_mail VARCHAR2) RETURN BOOLEAN;


-- Función para enviar un email
-- Si hay más de un destinatario, deben ir separados
-- por un separador que se puede obtener con get_separator
FUNCTION send_mail(
    pe_sender        IN VARCHAR2,
    pe_recipients    IN VARCHAR2,
    pe_subject            IN VARCHAR2,
    pe_message            IN VARCHAR2,
    ps_error            OUT VARCHAR2) RETURN NUMBER;


-- Función para enviar un email
-- Si hay más de un destinatario, deben ir separados
-- por un separador que se puede obtener con get_separator
FUNCTION send_mail_with_attachments(
    pe_sender        IN VARCHAR2,
    pe_recipients    IN VARCHAR2,
    pe_subject        IN VARCHAR2,
    pe_message        IN VARCHAR2,
    pe_attachments    IN t_attachments,
    ps_replies        OUT UTL_SMTP.replies) RETURN NUMBER;


END Pkg_Emails;

Mediante una variable de tipo r_atttachment podemos indicar el nombre de un fichero a adjuntar y su tipo mime. Normalmente el valor para ficheros de texto será text/plain y application/octet para ficheros binarios, si bien en este último caso podemos ser más específicos, pero no es estrictamente necesario. Otra posibilidad es almacenar también el directorio donde se encuentra el fichero y usarlo para generar la ruta. Sin embargo en este caso he optado por usar un directorio de Oracle llamadado FILESDIR que he creado de esta manera:
 
CREATE OR REPLACE DIRECTORY filesdir AS '/miruta';
GRANT READ ON DIRECTORY filesdir TO miusuario;

En cuanto a la implementación tenemos lo siguiente:
  • Una función llamada is_valid_mail_address que valida una dirección de email mediante una expresión regular, incluyendo el formato extendido que permiten algunos servidores, de la forma "Nombre" <direccion@dominio>. Es importante esta función porque antes de generar el email hay que descartar los destinatarios que no tengan el formato adecuado. De lo contrario el email no podrá será enviado. En mi caso llamo a get_valid_recipients que haciendo uso de esta función devuelve sólo los destinatarios válidos. La implementación la dejo a vuestra elección. 
  • La función send_mail es trivial porque simplemente usa los servicios del paquete base para enviar un email sencillo.
  • Por último tenemos send_mail_with_attachments que es probablemente la función más interesante y útil. Esta función genera un email con la siguiente estructura:
  1. Una cabecera, generada gracias a begin_mail del paquete PKG_Email_Base. Como el email contiene adjuntos, el tipo mime tiene que ser obligatoriamente de tipo multipart.
  2. Todo lo que vaya a partir de ahí son los adjuntos, incluído el texto del email, el cual no es más que un adjunto de tipo text/plain que se muestra en el cuerpo del email; por ello el parámetro inline debe tener el valor TRUE. Los adjuntos tienen a su vez la siguiente estructura: comienzo, contenido y fin del adjunto. Dicha estructura se genera gracias a las primitivas de PKG_Mail_Base.
  3. Para adjuntar los ficheros se usan las funciones auxiliares attach_text_file o attach_binary_file según sea un adjunto de texto o binario, debido a que el tratamiento en ambos casos es diferente, pero en cualquier caso la estructura general de cada adjunto es la misma.
  4. Sobre attach_text_file, destacar que el tipo mime deb ser text/plain, con el parámetro inline siempre a FALSE (para que no se vea en el cuerpo del email). Además el fichero ha de manipularse en modo texto y al final del adjunto se ha de indicar si es el último adjunto o no.
  5. En cuanto a attach_binary_file, el fichero ha de manipularse en modo binario y antes de adjuntar cada trozo del mismo, tiene que convertirse a formato base64. De ahí que se utilice el tipo RAW y se haga la conversión mediante el paquete UTL_ENCODE.
  6. Por último se envía el fin del email.
La implementación es la siguiente:



CREATE OR REPLACE PACKAGE BODY Pkg_Emails AS
 
-- nombre de directorio creado para almacenar ficheros
FILES_DIRECTORY_NAME    CONSTANT VARCHAR2(255) := 'FILESDIR';
 
FUNCTION is_valid_mail_address(pe_mail VARCHAR2) RETURN BOOLEAN IS
 
BEGIN
    RETURN REGEXP_LIKE(pe_mail,'("([^"])+")?\s?([_a-zA-Z0-9-]+(\.[_a-zA-Z0-9-]+)*@[a-zA-Z0-9-]+(\.[a-zA-Z0-9-]+)*(\.[a-zA-Z]{2,4})|<[_a-zA-Z0-9-]+(\.[_a-zA-Z0-9-]+)*@[a-zA-Z0-9-]+(\.[a-zA-Z0-9-]+)*(\.[a-zA-Z]{2,4})>)$');
END is_valid_mail_address;
 
 

FUNCTION attach_text_file(
    conn                IN OUT NOCOPY utl_smtp.connection,
    pe_attachment_path    IN VARCHAR2,
    pe_attachment_file    IN VARCHAR2,
    pe_last                IN BOOLEAN,
    ps_error            OUT VARCHAR2) RETURN NUMBER IS
 
    v_line                VARCHAR2(1024);
    v_data                RAW(1024);
    v_handler            UTL_FILE.FILE_TYPE;
 
BEGIN
    BEGIN
        v_handler := UTL_FILE.FOPEN(pe_attachment_path,pe_attachment_file,'r');
 
    EXCEPTION WHEN UTL_FILE.INVALID_PATH THEN
        ps_error := 'Fichero ' || pe_attachment_path || '/' || pe_attachment_file || ' no encontrado'; 
        RETURN -1;
 
    WHEN UTL_FILE.INVALID_OPERATION THEN
        ps_error := 'Fichero ' || pe_attachment_path || '/' || pe_attachment_file || ' no abrir en modo lectura'; 
        RETURN -2;
 
    WHEN UTL_FILE.INVALID_FILENAME THEN
        ps_error := 'Nombre de fichero ' || pe_attachment_path || '/' || pe_attachment_file || ' erróneo'; 
        RETURN -3;
    END;
 
    -- 1º) Cabecera del adjunto
    Pkg_Mail_Base.begin_attachment(
        conn         => conn,
        mime_type    => 'text/plain',
        inline       => FALSE,
        filename     => pe_attachment_file);  
 
    -- 2º) Incluir los datos del adjunto
    LOOP
        BEGIN
            -- Leer del fichero
            UTL_FILE.GET_LINE(
                FILE        => v_handler, 
                buffer        => v_line
            );
 
        -- Cuando no haya más datos salir
        EXCEPTION WHEN NO_DATA_FOUND THEN
            EXIT;
 
        WHEN OTHERS THEN
            BEGIN
                UTL_FILE.FCLOSE(v_handler);
         
            EXCEPTION WHEN OTHERS THEN
                NULL;
            END;
 
            ps_error := 'Error al leer el fichero ' || pe_attachment_path || '/' || pe_attachment_file || ': ' || SQLERRM; 
            RETURN -4;
        END;
 
        -- Añadir el texto al adjunto y nueva línea
        Pkg_Mail_Base.write_text(
            conn    => conn,
            message => v_line);
 
        Pkg_Mail_Base.write_text(
            conn    => conn,
            message => utl_tcp.CRLF
        );
    END LOOP;
 
    BEGIN
        UTL_FILE.FCLOSE(v_handler);
 
    EXCEPTION WHEN OTHERS THEN
        NULL;
    END;
 
    -- Poner marca de finalización de attachment
    Pkg_Mail_Base.end_attachment(
        conn    => conn,
        LAST    => pe_last
    );
 
    RETURN 1;
END attach_text_file;
 
 
FUNCTION attach_binary_file(
    conn                IN OUT NOCOPY utl_smtp.connection,
    pe_attachment_path    IN VARCHAR2,
    pe_attachment_file    IN VARCHAR2,
    pe_mimetype            IN VARCHAR2,
    pe_last                IN BOOLEAN,
    ps_error            OUT VARCHAR2) RETURN NUMBER IS
 
    v_handler    UTL_FILE.FILE_TYPE;
    v_data        RAW(32767);
    v_read        BINARY_INTEGER;
 
BEGIN
    -- Abrir fichero
    BEGIN
        v_handler := UTL_FILE.FOPEN(pe_attachment_path,pe_attachment_file,'rb',32767);
 
    EXCEPTION WHEN UTL_FILE.INVALID_PATH THEN
        ps_error := 'Fichero ' || pe_attachment_file || ' no encontrado'; 
        RETURN -1;
 
    WHEN UTL_FILE.INVALID_OPERATION THEN
        ps_error := 'Fichero ' || pe_attachment_file || ' no abrir en modo lectura'; 
        RETURN -2;
 
    WHEN UTL_FILE.INVALID_FILENAME THEN
        ps_error := 'Nombre de fichero ' || pe_attachment_file || ' erróneo'; 
        RETURN -3;
    END;
 
    -- Añadir cabecera al adjunto
    Pkg_Mail_Base.begin_attachment(
        conn         => conn,
        mime_type    => pe_mimetype,
        inline       => FALSE,
        filename     => pe_attachment_file,
        transfer_enc => 'base64');  
 
    LOOP
        BEGIN
            -- Leer del fichero
            UTL_FILE.GET_RAW(
                FILE    => v_handler,
                buffer     => v_data);
 
        -- Cuando no haya más datos salir
        EXCEPTION WHEN NO_DATA_FOUND THEN
            EXIT;
 
        WHEN OTHERS THEN
            BEGIN
                UTL_FILE.FCLOSE(v_handler);
         
            EXCEPTION WHEN OTHERS THEN
                NULL;
            END;
 
            ps_error := 'Error al leer el fichero ' || pe_attachment_file || ': ' || SQLERRM; 
            RETURN -4;
        END;
 
        -- Split the Base64-encoded attachment into multiple lines
        DECLARE
            i    BINARY_INTEGER;
            len BINARY_INTEGER;
            max_base64_line_width PLS_INTEGER;
 
        BEGIN
            max_base64_line_width := Pkg_Mail_Base.get_max_base64_line_width();
            i   := 1;
            len := utl_raw.LENGTH(v_data);
            WHILE (i < len) LOOP
                IF (i + max_base64_line_width < len) THEN
                    Pkg_Mail_Base.write_raw(conn,utl_encode.base64_encode(utl_raw.SUBSTR(v_data, i,max_base64_line_width)));
     
                ELSE
                    Pkg_Mail_Base.write_raw(conn,utl_encode.base64_encode(utl_raw.SUBSTR(v_data, i)));
                END IF;
                i := i + max_base64_line_width;
            END LOOP;
        END;
    END LOOP;
 
    BEGIN
        UTL_FILE.FCLOSE(v_handler);
 
    EXCEPTION WHEN OTHERS THEN
        NULL;
    END;
 
    Pkg_Mail_Base.end_attachment(conn, pe_last);
 
    RETURN 1;
END attach_binary_file;
 
 
FUNCTION send_mail(
    pe_sender        IN VARCHAR2,
    pe_recipients    IN VARCHAR2,
    pe_subject        IN VARCHAR2,
    pe_message        IN VARCHAR2,
    ps_error        OUT VARCHAR2) RETURN NUMBER IS
    v_destinatarios    VARCHAR2(32767);
 
BEGIN
    -- Filtrar los destinatarios no válidos
    v_destinatarios := get_valid_recipients(pe_recipients);
 
    BEGIN
        Pkg_Mail_Base.mail(
            sender        => pe_sender,
            recipients    => v_destinatarios,
            subject        => pe_subject,
            message        => pe_message);
 
    EXCEPTION WHEN utl_smtp.INVALID_OPERATION OR utl_smtp.TRANSIENT_ERROR OR utl_smtp.PERMANENT_ERROR THEN
        ps_error := SQLERRM(SQLCODE);
        RETURN SQLCODE;
    END;
 
    RETURN 1;
END send_mail;
 
 
-- Función para enviar un email con adjuntos
FUNCTION send_mail_with_attachments(
    pe_sender        IN VARCHAR2,
    pe_recipients    IN VARCHAR2,
    pe_subject        IN VARCHAR2,
    pe_message        IN VARCHAR2,
    pe_attachments    IN t_attachments,
    ps_replies        OUT UTL_SMTP.replies) RETURN NUMBER IS
    v_conn            utl_smtp.connection;
    v_data            RAW(32767);
    v_last_attach    BOOLEAN;
    v_destinatarios    VARCHAR2(32767);
 
    SIG_ADJUNTO        EXCEPTION;
    v_mensaje        VARCHAR2(1024);
 
    ct                NUMBER := 0;
    v_ret            NUMBER;
 
BEGIN
    -- Decartar los destinatarios no válidos
    v_destinatarios := get_valid_recipients(pe_recipients);
 
    -- Iniciar email y ponerle el texto. El mimetype multipart/mixed es imprescindible
    v_conn := Pkg_Mail_Base.begin_mail(
        sender        => pe_sender, 
        recipients    => v_destinatarios, 
        subject        => pe_subject,
        mime_type    => Pkg_Mail_Base.get_multipart_mime_type());
 
    -- Añadir cuerpo del mensaje
     -- inline hace que se muestre el mensaje en el cuerpo del email
    Pkg_Mail_Base.begin_attachment(
        conn => v_conn, mime_type => 'text/plain', inline => TRUE);
    Pkg_Mail_Base.write_text(v_conn, pe_message);
    Pkg_Mail_Base.end_attachment(conn => v_conn,LAST => FALSE);
 
    -- Añadir los adjuntos
    <<add_attachments>>
    FOR i IN pe_attachments.FIRST..pe_attachments.LAST LOOP
        BEGIN
            -- Adjunto de texto
            IF pe_attachments(i).mimetype = 'text/plain' THEN
                BEGIN
                    v_ret := attach_text_file(
                        conn                => v_conn,
                        pe_attachment_path    => FILES_DIRECTORY_NAME,
                        pe_attachment_file    => pe_attachments(i).filename,
                        pe_last                => (i >= pe_attachments.LAST),
                        ps_error            => v_mensaje);
 
                EXCEPTION WHEN OTHERS THEN
                    v_ret := SQLCODE;
                    v_mensaje := SQLERRM(SQLCODE);
                END;
 
                IF v_ret < 0 THEN
                    ct := ps_replies.COUNT;
                    ps_replies(ct).code := v_ret;
                    ps_replies(ct).text := v_mensaje;
                    RAISE SIG_ADJUNTO;
                END IF;
                         
            -- Adjunto de otro tipo
            ELSE
                BEGIN
                    v_ret := attach_binary_file(
                        conn                => v_conn,
                        pe_attachment_path    => FILES_DIRECTORY_NAME,
                        pe_attachment_file    => pe_attachments(i).filename,
                        pe_mimetype            => pe_attachments(i).mimetype,
                        pe_last                => (i >= pe_attachments.LAST),
                        ps_error            => v_mensaje);
 
                EXCEPTION WHEN OTHERS THEN
                    v_ret := SQLCODE;
                    v_mensaje := SQLERRM(SQLCODE);
                END;
 
                IF v_ret < 0 THEN
                    ct := ps_replies.COUNT;
                    ps_replies(ct).code := v_ret;
                    ps_replies(ct).text := v_mensaje;
                    RAISE SIG_ADJUNTO;
                END IF;
            END IF;
 
        EXCEPTION WHEN SIG_ADJUNTO THEN
            NULL;
        END;
    END LOOP add_attachments;
 
    -- Finalizar el email
    Pkg_Mail_Base.end_mail(v_conn);
    RETURN 1;
 
EXCEPTION WHEN OTHERS THEN
    ps_replies(ct).code := SQLCODE;
    ps_replies(ct).text := SQLERRM(SQLCODE);
    RETURN SQLCODE;
END send_mail_with_attachments;


END PKG_Emails;


Espero que os sea de utilidad y a la vez os haya resultado instructivo. Al menos para mi, la implementación de esta solución sí lo ha sido.

10 comentarios:

  1. Gracias compañero, voy a utilizarlo, si sale error espero me puedas echar un cable. Saludos.

    ResponderEliminar
  2. Gracias por tu aporte. ¿Puedes darme un ejemplo de como usar el paquete?

    ResponderEliminar
  3. Israel, contesto someramente al mensaje que me enviaste por email (las etiquetas HTML han sido alteradas deliberadamente):
    "Hola Javi,
    Leí tu blog sobre envío de adjuntos desde Oracle y me parece muy interesante, felicidades y gracias por tu aporte.
    Estoy intentando implementarlo en una base de datos 10G, he creado los paquetes en en ambiente de desarrollo pero cuando intento ejecutar el paquete me presenta error de parámetros incorrectos, ¿me das una mano por favor? El mensaje de error es obvio, quisiera saber cómo pasar los parámetros, sobre este correo como estoy haciendo la implementación. Lo que busco es enviar una imagen en el cuerpo del correo y además adjuntar la imagen.
    DECLARE
    v_mensaje VARCHAR2 (2000)
    := '[body]Feliz Cumpleaños!!
    [img src="cid:tarjeta_cumple.jpg"]
    [/body]';
    salida NUMBER;
    response UTL_SMTP.replies;
    BEGIN
    salida :=
    PKG_EMAILS.SEND_MAIL_WITH_ATTACHMENTS (
    PE_SENDER => 'cuentaprueba@noreply.com',
    PE_RECIPIENTS => 'itreminio@gmail.com',
    PE_SUBJECT => 'prueba',
    PE_MESSAGE => v_mensaje,
    PE_ATTACHMENTS => ('tarjeta_cumple.jpg', 'image/gif'),
    PS_REPLIES => response);
    END;
    "

    Gracias por tus comentarios y disculpa el retraso.

    Así, a bote pronto, si mal no recuerdo:
    1) Los ficheros a adjuntar han de ser accesibles localmente al servidor de base de datos. Si son locales al usuario, previamente se deberían transferir a dicho servidor.
    2) Ha de existir visibilidad entre el servidor de BD y el de correo, para lo cual también deben tener abiertos los puertos correspondientes.

    Compruébalo y si sirgue sin funcionar cométalo por aquí. Intentaré contestar más rápidamente.

    Un saludo.

    ResponderEliminar
  4. Hola

    Estoy teniendo problemas con el siguiente script que pretendo utilizar para enviar correos con adjuntos. De hecho el código lo copie de una pagina y le elimine algunas partes que considere que no me sirven y al final queda lo siguiente:

    CREATE OR REPLACE PROCEDURE ADMINISTRATOR.SP_ENV_EMAIL_MINIPIC_AT (
    p_from IN VARCHAR2,
    p_to IN VARCHAR2,
    ccp_to IN VARCHAR2,
    ccp_to2 IN VARCHAR2,
    p_subject IN VARCHAR2,
    p_html IN VARCHAR2,
    as_host IN VARCHAR2,
    ccp_to3 IN VARCHAR2,
    ccp_to4 IN VARCHAR2,
    v_clob IN CLOB,
    as_archivo IN varchar2,
    an_error OUT NUMBER
    )
    IS
    mailhost VARCHAR2 (30) := LTRIM (RTRIM (as_host));
    mail_conn UTL_SMTP.connection;
    crlf VARCHAR2 (2) := CHR (13) || CHR (10);
    mesg VARCHAR2 (7000);
    c_mime_boundary CONSTANT VARCHAR2(256) := 'a1b2c3d4e3f2g1';
    l_temp varchar2(32767) default null;
    l_attach_mime varchar2(1024) := 'text/html';
    l_body_html clob := empty_clob;
    l_offset number;
    l_ammount number;
    l_step PLS_INTEGER := 12000; -- A multiple of 3 and <= 24573

    -- ----------------------------------------------------------------------------
    -- Descripción: Permitir el envio a multiples destinatarios CC, fijo a 4 con
    -- generación de attachment
    -- ----------------------------------------------------------------------------
    BEGIN
    mail_conn := UTL_SMTP.open_connection (mailhost, 25);
    mesg := 'Date: '|| TO_CHAR (SYSDATE, 'dd Mon yy hh24:mi:ss')|| crlf|| p_html;

    .
    .
    .

    -- En este ciclo da el error
    --Write out the attachment blob in portions of l_step length
    FOR k IN 0 .. TRUNC((DBMS_LOB.getlength(as_archivo) - 1 )/l_step)
    LOOP
    UTL_SMTP.write_data(mail_conn, UTL_RAW.cast_to_varchar2
    (UTL_ENCODE.base64_encode(DBMS_LOB.substr(as_archivo,l_step, k * l_step + 1))));
    END LOOP;

    UTL_SMTP.write_data(mail_conn, UTL_TCP.crlf);

    -- Write the final html boundary
    utl_smtp.write_data(mail_conn, UTL_TCP.crlf || '--' || c_mime_boundary || '--' || UTL_TCP.crlf);

    ----------------------------------------------------
    -- Close the connection and end
    utl_smtp.close_data(mail_conn);
    utl_smtp.quit( mail_conn );
    dbms_lob.freetemporary(l_body_html);

    an_error := 1;

    EXCEPTION WHEN OTHERS THEN
    ROLLBACK;
    an_error := -1;
    raise_application_error (-20001,sqlerrm||'Error en SP_ENV_EMAIL_MINIPIC_AT');
    END;
    /

    El mensaje en cuestión dice:
    [Error] Execution (1: 1): ORA-20002: ORA-20001: ORA-06502: PL/SQL: numeric or value error: hex to raw conversion errorError en SP_ENV_EMAIL_MINIPIC_ATError en SP_PROC_ENVIA_EMAIL
    ORA-06512: at "ADMINISTRATOR.SP_PROC_ENVIA_EMAIL", line 274
    ORA-06512: at line 21

    Si me puedes ayudar, muchas gracias

    Att. Daniel

    ResponderEliminar
  5. Como enviar mensajes en formato html.

    ResponderEliminar
  6. Erik, no sé si te refieres a los adjuntos o al mensaje en sí:
    1) Si te refieres sólo los adjuntos, puesto que el html es texto al fin y al cabo, no hay que cambiar nada, solo preparar la tabla de adjuntos debidamente. Por ejemplo:
    DECLARE
    v_attachments t_attachments;

    BEGIN
    v_attachments(0).filename := 'loquesea.html';
    v_attachments(0).mimetype := 'text/plain';
    (...)

    2) En caso del email de tipo html con adjuntos, el texto del email se considera como un adjunto más, por lo que sólo habrá que modificar send_mail_with_attatchments en la parte donde se empieza el email, es decir, donde se hace esto:
    Pkg_Mail_Base.begin_attachment(
    conn => v_conn, mime_type => 'text/plain', inline => TRUE);
    Pkg_Mail_Base.write_text(v_conn, pe_message);
    Pkg_Mail_Base.end_attachment(conn => v_conn,LAST => FALSE);

    Cambiarlo por esto:
    Pkg_Mail_Base.begin_attachment(
    conn => v_conn, mime_type => 'text/html', inline => TRUE);
    Pkg_Mail_Base.write_text(v_conn, pe_message);
    Pkg_Mail_Base.end_attachment(conn => v_conn,LAST => FALSE);


    Recuerda que pe_message tiene que contener el texto con las etiquetas propias de un documento HTML, no sólo el texto del email.

    ResponderEliminar
  7. Muchas gracias.. lo que necesitaba fue resuleto con el punto 2.

    ResponderEliminar
  8. hola disculpa cuando mando este mensaje por ejemplo :
    "leer este mensaje urgente para mañana" ===> "leer este mensaje urgente para ma?ana"

    ResponderEliminar
  9. Eso tiene que ver con la codificación de caracteres. Parece que no es igual la de la base de datos que la de tu sistema.

    ResponderEliminar