/*-----------------------------------------------------------------------*
File........: smtpmail.p
Version.....: 5.0 - 9/20/01
Description : Opens up an SMTP connection and sends an email message  
               to multiple recipients.
Input Param : 
                mailhub     char - settable SMTP server name/IP address
                EmailTo     CHAR - list of email addresses separated by 
                                semicolons or commas (All semicolons will 
                                be replaced by commas so don't include stuff
                                like Smith, John)
                EmailFrom   CHAR - email address of user originating the email, 
                                the SMTP server should require that this user 
                                is real. Format looks like:
                                <user>@<host>[;<descriptive name>]
                                Example:
                                foo@bar.com[;Mr. Foo Bar]
                EmailCC     CHAR - list of email addresses separated by 
                                semicolons or commas (All semicolons will 
                                be replaced by commas so don't include stuff
                                like Smith, John)
                Attachments CHAR - Comma separated list of attachment descriptions 
                                Format looks like: 
                                file[:type=<mimetype>][:charset=<charset>][:filetype=<filetype>]
                LocalFiles  CHAR - comma separated list of filenames to the files 
                                described in Attachments.  The filenames in this  
                                parameter must either be in the Progress path or 
                                have the entire path specified.  In contrast to 
                                filenames in the Attachments are the filenames to 
                                show for the Attachments.
                Subject     CHAR - Subject line
                Body        CHAR - Actual text of the message can be whatever you  
                                want as long as you include the correct Header 
                                information in the MIMEHeader. 
                                If you are just sending plaintext you can leave 
                                the MIMEHeader blank, this is default setting 
                                If you wanted to send HTML you might use: 
                                type=text/html:charset=us-ascii:filetype=ascii
                MIMEHeader  CHAR - [type=<mimetype>][:charset=<chrset>][:filetype=<type>]
                BodyType    char - File/text.  Determines whether a file or text 
                                goes into the message body.

Output Param: 
                oSuccessful  LOGICAL - Yes the message was succesfully generated
                                No there was some error that prevented message from being successful generated.
                                ? there may have been a problem with a recipient
                                or format of the email.
                vMessage    CHAR - Any error messages from the server

Author......: Paul C. Keary - plk@cpec.com - Coe Press Equipment Corp.
Contributors: 
                Scott Auge          - Amduus
                Mario Paranhos      - BravePoint, Inc. (770) 449-9696
                Sam Schroeder       - sschroeder@mn.rr.com 
                Geoff Crawford      - Innovative Client Servers
                Steven Lichtenberg  - Safemasters, Inc.
                Mark Bremmeyr       - I S Solutions, LTD.
                S.E. Southwell      - BravePoint, Inc. (770) 449-9696
                
Copyright...: FreeFramework 2001 - http://www.freeframework.org
Created.....: 6/26/01
Notes.......: 
            This program was adapted from a combination of the work of    
            Scott Auge and distributed as part of his mailsdk             
            Scott had laid the groundwork for sending an email with       
            attachments. But his original code did not verify the servers 
            response to make sure the data was being sent properly.  

            Mario's original work smtpmail.p was a big help in developing 
            an understanding of how SMTP works.  His program was very     
            elegant in the way it deals with Sockets however Scott's work 
            had done much more in the area of including attachments.
            
            SMTP Protocols taken from RFC821                              
            MIME Protocols taken from RFC1521

Disclaimer..: This program is not fully tested especially with  
              regard to the Reading of the Server Responses, and encoding   
              of the MIME message body . Also the logging and server params 
              are not completely developed.  
              
Modifications:
/* Sam Schroeder - sschroeder@mn.rr.com                          */
/* Changed "~n" to CHR(13) + CHR(10) as RFC821 calls for         */
/* commands to end in <CRLF>, as carriage return and line feed.  */
/* NOTE: This is not fixed in the MIME section as I was not able */
/*       to test this section.                                   */
/*                                                               */
/*                                */
/*                                                               */
/* 6/20/01 Geoff Crawford - for most robustness, it is           */
/*         necessary to loop through the WRITE() on the          */
/*         socket in case if the underlying transport            */
/*         does the write in more than one step.  A              */
/*         simple loop was added.                                */
/* 6/28/01 Steven Lichtenberg - Added checks for server response */
/*         to ensure the conversation happens.  On initial       */
/*         connection, there may be a significant lag before the */
/*         server responds. Looping through to recheck for       */
/*         response was necessary                                */
/* 7/3/01  Steven Lichtenberg - Modifications to more fully      */
/*         incorporate Mario's original code andto make the      */
/*         routine more modular.  Added robustness features to   */
/*         ensure the complete/correct delivery of binary        */
/*         attachments through the use of MEMPTR.  Also added    */
/*         the ability to use either                             */
/*         a file or passed text for the message body.  This     */
/*         allows for the options of sending a file as an        */
/*         attachment or as the message body.  Reworked to use   */
/*         event driven principles for cleaner code and easier   */
/*         maintenance.                                          */
/* 7/9/01  Paul Keary - Replaced CHR(13) + CHR(10) with crlf     */
/*         Decreased indentation of some of code to 2 spaces for */
/*         better readability on character screens.              */
/*         Added code to set Encodedirectory based on OPSYS      */
/*         Capitalized most of the Progress Keywords(anal,I know)*/
/*         Found a line with a single period just after the line */
/*         where cBoundary = "MAIL_BOUNDARY", it appears to have */
/*         been introduced when the ~n were orginally changed to */
/*         to CHR(13) + CHR(10).                                 */
/*         Added alternative API that is activated by removing   */
/*         preprocesser PublicVersion                            */
/*         Found logic errors surrounding getsocket code and what*/
/*         happens if getsocket doesnot succeed.                 */
/* 7/12/01 Found a problem with the filename used for binary file*/
/*         if the input file name is a full path.  On a Unix box */
/*         it tried to write a file like /tmp//u/htmldocs/...    */
/*         Notice the 2 /'s after tmp.  Modified the code to use */
/*         a unique filename like en78422  instead of added a #  */
/*         onto the end of the original local file               */
/*         Also found attachbinlist was being delimited with a   */
/*         '<' for binaryfiles instead of a ',' This appeared to */
/*         a typing error, I am surprised it wasn't noticed b4now*/
/* 7/12/01 Mario Paranhos - fixed some tiny bugs in the mime type*/
/* 8/30/01 Mark Bremmeyr - Found a problem when body is from a   */
/*         file. Changed GetFile to process attachments and body */
/*         differently. Body text needed ~n before and after     */
/*         the content of input file.                            */
/* 9/20/01 Steve Southwell - Added the ability to have a descrip-*/
/*         tive "from".  Reformatted header in FFW format.       */
*-----------------------------------------------------------------------*/


