Changeset 1575


Ignore:
Timestamp:
Jun 19, 2011, 11:40:37 PM (14 years ago)
Author:
John Small
Message:

Latest code to support automaitc uploads and announcements of a new release of FM/2.

Location:
trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • trunk/ReleaseTool.cfg

    r1542 r1575  
    4141;     Key-name             Sections Code  Description
    4242
     43;     HOST                 FTP      1     The host name of the server
     44;                          NNTP     2
     45;                          SMTP     1
     46;     USERID               FTP      2     The userid used to log in
     47;                          NNTP     2
     48;                          SMTP     2
     49;     PASSWORD             FTP      2     The password used to log in.
     50;                          NNTP     2
     51;                          SMTP     2
     52;     FROM                 NNTP     2     "From" email address
     53;                          SMTP     2
     54;     SIGNATURE            NNTP     4     Zero or more lines of "signature"
     55;                          SMTP     4
    4356;     DESCRIPTIVE_HOSTNAME FTP      1     Text used by ReleaseTool to identify
    4457;                                         an FTP site in messages to its users.
    45 ;     HOST                 FTP      1     The host name
    46 ;                          NNTP     2
    47 ;     USERID               FTP      2     The userid used to log in
    48 ;                          NNTP     2
    49 ;     PASSWORD             FTP      2     The password used to log in.
    50 ;                          NNTP     2
    5158;     DIRECTORY            FTP      4     If a change directory command is needed
    5259;                                         before uploading a file, then this key-value
    … …  
    7077;           [Not-needed]   : Userid not needed. (ReleaseTool will prompt for an absent userid.)
    7178;        Password
    72 ;           [Hobbes-email] : ReleaseTool automatically replaces this the email address from the Hobbes text file.
     79;           [Hobbes-email] : ReleaseTool automatically replaces this with the email address from the Hobbes text file.
    7380;           [Not-needed]   : Password not needed. (ReleaseTool will prompt for an absent password.)
    7481;        File
    … …  
    7885;     Password note: Instead of recording passwords in this file, it may be best to omit them and have
    7986;        ReleaseTool prompt you for them, as needed.
     87
     88;     "From" notes:
     89;        -  For newsgroups you may want to use a disguied email address to avoid spam.
     90;        -  Accepted formats:
     91;           "Full name" <user@domain.net>
     92;           <user@domain.net>
     93;           user@domain.net
    8094
    8195;  Within a section, data lines can be in any order except DIRECTORY lines, if any, must precede
    … …  
    100114File                    = [Release-zip]
    101115
    102 [NNTP]                  ; eComstation news server/groups definition
    103 Host         = news.ecomstation.nl
    104 Newsgroups   = ecomstation.apps
    105 Userid       = [Not-needed]
    106 Password     = [Not-needed]
     116;[NNTP]                  ; eComstation news server/groups definition
     117;Host         = news.ecomstation.nl
     118;Newsgroups   = ecomstation.apps
     119;Userid       = [Not-needed]
     120;Password     = [Not-needed]
    107121
    108122[NNTP]                  ; ReleaseTool user's news server/groups definition
    109 Newsgroups   = comp.os.os2.apps,comp.os.os2.utilities
    110 Host         =
    111 Userid       =
    112 Password     =
     123Newsgroups  = comp.os.os2.apps,comp.os.os2.utilities
     124;Newsgroups  = alt.test
     125Host        =
     126Userid      =
     127Password    =
     128From        = zjsmallz@osworld.net
     129Signature   = John Small
     130Signature   = (Remove z's for address)
    113131
    114132[SMTP]
    115 Command      = g:\pmmail\bin\pmmsend -a G:\PMMail\Accounts\ygk_us0.act -t "%%TO%%" -s "%%SUBJECT%%" -m %%MESSAGE_BODY_FILE%%
     133;Command     = g:\pmmail\bin\pmmsend -a G:\PMMail\Accounts\ygk_us0.act -t "%%TO%%" -s "%%SUBJECT%%" -m %%MESSAGE_BODY_FILE%%
     134;Command     = call d:\utils\internet\rexxmail\rexxmail /NewMessageSend "%%TO%% ?subject=%%SUBJECT%% &body=%%MESSAGE_BODY_FILE%%" /Address=%%FROM%% /SMTPServer=%%SERVER%% /SMTPUSER=%%USERID%% /SMTPPASSWORD=%%PASSWORD%% /TimeZone=%%UTCOFFSET%%
     135Host        = smtp.toast.net
     136Userid      = jsmall@toast.net
     137From        = "John Small" <jsmall@os2world.net>
     138;Signature   = John Small
     139Signature   = FM/2 Development Team
     140UTCOffset   = -0500

  • trunk/ReleaseTool.cmd

    r1542 r1575  
    5454 *
    5555 * To Do
     56 *    -  Support multiple SMTP definitions?
     57 *    -  Support "To" address lists in CFG file?
     58 *    -  Support optional view of SMTP message bodies
     59 *    -  Support optional view of NNTP message bodies
    5660 *    -  Improve support for external CMD files which perform some or all of a task
    57  *    -  Support sending email via PMMSend?
    58  *    -  Support sending email via REXXMail?
    5961*/
    6062
    … …  
    6769signal on SYNTAX name Error
    6870/* JBS: for debugging */
    69 /*
    7071signal on Novalue
    71 */
    72 
    73 globals = 'cfg. ver. mainmenu. cmd. Hobbes. available. prev_user_choice'
     72
     73globals = 'cfg. ver. mainmenu. cmd. email. Hobbes. available. prev_user_choice currentSMTP'
     74/* JBS: Change this to be set dynamically */
     75currentSMTP = 1
    7476
    7577parse arg args
    … …  
    184186            when user_choice = mainmenu.Ensure_work_done_num then
    185187               do /* Ensure all work (by others) is comitted */
    186                   if cfg.SMTP.1.Command = '' then
     188                  if GatherEmailData(mainmenu.Ensure_work_done_num) = 1 then
     189                     do
     190                        call SendEmail
     191                     end
     192                  else
     193                     do
     194                        say 'Error prevert automated emails.'
     195                        say 'This nositification will have to be done manually.'
     196                     end
     197                  prev_user_choice = user_choice
     198               end
     199/*
     200                  if cfg.SMTP.currentSMTP.Command = '' then
    187201                     do
    188202                        say
    … …  
    195209                     end
    196210                  else
    197                      do
    198                         say
    199                         say 'Sending a noptification email to FM/2 developers...'
    200                         say
    201                         say 'Proposed subject:'
    202                         subj = 'Commit work for FM/2' ver.full
    203                         say '   ' || subj
    204                         say
    205                         say 'If this subject is acceptable, just press Enter. Otherwise'
    206                         say 'type in the desired subject for the notification email:'
    207                         response = strip(linein())
    208                         if response \= '' then
    209                            subj = response
    210                         SMTPBody_file = SysTempFilename('SMTPBody.???')
    211                         call lineout SMTPBody_file, 'The release of FM/2' ver.full 'is imminent.'
    212                         call lineout SMTPBody_file, ''
    213                         call lineout SMTPBody_file, 'Please commit all work for this release within 24 hours.'
    214                         call lineout SMTPBody_file, ''
    215                         call lineout SMTPBody_file, 'Reply to this email if there are reasons to delay the release.'
    216                         call stream  SMTPBody_file, 'c', 'close'
    217                         say
    218                         say 'The proposed body of the notification email will now be loaded into an editor.'
    219                         say 'Make desired changes, if any, and save the file.'
    220                         say
    221                         call charout, 'Press any key when ready to load the message body into an editor: '
    222                         call SysGetKey
    223                         say
    224                         call ExecCmd cmd.editor SMTPBody_file
    225                         call SendSMTP 'TO=fm2-dev@netlabs.org <fm2-dev@netlabs.org>', ,
    226                                       'SUBJ=' || subj, ,
    227                                       'BODYFILE=' || SMTPBody_file
    228                         call SysFileDelete SMTPBody_file
    229                      end
    230                   prev_user_choice = user_choice
    231                end
     211*/
    232212            when user_choice = mainmenu.Verify_tickets_closed_num then
    233213               do /* Verify completed tickets are marked closed */
    … …  
    390370                  say
    391371                  call UploadRelease
    392                   say
    393                   say 'Post a note to "Netlabs Community" <community@netlabs.org>'
    394                   say 'requesting that the release be moved to pub/fm2.'
    395                   say
    396372                  prev_user_choice = user_choice
    397373              end
    … …  
    399375               do /* Announce the release. */
    400376                  if available.RXSOCK = 1 then
    401                      call AnnounceToNewsgroups
    402                   else
    403377                     do
    404                         say 'Since RXSOCK.DLL failed to load, this will have to be done manually.'
    405378                        say
    406                      end
     379                        say 'Posting a note to "Netlabs Community" <community@netlabs.org>'
     380                        if GatherEmailData(mainmenu.Upload_num) = 1 then
     381                           do
     382                              call SendEmail
     383                           end
     384                        else
     385                           do
     386                              say 'Errors prevented an automated email.'
     387                              say 'This nositification will have to be done manually.'
     388                           end
     389                           end
     390                        else
     391                           do
     392                              say 'Since RXSOCK.DLL failed to load, this will have to be done manually.'
     393                              say
     394                           end
     395                        call AnnounceToNewsgroups
    407396                  prev_user_choice = user_choice
    408397              end
    … …  
    434423
    435424/*** Subroutines ***/
     425GatherEmailData: procedure expose (globals)
     426   parse arg tasknum
     427   if cfg.SMTP.currentSMTP.userid = '' then
     428      do
     429         say
     430         say 'No SMTP userid was found in the CFG file for host:' cfg.SMTP.currentSMTP.host
     431         say
     432         say 'If one is needed, plese enter it. If not, just press the ENTER key:'
     433         response = strip(linein())
     434         if response \= '' then
     435            cfg.SMTP.currentSMTP.userid = response
     436      end
     437   if cfg.SMTP.currentSMTP.password = '' then
     438      do
     439         say
     440         say 'No SMTP password was found in the CFG file for host:' cfg.SMTP.currentSMTP.host
     441         say
     442         say 'If one is needed, plese enter it. If not, just press the ENTER key:'
     443         response = strip(linein())
     444         if response \= '' then
     445            cfg.SMTP.currentSMTP.password = response
     446      end
     447   select
     448      when tasknum = mainmenu.Ensure_work_done_num then
     449         do
     450            say
     451            say 'Sending a notification email to FM/2 developers...'
     452            say
     453            say 'Proposed list of addressee(s):'
     454            email.to_list = '"FM/2 Developmers" <fm2-dev@netlabs.org>'
     455            say '   ' || email.to_list
     456            say
     457            say 'If this list is acceptable, just press Enter. Otherwise'
     458            say 'type in the desired comma-separated list of addressees:'
     459            response = strip(linein())
     460            if response \= '' then
     461               email.to_list = response
     462            say
     463            say 'Proposed subject:'
     464            email.subject = 'Commit work for FM/2' ver.full
     465            say '   ' || email.subject
     466            say
     467            say 'If this subject is acceptable, just press Enter. Otherwise'
     468            say 'type in the desired subject for the notification email:'
     469            response = strip(linein())
     470            if response \= '' then
     471               email.subject = response
     472            email.body_file = SysTempFilename('SMTPBody.???')
     473            call lineout email.body_file, 'The release of FM/2' ver.full 'is imminent.'
     474            call lineout email.body_file, ''
     475            call lineout email.body_file, 'Please commit all work for this release within 24 hours.'
     476            call lineout email.body_file, ''
     477            call lineout email.body_file, 'Reply to this email if there are reasons to delay the release.'
     478            call stream  email.body_file, 'c', 'close'
     479            say
     480            say 'The proposed body of the notification email will now be loaded into an editor.'
     481            say 'Make desired changes, if any, and save the file.'
     482            say
     483            call charout, 'Press any key when ready to load the message body into an editor: '
     484            call SysGetKey
     485            say
     486            call ExecCmd cmd.editor email.body_file
     487         end
     488      when tasknum = mainmenu.Upload_num then
     489         do
     490            say
     491            say 'Sending a notification email to Netlabs...'
     492            say
     493            say 'Proposed list of addressee(s):'
     494            email.to_list = '"Netlabs Community" <community@netlabs.org>'
     495            say '   ' || email.to_list
     496            say
     497            say 'If this list is acceptable, just press Enter. Otherwise'
     498            say 'type in the desired comma-separated list of addressees:'
     499            response = strip(linein())
     500            if response \= '' then
     501               email.to_list = response
     502            say
     503            say 'Proposed subject:'
     504            email.subject = 'FM/2 version' ver.full 'released and uploaded.'
     505            say '   ' || email.subject
     506            say
     507            say 'If this subject is acceptable, just press Enter. Otherwise'
     508            say 'type in the desired subject for the notification email:'
     509            response = strip(linein())
     510            if response \= '' then
     511               email.subject = response
     512            email.body_file = SysTempFilename('SMTPBody.???')
     513            call lineout email.body_file, 'The FM/2' ver.full 'has been released.'
     514            call lineout email.body_file, ''
     515            call lineout email.body_file, 'The file: fm2-' || ver.wpi
     516            call lineout email.body_file, 'has been uploaded to /incoming/fm2'
     517            call lineout email.body_file, ''
     518            call lineout email.body_file, 'Please move this file to /pub/fm2'
     519            call stream  email.body_file, 'c', 'close'
     520            say
     521            say 'The proposed body of the notification email will now be loaded into an editor.'
     522            say 'Make desired changes, if any, and save the file.'
     523            say
     524            call charout, 'Press any key when ready to load the message body into an editor: '
     525            call SysGetKey
     526            say
     527            call ExecCmd cmd.editor email.body_file
     528         end
     529      otherwise
     530         do
     531            say 'Program Error: Email for task not yet programmed.'
     532            return 0
     533         end
     534   end
     535return 1
     536
    436537Init: procedure expose (globals)
    437538   call RxFuncAdd 'SysLoadFuncs', 'REXXUTIL', 'SysLoadFuncs'
    … …  
    628729   m = m + 1
    629730   mainmenu.Announce_num               = m
    630    mainmenu.m.text                     = 'Aannounce the release.'
     731   mainmenu.m.text                     = 'Announce the release.'
    631732   m = m + 1
    632733   mainmenu.TRAC_update_and_Next_ver_num  = m
    … …  
    673774   cfg.file       = 'ReleaseTool.cfg'
    674775   cfg.crlf       = '0D0A'x
     776   cfg.closing    = cfg.crlf || cfg.crlf || '.'
     777   cfg.user_agent = 'FM2ReleaseTool'
     778
    675779   cfg.FTP.0      = 0
    676780   cfg.NNTP.0     = 0
    677781   cfg.SMTP.0     = 0
    678    cfg.FTP.keys   = 'DESCRIPTIVE_HOSTNAME HOST USERID PASSWORD DIRECTORY FILE'
    679    cfg.NNTP.keys  = 'NEWSGROUPS HOST USERID PASSWORD'
    680    cfg.SMTP.keys  = 'COMMAND'
    681 
    682    cfg.NNTP.closing               = cfg.crlf || cfg.crlf || '.' || cfg.crlf
     782   cfg.FTP.keys   = 'HOST USERID PASSWORD DIRECTORY FILE DESCRIPTIVE_HOSTNAME'
     783   cfg.NNTP.keys  = 'HOST USERID PASSWORD FROM SIGNATURE NEWSGROUPS'
     784   cfg.SMTP.keys  = 'HOST USERID PASSWORD FROM SIGNATURE COMMAND UTCOFFSET'
     785
    683786   cfg.NNTP.signature_preface     = cfg.crlf || '-- ' || cfg.crlf
    684787   cfg.NNTP.mime_version          = '1.0'
    … …  
    687790   cfg.maxNNTPrecvbufsize = 200   /* JBS: Better number? */
    688791   /* JBS: Better name? */
    689    cfg.NNTP.user_agent            = 'FM2NNTPPoster'
     792
     793   cfg.SMTP.signature_preface     = cfg.crlf || '-- ' || cfg.crlf
    690794
    691795   retval = 0
    … …  
    703807         when left(line, 1) = '[' then
    704808            do
    705                if node = 'FTP' then
    706                   do
    707                      cfg.node.n.directory.0 = d
    708                      cfg.node.n.directory.d.file.0 = f
    709                   end
     809               select
     810                  when node = 'FTP' then
     811                     do
     812                        cfg.node.n.directory.0 = d
     813                        cfg.node.n.directory.d.file.0 = f
     814                     end
     815                  when node = 'SMTP' | node = 'NNTP' then
     816                     do
     817                        cfg.node.n.signature.0 = s
     818                        s = 0
     819                     end
     820                  otherwise
     821               end
    710822               parse upper var line '[' node ']'
    711823               cfg.node.0 = cfg.node.0 + 1
    … …  
    713825               d = 0
    714826               f = 0
     827               s = 0
    715828            end
    716829         when pos('=', line) = 0 then
    … …  
    726839                  when wordpos(key_name, cfg.node.keys) = 0 then
    727840                     retval = -(10000 + linenum)
     841                  when (node = 'SMTP' | node = 'NNTP') & key_name = 'SIGNATURE' then
     842                     do
     843                        s = s + 1
     844                        cfg.node.n.signature.s = key_value
     845                     end
    728846                  when node = 'FTP' & key_name = 'DIRECTORY' then
    729847                     do
    … …  
    752870         cfg.node.n.directory.d.file.0 = f
    753871      end
     872   else if (node = 'SMTP' | node = 'NNTP') then
     873      cfg.node.n.signature.0 = s
    754874   call stream cfg.file, 'c', 'close'
    755875return retval
    … …  
    12321352                        say
    12331353                     end
     1354                  say
    12341355                  if cfg.FTP.u.password = '' then
    12351356                     do
    … …  
    13051426            cfg.NNTP.s.password = strip(linein())
    13061427         end
    1307 /*
    1308       say 'NNTP data summary:'
    1309       say
    1310       say 'From:' cfg.NNTP.from
    1311       say 'Subject:' cfg.NNTP.subject
    1312       say 'Server(s):'
    1313       do s = 1 to cfg.NNTP.0
    1314          say '   Name:' cfg.NNTP.s.host
    1315          say '   Newsgroup(s):' cfg.NNTP.s.newsgroups
    1316          if cfg.NNTP.s.userid = '' then
    1317             say '   User: <None>'
    1318          else
    1319             say '   User:' cfg.NNTP.s.userid
    1320          if cfg.NNTP.s.password = '' then
    1321             say '   Password: <None>'
    1322          else
    1323             say '   Password:' cfg.NNTP.s.password
    1324          say
    1325       end
    1326 */
    1327 /*
    1328       say 'Body w/ signature:'
    1329       pager = 'less'
    1330       '@echo'  cfg.NNTP.message_body || cfg.NNTP.signature_preface || cfg.NNTP.signature '|' pager
    1331       '@pause'
    1332 */
     1428      if cfg.NNTP.s.from = '' then
     1429         do
     1430            say 'NNTP: The Hobbes email address is:' Hobbes.uploader_email_address
     1431            say
     1432            say 'NNTP: Type the desired email address for the newsgroups announcements.'
     1433            say 'NNTP: You may want to disguise the address to avoid spam.'
     1434            call charout , 'NNTP: (Just press ENTER to accept the Hobbes email address): '
     1435            reply = strip(linein())
     1436            if reply \= '' then
     1437               cfg.NNTP.s.from = reply
     1438            else
     1439               cfg.NNTP.s.from = Hobbes.uploader_email_address
     1440         end
    13331441      call SendNNTP s
    13341442   end
    … …  
    13361444
    13371445NNTPSetup: procedure expose (globals)
    1338    say;say
    1339    say 'NNTP: The Hobbes email address is:' Hobbes.uploader_email_address
    1340    say
    1341    say 'NNTP: Type the desired email address for the newsgroups announcements.'
    1342    say 'NNTP: You may want to disguise the address to avoid spam.'
    1343    call charout , 'NNTP: (Just press ENTER to accept the Hobbes email address): '
    1344    reply = strip(linein())
    1345    if reply \= '' then
    1346       cfg.NNTP.from = reply
    1347    else
    1348       cfg.NNTP.from = Hobbes.uploader_email_address
    13491446   say;say
    13501447   cfg.NNTP.subject = 'FM/2' ver.full 'has been released.'
    … …  
    13561453      cfg.NNTP.subject = reply
    13571454   say;say
    1358    say 'NNTP: The signature on the message will automatically be preceded by the following lines:'
    1359    say
    1360    say '-- '
    1361    say 'NNTP: Please enter the desired signature.'
    1362    cfg.NNTP.signature = strip(linein(), 'T')
    13631455
    13641456   tempfile = SysTempFilename('RTNNTPBody.???')
    … …  
    13711463   call lineout tempfile, '  ftp://ftp.netlabs.org/incoming/' || release_file
    13721464   call lineout tempfile, 'which will eventually move to'
    1373    call lineout tempfile, '  ftp://ftp.netlabs.org/pub/' || release_file
     1465   call lineout tempfile, '  ftp://ftp.netlabs.org/pub/fm2/' || release_file
    13741466   call lineout tempfile, ''
    13751467   call lineout tempfile, 'Hobbes:'
    … …  
    15031595                  do
    15041596                     say 'NNTP: Sending message...'
    1505                      rc = SockSend(socket, 'From:' cfg.NNTP.from || cfg.crlf || ,
     1597                     NNTPsig = ''
     1598                     do i = 1 to cfg.NNTP.s.signature.0
     1599                        NNTPsig = NNTPsig || cfg.NNTP.s.signature.i || cfg.crlf
     1600                     end
     1601                     rc = SockSend(socket, 'From:' cfg.NNTP.s.from || cfg.crlf || ,
    15061602                                           'Newsgroups:' cfg.NNTP.s.newsgroups || cfg.crlf || ,
    15071603                                           'Subject:' cfg.NNTP.subject || cfg.crlf || ,
    1508                                            'User-Agent:' cfg.NNTP.user_agent || cfg.crlf || ,
     1604                                           'User-Agent:' cfg.user_agent || cfg.crlf || ,
    15091605                                           'MIME-version:' cfg.NNTP.mime_version || cfg.crlf || ,
    15101606                                           'Content-Type:' cfg.NNTP.content_type || cfg.crlf || ,
    … …  
    15131609                                           cfg.NNTP.message_body || ,
    15141610                                           cfg.NNTP.signature_preface || ,
    1515                                            cfg.NNTP.signature || ,
    1516                                            cfg.NNTP.closing)
     1611                                           NNTPsig || ,
     1612                                           cfg.closing || cfg.crlf)
    15171613                     if rc < 0 then
    15181614                        do
    … …  
    16841780return
    16851781
    1686 SendSMTP: procedure expose (globals)
    1687    email_command = cfg.SMTP.1.Command
     1782ExecuteExternalSMTPProgram: procedure expose (globals)
     1783/*
     1784                        call SendSMTP 'TO=fm2-dev@netlabs.org <fm2-dev@netlabs.org>', ,
     1785                                      'SUBJ=' || subj, ,
     1786                                      'BODYFILE=' || SMTPBody_file
     1787                        call SendSMTP 'TO=fm2-dev@netlabs.org <fm2-dev@netlabs.org>', ,
     1788                                      'FROM=' || 'jsmall@os2world.net', ,
     1789                                      'SUBJ=' || subj, ,
     1790                                      'BODYFILE=' || SMTPBody_file, ,
     1791                                      'SERVER=' || cfg.SMTP.currentSMTP.host, ,
     1792                                      'USERID=' || cfg.SMTP.currentSMTP.userid, ,
     1793                                      'PASSWORD=' || 'jfkdl', ,
     1794                                      'UTCOFFSET=' || '-0500'
     1795                     end
     1796*/
     1797   email_command = cfg.SMTP.currentSMTP.Command
    16881798   do i = 1 to arg()
    16891799      parse value arg(i) with key '=' key_value
    16901800      key = translate(key)
    16911801      select
    1692          when (key = 'TO' & pos('%%TO%%', email_command) > 0) then
     1802         when pos('%%TO%%', email_command) > 0 then
    16931803            do
    16941804               parse var email_command part1 '%%TO%%' part2
    1695                email_command = part1 || key_value || part2
    1696             end
    1697          when (key = 'SUBJ' & pos('%%SUBJECT%%', email_command) > 0) then
     1805               email_command = part1 || email.to_list || part2
     1806            end
     1807         when pos('%%FROM%%', email_command) > 0 then
     1808            do
     1809               parse var email_command part1 '%%FROM%%' part2
     1810               email_command = part1 || cfg.SMTP.currentSMTP.from || part2
     1811            end
     1812         when pos('%%SUBJECT%%', email_command) > 0 then
    16981813            do
    16991814               parse var email_command part1 '%%SUBJECT%%' part2
    1700                /* JBS: Test code */
    1701                email_command = part1 || '[TEST message. Ignore] ' || key_value || part2
    1702 /*
    1703                email_command = part1 || key_value || part2
    1704 */
    1705             end
    1706          when (key = 'BODYFILE' & pos('%%MESSAGE_BODY_FILE%%', email_command) > 0) then
     1815               email_command = part1 || email.subject || part2
     1816            end
     1817         when pos('%%MESSAGE_BODY_FILE%%', email_command) > 0 then
    17071818            do
    17081819               parse var email_command part1 '%%MESSAGE_BODY_FILE%%' part2
    1709                email_command = part1 || stream(key_value, 'c', 'query exists') || part2
     1820               email_command = part1 || stream(email.bofykey_value, 'c', 'query exists') || part2
     1821            end
     1822         when pos('%%SERVER%%', email_command) > 0 then
     1823            do
     1824               parse var email_command part1 '%%SERVER%%' part2
     1825               email_command = part1 || cfg.SMTP.currentSMTP.host || part2
     1826            end
     1827         when pos('%%USERID%%', email_command) > 0 then
     1828            do
     1829               parse var email_command part1 '%%USERID%%' part2
     1830               email_command = part1 || cfg.SMTP.currentSMTP.userid || part2
     1831            end
     1832         when pos('%%PASSWORD%%', email_command) > 0 then
     1833            do
     1834               parse var email_command part1 '%%PASSWORD%%' part2
     1835               email_command = part1 || cfg.SMTP.currentSMTP.password || part2
     1836            end
     1837         when pos('%%UTCOFFSET%%', email_command) > 0 then
     1838            do
     1839               parse var email_command part1 '%%UTCOFFSET%%' part2
     1840               email_command = part1 || cfg.SMTP.currentSMTP.UTCOffset || part2
    17101841            end
    17111842         otherwise
    1712             say 'Program error: Unknown param: "' || arg(i) || '" for SendSMTP function.'
     1843            nop
    17131844      end
    17141845   end
    1715    /* JBS: Test code */
    1716    say
    1717    say 'While the new email code is being tested and debugged:'
    1718    say '1) All subjects will be prefaced by: "[TEST message. Ignore]"'
    1719    say '2) A "preview" of the pending email command will be displayed.'
     1846   say 'A "preview" of the pending email command will be displayed.'
    17201847   say
    17211848   say 'If the email command is unsuccessful, please copy and paste it and'
    17221849   say 'post it, along with a description of the error(s) and, if possible,'
    1723    say 'a proposed correction to the fm2-dev mailiing list.'
     1850   say 'a proposed correction to the fm2-dev mailing list.'
    17241851   say
    17251852   say 'The pending email command:'
    … …  
    17991926return
    18001927
     1928SendEmail: procedure expose (globals)
     1929   if cfg.SMTP.0 > 1 then
     1930      if cfg.SMTP.currentSMTP.command \= '' then
     1931         do
     1932            call ExecuteExternalSMTPProgram
     1933            return
     1934         end
     1935
     1936   socket = ConnectToMailServer(cfg.SMTP.currentSMTP.host)
     1937   if socket < 0 then
     1938      do
     1939         say 'Unable to connect to' cfg.SMTP.currentSMTP.host
     1940         call SockPSock_errno
     1941         return
     1942      end
     1943   do forever
     1944      reply = GetServerReply(socket)
     1945      if left(reply, 3) \= '220' then
     1946          do
     1947             say 'Unexpected initial response from:' cfg.SMTP.currentSMTP.host
     1948             say reply
     1949             leave
     1950          end
     1951      reply = SendDataAndGetServerReply(socket, 'EHLO' cfg.myName)
     1952      if left(reply, 3) \= '250' then
     1953         do
     1954            /* JBS: Send HELO instead? */
     1955            say reply
     1956            leave
     1957         end
     1958      auth_login_pos = pos('AUTH LOGIN', reply)
     1959      auth_plain_pos = pos('AUTH PLAIN', reply)
     1960      if auth_login_pos = 0 then
     1961         if auth_plain_pos = 0 then
     1962            do
     1963               say 'Unsupported authorization method:' reply
     1964               call SockClose socket
     1965               return
     1966            end
     1967         else
     1968            do
     1969               /* AUTH PLAIN login here */
     1970               /* JBS: Implement AUTH PLAIN login here */
     1971                  say 'AUTH PLAIN not yet implemented!'
     1972                  return
     1973            end
     1974      else
     1975         do
     1976            /* AUTH LOGIN login here */
     1977            reply = SendDataAndGetServerReply(socket, 'AUTH LOGIN')
     1978            if left(reply, 3) \= '334' then
     1979               do
     1980                  say 'Authorization failed (or unexpected response to AUTH LOGIN).' || cfg.crlf || reply
     1981                  leave
     1982               end
     1983            reply = SendDataAndGetServerReply(socket, EncodeB64(cfg.SMTP.currentSMTP.userid))
     1984            if left(reply, 3) \= '334' then
     1985               do
     1986                  say 'Authorization failed (or unexpected response to userid).' || cfg.crlf || reply
     1987                  leave
     1988               end
     1989            reply = SendDataAndGetServerReply(socket, EncodeB64(cfg.SMTP.currentSMTP.password))
     1990            if left(reply, 3) \= '235' then
     1991               do
     1992                  say 'Authorization failed (or unexpected response to password).' || cfg.crlf || reply
     1993                  leave
     1994               end
     1995            reply = SendDataAndGetServerReply(socket, 'MAIL FROM:<' || StrippedEmailAddress(cfg.SMTP.currentSMTP.from) || '>')
     1996            if left(reply, 3) \= '250' then
     1997               do
     1998                  say 'Unexpected response to MAIL FROM:' || cfg.crlf || reply
     1999                  leave
     2000               end
     2001            temp_to_list = email.to_list
     2002            do until (temp_to_list = '' | left(reply, 3) \= 250)
     2003               parse var temp_to_list addressee ',' temp_to_list
     2004               reply = SendDataAndGetServerReply(socket, 'RCPT TO: <' || StrippedEmailAddress(addressee) || '>')
     2005            end
     2006            if left(reply, 3) \= '250' then
     2007               do
     2008                  say 'Unexpected response to RCPT TO:' || cfg.crlf || reply
     2009                  leave
     2010               end
     2011            reply = SendDataAndGetServerReply(socket, 'DATA')
     2012            if left(reply, 3) \= '354' then
     2013               do
     2014                  say 'Unexpected response to DATA:' || cfg.crlf || reply
     2015                  leave
     2016               end
     2017            data = 'Date:' left(date('W'),3) || ', ' || date('N') || ' ' || time('N') || ' ' || cfg.SMTP.currentSMTP.UTCOffset || cfg.crlf
     2018            /* JBS: Message Id? */
     2019            data = data || 'To:' email.to_list || cfg.crlf
     2020            data = data || 'From:' '"John B. Small" <jsmall@toast.net>' || cfg.crlf
     2021            /* JBS Reply-to same as From? */
     2022            data = data || 'Reply-To:' '"John Small" <jsmall@toast.net>' || cfg.crlf
     2023            data = data || 'Subject:' email.subject || cfg.crlf
     2024/*
     2025            data = data || 'MIME-Version: 1.0' || cfg.crlf
     2026*/
     2027            data = data || 'X-Mailer:' cfg.user_agent || cfg.crlf
     2028            data = data || 'X-Mailer-Platform: OS/2; architecture=x86; version=20.45' || cfg.crlf
     2029            data = data || cfg.crlf /* End of Header */
     2030            do while lines(email.body_file) > 0
     2031               line = linein(email.body_file)
     2032               data = data || line || cfg.crlf
     2033            end
     2034            call stream email.body_file, 'c', 'close'
     2035            call SysFileDelete email.body_file
     2036
     2037            data = data || cfg.SMTP.signature_preface || cfg.crlf   /* Start of signature */
     2038            do i = 1 to cfg.SMTP.currentSMTP.signature.0
     2039               data = data || cfg.SMTP.currentSMTP.signature.i || cfg.crlf
     2040            end
     2041            data = data || cfg.closing                             /* End of Message */
     2042            say
     2043            call charout , 'OK to send email? (Y/n): '
     2044            reply = translate(SysGetKey())
     2045            say
     2046            if reply \= 'N' then
     2047               do
     2048                  reply = SendDataAndGetServerReply(socket, data)
     2049                  if left(reply, 3) \= '250' then
     2050                     do
     2051                        say 'Unexpected response to message send:' || cfg.crlf || reply
     2052                        leave
     2053                     end
     2054               end
     2055            reply = SendDataAndGetServerReply(socket, 'QUIT')
     2056            if left(reply, 3) \= '221' then
     2057               do
     2058                  say 'Unexpected response to QUIT:' || cfg.crlf || reply
     2059               end
     2060         end
     2061      leave
     2062   end
     2063   call SockClose(socket)
     2064return
     2065
     2066StrippedEmailAddress: procedure
     2067   parse arg email_address
     2068   email_address = strip(email_address)
     2069   if left(email_address, 1) = '"' then
     2070      parse var email_address '"' . '"' email_address
     2071return strip(strip(strip(email_address), 'L', '<'), 'T', '>')
     2072
     2073GetServerReply: procedure expose (globals)
     2074   /* JBS: 1-time receive with large buffer or as-many-as-needed receives? */
     2075   max_recv_buffersize = 1024
     2076   parse arg socket
     2077   rc = SockRecv(socket, 'server_reply', max_recv_buffersize)
     2078   select
     2079      when rc < 0 then
     2080         return 'ERROR on receive:' rc
     2081      when rc = 0 then
     2082         return 'ERROR on receive: Connection closed prematurely.'
     2083      when rc = max_recv_buffersize then
     2084         return 'ERROR on receive: Buffer size too small?'
     2085      when pos(cfg.crlf, server_reply) = 0 then
     2086         return 'ERROR No CRLF found. Buffer too small?' || cfg.crlf || 'Reply:' server_reply
     2087      otherwise
     2088         return server_reply
     2089   end
     2090
     2091
     2092/**********************************************************************/
     2093EncodeB64: procedure expose (globals) /* encodes a text string */
     2094/**********************************************************************/
     2095
     2096   parse arg Text  /* get the argument */
     2097
     2098   B64Chars = xrange('A','Z')||xrange('a','z')||xrange('0','9')||'+/'  /* define the base64 character set */
     2099   B64Str = ''  /* start with nothing */
     2100
     2101   do while (length(Text) > 3)  /* go on while the length is sufficient */
     2102
     2103      parse var Text NextBlock 4 Text  /* get the next block of 3 characters */
     2104      NextBits = x2b(c2x(NextBlock))  /* convert it to 24 bits */
     2105
     2106      do 4  /* do 4 times */
     2107         parse var NextBits NextSext 7 NextBits  /* get the next sextet */
     2108         B64Str = B64Str||substr(B64Chars,x2d(b2x(NextSext))+1,1)  /* convert to decimal, get the corresponding B64 character, and add */
     2109      end
     2110
     2111   end
     2112
     2113   TextLeft = length(Text)  /* the number of 8-bit characters left (1, 2, or 3) */
     2114
     2115   if (TextLeft > 0) then  /* if we have anything left */
     2116      do
     2117
     2118         NextBits = x2b(c2x(Text))||copies('00',(3-TextLeft))  /* convert to bits and add zeroes */
     2119
     2120         do (TextLeft + 1)  /* do so many times */
     2121            parse var NextBits NextSext 7 NextBits  /* get the next sextet */
     2122            B64Str = B64Str||substr(B64Chars,x2d(b2x(NextSext))+1,1)  /* convert to decimal, get the corresponding B64 character, and add */
     2123         end
     2124
     2125         B64Str = B64Str||copies('=',3 - TextLeft)  /* add this */
     2126
     2127      end
     2128
     2129return B64Str  /* end of Encode64 */
     2130
     2131ConnectToMailServer: procedure expose (globals)
     2132   myIPaddr = SockGetHostid()
     2133   rc = SockGetHostByAddr(myIPaddr, 'hoststem.')
     2134   if rc = 0 then
     2135      do
     2136         say 'Error: SockGetHostByAddr'
     2137         return (-1000)
     2138      end
     2139   cfg.myName = hoststem.name
     2140   rc = SockGetHostByName(cfg.SMTP.currentSMTP.host, 'hoststem.')
     2141   if rc = 0 then
     2142      do
     2143         say 'Error: SockGetHostByAddr'
     2144         return (-1001)
     2145      end
     2146   serverIPaddr = hoststem.addr
     2147
     2148   socket = SockSocket('AF_INET', 'SOCK_STREAM', 'IPPROTO_TCP')
     2149   if socket < 0 then
     2150      exit_rc = -1
     2151   else
     2152      do
     2153         inetaddr.family = 'AF_INET'
     2154         inetaddr.addr   = serverIPaddr
     2155         inetaddr.port   = 25
     2156         exit_rc         = SockConnect(socket, 'inetaddr.')
     2157      end
     2158   if exit_rc < 0 then
     2159      return exit_rc
     2160   else
     2161      return socket
     2162
     2163SendDataAndGetServerReply: procedure expose (globals)
     2164   parse arg socket, data
     2165   p = pos(cfg.crlf, data)
     2166   if p > 1 then
     2167      say 'Sending:' left(data, min(p - 1, 60)) || '...'
     2168   else if length(data) >  60 then
     2169      say 'Sending:' left(data, 60) || '...'
     2170   else
     2171      say 'Sending:' data
     2172   rc = SockSend(socket, data || cfg.crlf)
     2173   if rc <= 0 then
     2174      do
     2175         call SockPSock_errno
     2176         return 'ERROR on send:' rc
     2177      end
     2178   else
     2179      return GetServerReply(socket)
     2180
Note: See TracChangeset for help on using the changeset viewer.