/********** forward declare functions ***********/

FUNCTION newstate RETURNS INTEGER
  (INPUT newstate AS INTEGER,
   INPUT pstring AS CHARACTER,
   INPUT hSocket AS HANDLE) FORWARD.
FUNCTION getfile RETURNS MEMPTR(INPUT filnm AS CHAR, INPUT FileType AS CHAR) FORWARD.

/******************** Variable definitions **************/

/* 7/9/01 PK - to support 2 API's for calling this procedure */
/* Uncomment the following line to use the defactor API as set on the
   FreeFrameWork, alternate version uses mailhub defined within this 
   program and does not use BodyType or vMessage */
&SCOPED-DEFINE PublicVersion 1
&IF DEFINED(PublicVersion) > 0
&THEN
DEF INPUT PARAMETER mailhub         as char no-undo.
DEF INPUT PARAMETER EmailTo         AS CHAR NO-UNDO.
DEF INPUT PARAMETER EmailFrom       AS CHAR NO-UNDO.
DEF INPUT PARAMETER EmailCC         AS CHAR NO-UNDO.
DEF INPUT PARAMETER Attachments     AS CHAR NO-UNDO.
DEF INPUT PARAMETER LocalFiles      AS CHAR NO-UNDO.
DEF INPUT PARAMETER Subject         AS CHAR NO-UNDO.
DEF INPUT PARAMETER Body            AS CHAR NO-UNDO.
DEF INPUT PARAMETER MIMEHeader      AS CHAR NO-UNDO.
DEF INPUT PARAMETER BodyType        as char no-undo.

DEF OUTPUT PARAMETER oSuccessful    AS LOGICAL NO-UNDO.
DEF OUTPUT PARAMETER vMessage       AS CHAR NO-UNDO.
/*                                                                       */
/* /*****************************************************************    */
/*    Added by Paul Keary on 7/9/01                                      */
/*    This code can be used to simplify calls to smtpmail.p              */
/*    Note the version that appeared on FreeFramework.org had EmailTo as */
/*    the first Parameter, This version has EmailFrom as First Parameter */
/*    to coincide with the default format in Outlook, either way is fine */
/*    this is more to be capatible with older code                       */
/*  ****************************************************************/    */
&ELSE
DEF INPUT PARAMETER EmailFrom           AS CHAR NO-UNDO.
DEF INPUT PARAMETER EmailTo           AS CHAR NO-UNDO.
DEF INPUT PARAMETER EmailCC           AS CHAR NO-UNDO.
DEF INPUT PARAMETER Attachments       AS CHAR NO-UNDO.
DEF INPUT PARAMETER LocalFiles        AS CHAR NO-UNDO.
DEF INPUT PARAMETER Subject           AS CHAR NO-UNDO.
DEF INPUT PARAMETER Body                AS CHAR NO-UNDO.
DEF INPUT PARAMETER MIMEHeader        AS CHAR NO-UNDO.

DEF OUTPUT PARAMETER oSuccessful      AS LOGICAL NO-UNDO.
DEF VAR BodyType                    AS CHAR INITIAL "TEXT" NO-UNDO.
DEF VAR Mailhub                     AS CHAR INITIAL "mail.foo.bar.com" NO-UNDO.
DEF VAR vMessage                    AS CHAR NO-UNDO.
&ENDIF
/* End of Alternate API call definition */


/* Configure These Parameters per your specific needs */
DEF VAR loglevel                    AS INTEGER NO-UNDO.
DEF VAR LogFile                     AS CHARACTER NO-UNDO.
DEF VAR EncodeDirectory             AS CHAR NO-UNDO.
DEF VAR timezone                    AS CHAR NO-UNDO.

DEF VAR cLocalFile                  AS CHARACTER NO-UNDO.
DEF VAR cBinaryFile                 AS CHARACTER NO-UNDO.

/* Used to communicate with SMTP Socket */
DEF VAR hSocket                     AS HANDLE NO-UNDO.

DEF VAR ServResponse                AS CHAR FORMAT "x(40)" NO-UNDO.
DEF VAR ServerCode                  AS INTEGER NO-UNDO.
DEF VAR vState                      AS INTEGER  NO-UNDO.
DEF VAR crlf                        AS CHAR NO-UNDO.


/* SWL 07/03/2001 counter for looping */
DEF VAR icnt                        AS INTEGER   NO-UNDO.
DEF VAR icnt1                       AS INTEGER   NO-UNDO.
DEF VAR filcnt                      AS INTEGER   NO-UNDO.
DEF VAR rcptcnt                     AS INTEGER   NO-UNDO.
DEF VAR rspcnt                      AS INTEGER   NO-UNDO.
DEF VAR AttachBinlist               AS CHARACTER NO-UNDO.
/****************************************************************/
/* Only Log attachments if debug level = 1                      */
/*   modify log locations as required                           */
/****************************************************************/

/* Closest we come to a Constant Variable in Progress.
   DO NOT change the value of crlf */
crlf = CHR(13) + CHR(10).

loglevel = 1.  /* Minimal logging = 3 Verbose loggin = 1 */
/* 7/9/01 PK - Eliminate need to configure for most users */
&IF OPSYS = "UNIX" &THEN
EncodeDirectory = "/tmp/".
LogFile = "/tmp/socketemail.log".
&ELSE
EncodeDirectory = SESSION:TEMP-DIRECTORY.
LogFile = "socketemail.log". /* Write to default directory */
&ENDIF


/* Make sure EncodeDirectory ends in a /  */
IF SUBSTRING(EncodeDirectory,LENGTH(EncodeDirectory),1) <> "/" THEN
  EncodeDirectory = EncodeDirectory + "/".

/* Determine which timezone we are in so that the Mail will have the
   correct SENT Time
   Calling all programmers!!!
   IF Anyone has a better way to set the TimeZone on a Non-Unix 
   platform please submit the code to the freeframework. */
&IF OPSYS = "UNIX"
&THEN
  INPUT THROUGH date +%Z NO-ECHO.
  SET timezone.
  INPUT CLOSE.
&ELSE timezone = "EST".
&ENDIF

DEFINE STREAM sLogfile.
&GLOBAL-DEFINE Stream STREAM sLogFile
&GLOBAL-DEFINE LOGGER PUT {&Stream} UNFORMATTED TODAY " " STRING (TIME, "hh:mm:ss") " "

/* No Point in doing anything if EmailFrom and EmailTo Not Known */
IF EmailFrom = "" or
   EmailTo = "" THEN DO:
  vmessage = "From or To is blank".
  RETURN.
END. /* if emailfrom = "" or emailto = "" */

OUTPUT {&Stream} TO VALUE(LogFile) UNBUFFERED APPEND.

IF loglevel <= 2 THEN
  {&logger} SKIP "***************** *********** New group ****** **************" SKIP.

IF loglevel <= 2 THEN
  {&Logger} "Socket email started" SKIP
          "Input Parameters" SKIP
          "EmailFrom = " EmailFrom SKIP
          "EmailTo = " EmailTo SKIP
          "EmailCC = " EmailCC SKIP
          "Attachments = " Attachments SKIP
          "LocalFiles = " LocalFiles SKIP
          "Subject = " Subject SKIP
          "Body = " Body SKIP
          "MIMEHeader = " MIMEHeader SKIP.
ELSE {&Logger} "Send Mail From " EmailFrom " to " EmailTo SKIP.
/* process attachments and generate a comma separated list of
   file names for the output of base64encode.p . This is done prior
   to opening the socket to minimize the impact on resources
   (you do not need to have a socket open doing nothing for hours */
IF localfiles <> "" THEN DO filcnt =  1 TO NUM-ENTRIES(localfiles):
  IF loglevel <= 2 THEN
    {&logger} " processing Attachement " ENTRY(filcnt,localfiles) skip.

  RUN dofiles(INPUT ENTRY(filcnt,localfiles),
              INPUT ENTRY(filcnt,attachments),
              INPUT-OUTPUT attachbinlist) NO-ERROR.

  IF vMessage <> "" THEN DO:
    RUN cleanup.
    RETURN.
  END. /* if return value <> "" then */
END. /* do icnt = 1 to num-entries(attachments) */

/****************************************************************/
/* Create the socket, log in the log file that it was succes-   */
/* ful or not.                                                  */
/****************************************************************/
IF loglevel <= 2 then {&logger} "opening socket" skip.
RUN getsocket(input loglevel,input mailhub,output hSocket).
IF vMessage <> "" THEN RETURN.

IF NOT THIS-PROCEDURE:PERSISTENT THEN
  WAIT-FOR CLOSE OF THIS-PROCEDURE.

/****************************************************************/
/*  used a readhandler to avoid timing ut issues with running   */
/*  in a non-event driven mode.  Also more fully complies with  */
/*  Mario's original program design.                            */
/****************************************************************/
PROCEDURE readhandler:
  DEF VAR vlength     AS INTEGER   NO-UNDO.
  DEF VAR str         AS CHARACTER NO-UNDO.
  DEF VAR v                              AS INTEGER   NO-UNDO.
  DEF VAR idx                            AS INTEGER   NO-UNDO.
  DEF VAR mData                          AS MEMPTR    NO-UNDO.
  DEF VAR vbuffer                        AS MEMPTR    NO-UNDO.
 
 /* Used to Build MIME Message Body */
  DEF VAR cTempValue                      AS CHARACTER NO-UNDO.
  DEF VAR cBoundary                       AS CHARACTER NO-UNDO.
  DEF VAR cMimeType                       AS CHARACTER NO-UNDO.
  DEF VAR cCharSet                        AS CHARACTER NO-UNDO.
  DEF VAR cFileType                       AS CHARACTER NO-UNDO.
  DEF VAR cFile                           AS CHARACTER NO-UNDO.
  DEF VAR cImportData                     AS CHARACTER NO-UNDO.
 
  DEF VAR smtpcmd                   AS CHAR FORMAT "x(90)" NO-UNDO.
  DEF VAR teststr                   AS CHARACTER NO-UNDO.

  DEF VAR cMonth                          AS CHARACTER NO-UNDO
         INIT "Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec".

  IF NOT VALID-HANDLE(hSocket) THEN RETURN.

  vlength = hSocket:GET-BYTES-AVAILABLE().
  IF vlength > 0 THEN DO:
    SET-SIZE(vbuffer) = vlength + 1.
    hSocket:READ(vbuffer, 1, vlength, 1).
    str = GET-STRING(vbuffer,1).
    if loglevel <= 2 then 
      {&logger} "vstate " vstate skip "str " str skip.
    SET-SIZE(vbuffer) = 0.
    v = INTEGER(ENTRY(1, str," ")).

    CASE vState:
        /********************** Build message ***************/
      WHEN 1 THEN DO:
        if loglevel <= 2 then {&logger} vstate " " v " "  "HELO" skip.
        IF v = 220 THEN  /* send helo */
          vstate = newState(2, "HELO how are you?" + crlf,hsocket).
        ELSE vState = -1.
      END. /* when 1 */
        /************************ build From **************/
      WHEN 2 THEN DO:
        IF loglevel <= 2 then 
  	      {&logger} vstate " " v " "  "Mail From" skip.
        IF v = 250 THEN do:
          ASSIGN
          EmailTo = REPLACE(EmailTo,";",",").
          EmailCC = REPLACE(EmailCC,";",",").
          vstate =  newState(3, "MAIL From: " + ENTRY(1,EmailFrom,";") +
                             crlf,hsocket).
        END. /* if v = 250 */
        ELSE vState = -1.
      END. /* when 2 */
        /********************assign to and cc **************/
      WHEN 3 THEN DO:
        ASSIGN
        icnt    = if icnt = 0 then 1 else
                  (if icnt = ? then 1 else icnt)
        icnt1   = if icnt1 = 0 then 1 else
                  (if icnt1 = ? then 1 else icnt1)
        rcptcnt = num-entries(emailto) + num-entries(emailcc)
        smtpcmd = "".
        /************************************************************
         *** in case we get multiple responses back in the same packet,
         *** we need to parse the return string to determine how many
         *** responses we get back
         ***********************************************************/

        IF loglevel <= 2 THEN 
           {&logger} vstate " " v " "  "Mail to/CC" skip 
                    "rcptcnt " rcptcnt skip
                    "rspcnt " rspcnt " emailto " NUM-ENTRIES(emailto) 
                    " cc " NUM-ENTRIES(emailcc) skip.
        IF v = 250 THEN do:       /* loop through all to's and cc's  */
          DO icnt = icnt to NUM-ENTRIES(EmailTo):
            if loglevel <= 2 THEN 
              {&logger} icnt "email to " ENTRY(icnt,emailto) skip.
            vstate = newState(3, "RCPT TO: " + ENTRY(icnt,EmailTo) + 
                                 crlf,hsocket). 
          END.  /*  do icnt = 1 to num-entries(EmailTo): */
          IF emailcc <> "" THEN DO icnt1 = icnt1 to NUM-ENTRIES(Emailcc):
            IF loglevel <= 2 then 
	          {&logger} icnt1 " email to " ENTRY(icnt1,emailcc) skip.
            vstate = newState(3, "RCPT TO: " + ENTRY(icnt1,EmailCC) +
                                  crlf,hsocket). 
          END. /* if emailcc <> "" then do*/
        END. /*  IF v = 250 THEN */

        teststr = str.
        rpt-bl:
        REPEAT:
          IF INDEX(teststr,"Recipient") = 0 THEN LEAVE rpt-bl.
          ELSE rspcnt = rspcnt + 1.
          teststr = SUBSTR(teststr,INDEX(teststr,"Recipient") + 9).
        END. /* repeat */
        IF loglevel <= 2 THEN
          {&logger} "end of 3: " str skip  "rspcnt " rspcnt 
                    "rcptcnt " rcptcnt skip.
        if rspcnt = rcptcnt then
          vstate = newstate(5,"DATA " + crlf, hsocket).
      end. /* when 3 */
      /*************** build header ********************/
      WHEN 4 THEN DO:
        if loglevel <= 2 then {&logger} vstate " " v " "  "Data" skip.
        IF v = 250 THEN
          vstate = newState(5, "DATA " + crlf,hsocket).
        ELSE vState = -1.
      END. /* when 4 */
      WHEN 5 THEN DO:
        IF loglevel <= 2 then {&logger} vstate " " v " "
                               "build header/send data" skip.
        IF v = 354 THEN do:
          /* Build Email Header */
          smtpcmd = "From: " 
          + (IF NUM-ENTRIES(EmailFrom,";") > 1 THEN ENTRY(2,emailfrom,";") + " <" + ENTRY(1,emailfrom,";") + ">"
          ELSE EmailFrom) + crlf.
          /**************************************/
          /* Loop through all To's              */
          /**************************************/
          IF EmailTo <> "" THEN DO idx = 1 TO NUM-ENTRIES(EmailTo):
            smtpcmd = smtpcmd + "To: " + ENTRY(idx,EmailTo) + "~n".
          END.  /* IF EmailTo <> "" THEN DO idx = 1 */

          /*****************************/
          /* Loop through all CC's     */
          /*****************************/
          IF EmailCC <> "" THEN DO idx = 1 TO NUM-ENTRIES(EmailCC):
            smtpcmd = smtpcmd + "Cc: " + ENTRY(idx,EmailCC) + "~n".
          END.  /* IF EmailCC <> "" THEN  */
               
          ASSIGN
          smtpcmd = smtpcmd + "Subject: " + Subject + "~n" 
          /* Sample format    Date: 27 March 2001 10:30:00 EST */
          smtpcmd = smtpcmd + "Date: " + STRING(DAY(TODAY)) + " " +
                    entry(MONTH(TODAY),cMonth) + " " +
                    STRING(YEAR(TODAY),"9999") + " " +
                    STRING(TIME,"hh:mm:ss") + " " + timezone + "~n".

          SET-SIZE(mData) = LENGTH(smtpcmd) + 1.
          PUT-STRING(mData,1) = smtpcmd.
          RUN WriteData(input mData, input hsocket).
          SET-SIZE(mData) = 0.

          /********************************************************/
          /* Begin sending message                                */
          /********************************************************/
          /* Done building Email Hdr, Now do body of the message */
          /** Set up a boundary value if we have file attachments **/
          /** Create multi mime header for email **/
          IF Attachments <> "" THEN DO:
            ASSIGN
            cBoundary = "MAIL_BOUNDARY"
            smtpcmd = "MIME-Version: 1.0" + "~n" +
                      'Content-type: multipart/mixed;~n' +
		      '        boundary="' + cBoundary + '"~n' + 
                      "Content-Transfer-Encoding: 7bit~n".
            smtpcmd = smtpcmd + "This is a multi-part MIME Encoded message" +
                      "~n~n--" + cBoundary + "~n".
            SET-SIZE(mData) = LENGTH(smtpcmd) + 1.
            PUT-STRING(mData,1) = smtpcmd.
            RUN WriteData(input mData, input hsocket).
            SET-SIZE(mData) = 0.
          END. /* IF Attachments <> "" THEN DO: */

          /** Do we have a MIME Type for this messsage **/
          IF MIMEHeader <> "" THEN DO:
            RUN ParseParm(INPUT MIMEHeader,
                          OUTPUT cMimetype,
                          OUTPUT cCharset,
                          OUTPUT cfiletype).
            smtpcmd = IF Attachments = "" THEN "Mime-Version: 1.0~n"
                                           ELSE "".
            smtpcmd = smtpcmd + "Content-Type: " + cMimeType +
                      "; charset=" + cCharSet + "~n" +
                      "Content-Transfer-Encoding: 7bit~n".
            SET-SIZE(mData) = LENGTH(smtpcmd) + 1.
            PUT-STRING(mData,1) = smtpcmd.
            RUN WriteData(INPUT mData, INPUT hsocket).
            SET-SIZE(mData) = 0.
          END.  /* IF MIMEHeader <> "" THEN DO: */

          /*********************************************************/
          /* Output the Message                                    */
          /*********************************************************/
          smtpcmd = "~n".
          IF bodytype = "file" THEN DO:
            IF loglevel <= 2 THEN
              {&logger} "before getfile " GET-SIZE(mdata) skip.
            mData = getfile(body, 'B').
           IF loglevel <= 2 THEN DO:
              {&logger} "after getfile " GET-SIZE(mdata) skip.
              /* ||| 32k limit problem - SES */
              /* {&logger} "body file = " SKIP GET-STRING(mdata,1,get-size(mdata)) SKIP. */ 
            END.

            RUN WriteData(INPUT mData, INPUT hsocket).
            SET-SIZE(mData) = 0.
          END. /* if bodytype = "file" */
          ELSE DO:
            smtpcmd = smtpcmd + Body + "~n".
            SET-SIZE(mData) = length(smtpcmd) + 1.
            PUT-STRING(mData,1) = smtpcmd.
            RUN WriteData(input mData, input hsocket).
            SET-SIZE(mData) = 0.
          END.  /*  else */
          /*******************************************************/
          /* Process any files attachments.                      */
          /*******************************************************/
          /* LocalFiles holds comma separated list of files that are 
	     in the Progress path or contain an fullpath.
             Attachments holds colon separated list of parameters of
             to use in sending file. The 1st parameter is the name of 
	     file to use in generating a temporary file, the remaining
	     parameters are all optional: 
	     Type=text/plain   Charset=US-ASCII   FileType=ASCII
          */
          DO idx = 1 TO NUM-ENTRIES(LocalFiles):
            ASSIGN
            cFile = ENTRY(1,ENTRY(idx,Attachments),":")
            cLocalFile = ENTRY(idx,LocalFiles).
            
            /** set up the mime header **/
            /* Content-Type: <mimetype>; charset=<charset> */
            RUN parseParm(input entry(idx,attachments),
                          output cMimetype,
                          output cCharset,
                          output cfiletype).

            smtpcmd = "~n--" + cBoundary + "~n" +
                      "Content-type: " + cMimeType + "; ".
            IF cFileType <> "Binary" THEN
              smtpcmd = smtpcmd + "charset=" + cCharSet.
            smtpcmd = smtpcmd + '~n        name="' + cFile + '"~n'.


            IF cFileType = "Binary" THEN
              smtpcmd = smtpcmd + 'Content-Transfer-Encoding: base64~n'.

            smtpcmd = smtpcmd + 'Content-Disposition: attachment;~n' +
                      '        filename="' + cFile + '"~n~n'.
            SET-SIZE(mData) = LENGTH(smtpcmd) + 1.
            PUT-STRING(mData,1) = smtpcmd.
            RUN WriteData(INPUT mData, INPUT hsocket).
            SET-SIZE(mData) = 0.

            /** now do the file **/
           mData = getfile(ENTRY(idx,attachbinlist), 'A').
           RUN WriteData(INPUT mData, INPUT hsocket).
            SET-SIZE(mData) = 0.

	    smtpcmd = "~n".
	    SET-SIZE(mData) = LENGTH(smtpcmd) + 1.
	    PUT-STRING(mData,1) = smtpcmd.
	    RUN WriteData(INPUT mData, INPUT hsocket).
	    SET-SIZE(mData) = 0.

            /** if we have a "Binary" file then try to delete 
                the encoded version **/
            IF cFileType = "Binary" THEN
              OS-DELETE VALUE(entry(idx,attachbinlist)) NO-ERROR.
          END. /** process each attachment  do idx - 1 to num-entries **/

          IF Attachments <> "" THEN DO:
            smtpcmd = '~n--' + cBoundary + '--~n~n'.
            SET-SIZE(mData) = length(smtpcmd) + 1.
            PUT-STRING(mData,1) = smtpcmd.
            RUN WriteData(input mData, input hsocket).
            SET-SIZE(mData) = 0.
          END. /* IF Attachments <> "" THEN DO: */
          vstate = newstate(6, crlf + "." + crlf, hsocket).
        END. /* if v = 354 */
        ELSE vState = -1.
      END. /* when 5 */
      WHEN 6 THEN DO:
        IF loglevel <= 2 THEN
	      {&logger} vstate " " v " "  "send quit" skip.
        IF v = 250 THEN
          vstate = newState(7,"QUIT" + crlf,hsocket).
        ELSE vState = -1.
      END. /* when 6 */
    END CASE. /* vstate */
  END. /* IF vlength > 0 THEN DO: */
  IF loglevel <= 2 THEN {&logger}   "Finish up " vstate skip.
  IF vState = 7 THEN vMESSAGE = "Email has been accepted for delivery.".
  IF vState < 0 THEN vMESSAGE = "Email has been aborted.".
  IF vstate < 0 OR vstate = 7 THEN DO:
    RUN cleanup.
    if vstate = 7 then oSuccessful = YES.
    APPLY 'CLOSE' TO THIS-PROCEDURE.
  END.  /* IF vstate < 0 OR vstate = 7 THEN DO: */
END PROCEDURE.   /* readhandler */

PROCEDURE Cleanup.
  {&Logger} "End SMTP Session" SKIP.
  OUTPUT {&Stream} CLOSE. 

  IF VALID-HANDLE(hSocket) THEN DO:
    IF hSocket:CONNECTED() THEN hSocket:DISCONNECT() NO-ERROR.
    DELETE OBJECT hSocket.
  END.
END PROCEDURE. /* cleanup */

PROCEDURE WriteData:
  DEF INPUT PARAMETER mdata       AS memptr NO-UNDO.
  DEF INPUT PARAMETER hsocket     AS handle NO-UNDO.
  DEF VAR DataBytesWritten        AS INTEGER NO-UNDO.
  DEF VAR WriteSuccess            AS LOGICAL NO-UNDO.
  DEF VAR MessageSize             AS INTEGER NO-UNDO.
  DEF VAR mystring		  AS CHARACTER NO-UNDO.

  ASSIGN
  MessageSize = GET-SIZE(mdata)
  DataBytesWritten = 0.
  IF messagesize = 0 THEN RETURN.

  /* 7/10/01 PK - Chomp off the Null at the end of the memptr data */
  IF GET-BYTE(mData,messagesize) = 0 OR
     GET-BYTE(mData,messagesize) = 255 THEN DO:  /* ||| Is this I18N compatible? - SES */
    IF loglevel <=2 THEN
      {&logger} "1 writedata chomp data" GET-BYTE(mData,messagesize) skip.
    messagesize = messagesize - 1.
  END.

  /* 6/20/01 GC - Loop continuously until the number of bytes
                  written is greater or equal to the message size */
  IF loglevel <= 1 THEN DO:
    {&logger} "writedata = before " DataBytesWritten " " 
              MessageSize " " hSocket:BYTES-WRITTEN skip
              /*GET-STRING(mdata,1,messagesize)*/ SKIP. 
  END.
  DO WHILE DataBytesWritten < MessageSize:
    IF loglevel <= 1 THEN
      {&logger} "writedata = in " DataBytesWritten " " 
                MessageSize " " hSocket:BYTES-WRITTEN skip.
    WriteSuccess = hSocket:WRITE(mdata, DataBytesWritten + 1,
                                 MessageSize - DataBytesWritten).
    /*IF NOT WriteSuccess THEN LEAVE. */
    IF WriteSuccess THEN 
      DataBytesWritten = DataBytesWritten + hSocket:BYTES-WRITTEN.
  END. /* DO WHILE */
  IF loglevel <= 1 THEN 
    {&logger} "writedata = after " DataBytesWritten " " MessageSize " "
              hSocket:BYTES-WRITTEN skip.
  SET-SIZE(mData) = 0.
END procedure. /* writeData */

/*******************************************************************/
/** Parse mime type and char set out of header                    **/
/** If nothing there, return the default                          **/
/*******************************************************************/
PROCEDURE ParseParm:
  DEF INPUT PARAMETER cString         AS CHARACTER NO-UNDO.
  DEF OUTPUT parameter cMimetype      as character no-undo.
  DEF OUTPUT parameter cCharset       as character no-undo.
  DEF OUTPUT parameter cFiletype      as character no-undo.

  DEF VAR c               AS CHARACTER NO-UNDO.
  DEF VAR i               AS INTEGER  NO-UNDO.

  ASSIGN
  cMimeType = "text/plain"
  cCharSet  = "US-ASCII"
  cFileType = "ASCII".

  DO i = 1 TO NUM-ENTRIES(cString,":"):
    c = ENTRY(i,cString,":").
    CASE ENTRY(1,c,"="):
      WHEN "Type" THEN DO:
        cMimeType = ENTRY(2,c,"=").
      END.  /*  WHEN "Type" THEN DO: */
      WHEN "CharSet" THEN DO:
        cCharSet = ENTRY(2,c,"=").
      END.  /*   WHEN "CharSet" THEN DO: */
      WHEN "FileType" THEN DO:
        cFileType = ENTRY(2,c,"=").
      END.  /* WHEN "FileType" THEN DO: */
    END CASE. /*  CASE ENTRY(1,c,"="): */
  END.  /* DO i = 1 TO NUM-ENTRIES(cString,":"): */
END PROCEDURE. /** ParseParm **/

/*****************************************************************/
/*  Generate base 64 encoded binary files                       **/
/*****************************************************************/
PROCEDURE dofiles:
  DEF INPUT parameter localfile            as char no-undo.
  DEF INPUT parameter cattachment           as char no-undo.
  DEF INPUT-OUTPUT parameter attachbinlist as char no-undo.

  DEF VAR cLocalFile                       as char no-undo.
  DEF VAR Mimetype                     as character no-undo.
  DEF VAR ccharset                      as character no-undo.
  DEF VAR cFileType                       AS CHARACTER NO-UNDO.

  FILE-INFO:FILE-NAME = localfile.
  /***** file-info returns "F" + "RW" if the file is read/writable etc)
         check to be sure it is a valid file    ************/
  IF INDEX(FILE-INFO:FILE-TYPE,"F") = 0 THEN DO:
    vMessage = localfile + " Not a valid file".
    RETURN.
  END.

  RUN ParseParm(INPUT cAttachment,
                OUTPUT mimetype,
                OUTPUT cCHARSET,
                OUTPUT cfiletype).

  IF cFileType = "Binary" THEN DO:
    /* 7/12/02 PK if localfile includes a file path it will cause
       some problems trying to write the file in /tmp           
       Generate a unique file to use for the encoded version */

    /* cBinaryFile is used in this loop to check for existence of
       the new encoded file.  It must be reset to the desired value
       after the loop. */
    cBinaryFile = localfile.
    DO while cBinaryFile <> ?:
      /* Use of ETIME in the name is to further minimize the 
	 likelihood that the same RANDOM # could be generated by
	 2 processes at once, since there is a possibility that 
	 between the time search runs and the encoded file is actually
         created the same filename could be generated */
      cLocalFile = EncodeDirectory + "en" + STRING(ETIME) + 
		   STRING(RANDOM(1,99999),"99999").
      cBinaryFile = SEARCH(cLocalFile). /* Check for existence */
    END.

    ASSIGN
    cBinaryFile = LocalFile. /* FILE-INFO:FULL-PATHNAME better? */
    /* 7/12/01 PK The delimiter in the else statement was a '<' */
    attachbinlist = IF attachbinlist = "" THEN cLocalFile
                    ELSE attachbinlist + "," + cLocalFile.
    &IF DEFINED(PublicVersion) > 0 &THEN
      RUN ffwlib/b64encode.p(cBinaryFile, cLocalFile) NO-ERROR.
      IF ERROR-STATUS:ERROR THEN {&LOGGER} ERROR-STATUS:GET-MESSAGE(1).
    &ELSE 
      RUN utils/base64encode(cBinaryFile, cLocalFile).
    &ENDIF
  END.  /* IF cFileType = "Binary" THEN  */
  ELSE attachbinlist = IF attachbinlist = "" THEN localfile
                       ELSE attachbinlist + "," + localfile.
END PROCEDURE. /* dofiles */

PROCEDURE getsocket:
  DEF INPUT PARAMETER loglevel AS INTEGER NO-UNDO.
  DEF INPUT PARAMETER mailhub  AS CHAR NO-UNDO.
  DEF OUTPUT PARAMETER hSocket AS HANDLE NO-UNDO.

  CREATE SOCKET hSocket.
  hSocket:SET-SOCKET-OPTION ("TCP-NODELAY", "FALSE").
  hSocket:SET-SOCKET-OPTION ("SO-LINGER", "FALSE").
  hSocket:SET-READ-RESPONSE-PROCEDURE ("readHandler",THIS-PROCEDURE).

  hSocket:CONNECT("-H " + MailHub + " -S 25") NO-ERROR.

  IF hSocket:CONNECTED() = FALSE THEN DO:
    {&LOGGER} "Unable to Connect to " + Mailhub + "~n".
    RUN CleanUp.
    vmessage = "No Connection".
    RETURN.
  END.  /* Cannot make a connection to mail server */
  IF loglevel <= 2 THEN {&LOGGER} "Socket Connection Established.~n".
  vstate = 1.
END PROCEDURE. /* getsocket */

/******************* Functions ********************************/
FUNCTION newstate RETURNS INTEGER
  (INPUT newstate AS INTEGER,
   INPUT pstring AS CHARACTER,
   INPUT hSocket AS HANDLE):
  DEF VAR vState              AS INTEGER NO-UNDO.
  DEF VAR vbuffer             AS MEMPTR  NO-UNDO.
  DEF VAR DataBytesWritten    AS INTEGER NO-UNDO.
  DEF VAR WriteSuccess        AS LOGICAL NO-UNDO.
  DEF VAR MessageSize         AS INTEGER NO-UNDO.
  
  IF loglevel <= 2 THEN
     {&logger} "newstate " newstate " pstring " pstring skip .
  
  ASSIGN 
  DataBytesWritten = 0
  MessageSize = LENGTH(pstring).
        
  SET-SIZE(vbuffer) = 0.
  vState = newState.
  IF pstring = "" THEN RETURN -1.
  SET-SIZE(vbuffer) = LENGTH(pstring) + 1.
  PUT-STRING(vbuffer,1) = pstring.
     /* 6/20/01 GC - Loop continuously until the number of bytes
                     written is greater or equal to the message size */
  IF loglevel <= 2 THEN 
    {&logger} "newstate - before loop " DataBytesWritten " " 
              MessageSize " " hSocket:BYTES-WRITTEN skip.
  DO WHILE DataBytesWritten < MessageSize:
     WriteSuccess = hSocket:WRITE(vbuffer, DataBytesWritten + 1, 
                                  MessageSize - DataBytesWritten).
     IF NOT WriteSuccess THEN LEAVE.
     DataBytesWritten = DataBytesWritten + hSocket:BYTES-WRITTEN.
  END. /* DO WHILE */
  IF loglevel <= 2 THEN
    {&logger} "newstate - after loop " DataBytesWritten " "
             hSocket:BYTES-WRITTEN " " MessageSize skip.
  SET-SIZE(vbuffer) = 0.
  RETURN vstate.
END function.  /* newstate */

FUNCTION getfile RETURNS MEMPTR(INPUT filnm AS CHAR, INPUT FileType AS CHAR):
  DEF VAR hdata AS MEMPTR NO-UNDO.                                         
  DEF VAR hBody AS MEMPTR NO-UNDO.
  DEF VAR mybytecount AS INTEGER NO-UNDO.
    
  SET-SIZE(hData) = 0.
  SET-SIZE(hBody) = 0.

  FILE-INFO:FILE-NAME = filnm.
  IF loglevel <= 2 THEN 
    {&logger} "in getfile " FILE-INFO:FILE-NAME skip 
              FILE-INFO:FULL-PATHNAME skip
              FILE-INFO:FILE-TYPE skip
              FILE-INFO:FILE-SIZE skip.
    
  IF INDEX(FILE-INFO:FILE-TYPE,"F") = 0 THEN DO:
    {&logger} "index f = 0" SKIP.
    SET-SIZE(hdata) = 0.
    RETURN hdata.
  END. /*     if file-info:file-type <> "f" then */
  ELSE DO:
    SET-SIZE(hBody) = 0.
    INPUT FROM VALUE(FILE-INFO:FILE-NAME) BINARY NO-MAP NO-CONVERT.
    SET-SIZE(hBody) = FILE-INFO:FILE-SIZE + 1.
    IMPORT UNFORMATTED hBody NO-ERROR.
    INPUT CLOSE.
    IF ERROR-STATUS:ERROR THEN
      SET-SIZE(hBody) = 0.

    IF FileType = 'B' THEN DO:
        SET-SIZE(hdata) = FILE-INFO:FILE-SIZE + 3.
        PUT-STRING(hData, 1) = "~n".    
        /* ||| 32 K limit problem: -SES */
        /* PUT-STRING(hData, 2) = GET-STRING(hBody, 1). */
        /* PUT-BYTES(hData, 2) = GET-BYTES(hBody, 1, MIN(30000, GET-SIZE(hbody) - 1,GET-SIZE(hdata) - 3)). */
        message "Steve's debug 1.".
        DO mybytecount = 1 to GET-SIZE(hbody) - 1 BY 1000:
            PUT-BYTES(hData,1 + mybytecount) = GET-BYTES(hbody,mybytecount,MIN(1000,GET-SIZE(hbody) - mybytecount)). 
        END. 
        message "Steve's debug 2.".
        PUT-STRING(hData,GET-SIZE(hdata) - 1) = "~n".
    END.
    ELSE DO:
      SET-SIZE(hdata) = FILE-INFO:FILE-SIZE + 1.
      /* ||| 32 K limit problem: -SES */
      /* PUT-STRING(hData, 1) = GET-STRING(hBody, 1). */
      hdata = hbody. /* SES */
    END.
    IF loglevel <= 2 THEN
      {&logger} "get file return, hdata: " get-size(hdata) SKIP.
    RETURN hdata.
  END. /* else */
  /*  set-size(hdata) = 0. */
END FUNCTION. /* getfile */