Changeset 1824


Ignore:
Timestamp:
Jun 28, 2015, 6:53:31 PM (10 years ago)
Author:
John Small
Message:

JBS Ticket #510:

  • Improved email and nntp code
    • Improved error handling
    • Added support for "PLAIN" email authentication
    • Improved recognition for various email authentications
    • Added a descriptor to the start of the email screens which identifies the purpose of the email
  • Support for all-at-once or one-at-a-time uploads
  • Several minor improvements to user interface
  • Corrected some typos and improved some wording
File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/ReleaseTool.cmd

    r1815 r1824  
    7373 *    28 Feb 14 JBS Ticket 510: Improved handling cleaenup of temporary files
    7474 *    30 Aug 14 GKY Add "pub" to front of Hobbes path to prevent deletion of upload
     75 *    27 Jun 15 JBS Ticket #510:
     76 *                - Improved email and nntp code
     77 *                   - Improved error handling
     78 *                   - Added support for "PLAIN" email authentication
     79 *                   - Improved recognition for various email authentications
     80 *                   - Added a descriptor to the start of the email screens which identifies the purpose of the email
     81 *                - Support for all-at-once or one-at-a-time uploads
     82 *                - Several minor improvements to user interface
     83 *                - Corrected some typos and improved some wording
    7584 *
    7685 * To Do
    77  *    -  Better error handling for emails/NNTP
     86 *    -  Research and implement ways to pass "Full name" <user@domain.net> addresses to external programs
    7887 *    -  Support multiple description lines for SMTP/NNTP (to improve readabliity on verification screens)
    7988 *    -  Make sure ##macro## key_values are filled before use?
    … …  
    94103signal on Notready name Error
    95104signal on Syntax name Error
    96 signal on Novalue name Error
    97 /* JBS: for debugging */
    98105signal on Novalue
    99106
    … …  
    406413                     end
    407414                  else
    408                      say 'Upload(s) failed. Email to Netlabs cancelled.'
     415                     say 'Upload(s) failed (or aborted). Email to Netlabs canceled.'
    409416                  prev_user_choice = user_choice
    410417              end
    … …  
    412419               do /* Announce the release. */
    413420                  call Email user_choice
     421/*
     422                  '@pause'
     423*/
    414424                  call AnnounceToNewsgroups
    415425                  prev_user_choice = user_choice
    … …  
    501511      call SysCls
    502512      say
    503       say 'Email: Verify/edit content'
    504       say
     513      say 'Email:' page_title cfg.crlf
     514      say 'Verify/edit content' cfg.crlf
    505515      say 'Subject  :' email.subject
    506516      say 'Text     :' _text
    … …  
    548558            call SysCls
    549559            say
    550             say 'Email: Verify/edit server-specific data for' cfg.SMTP.currentSMTP.description
    551             say
     560            say 'Email:' page_title cfg.crlf
     561            say 'Verify/edit server-specific data for' cfg.SMTP.currentSMTP.host cfg.crlf
    552562            say 'To       :' email.to_list
    553563            say 'UserID   :' cfg.SMTP.currentSMTP.userid
    … …  
    590600         end
    591601         if option = 'C' then
    592             if cfg.SMTP.currentSMTP.command = '' then /* Use internal SMTP code */
    593                rcx = SendEmail()
    594             else                                      /* Use external command */
    595                do
    596                   say 'Using external command(s) to send email...'
    597                   _command = cfg.SMTP.currentSMTP.Command
    598                   do while pos('##TO##', _command) > 0
    599                      parse var _command part1 '##TO##' part2
    600                      _command = part1 || email.to_list || part2
    601                   end
    602                   do while pos('##FROM##', _command) > 0
    603                      parse var _command part1 '##FROM##' part2
    604                      _command = part1 || cfg.SMTP.currentSMTP.from || part2
    605                   end
    606                   do while pos('##SUBJECT##', _command) > 0
    607                      parse var _command part1 '##SUBJECT##' part2
    608                      _command = part1 || email.subject || part2
    609                   end
    610                   do while pos('##MESSAGE_BODY_FILE##', _command) > 0
    611                      parse var _command part1 '##MESSAGE_BODY_FILE##' part2
    612                      _command = part1 || stream(email.body_file, 'c', 'query exists') || part2
    613                   end
    614                   do while pos('##HOST##', _command) > 0
    615                      parse var _command part1 '##HOST##' part2
    616                      _command = part1 || cfg.SMTP.currentSMTP.host || part2
    617                   end
    618                   do while pos('##PORT##', _command) > 0
    619                      parse var _command part1 '##PORT##' part2
    620                      _command = part1 || cfg.SMTP.currentSMTP.port || part2
    621                   end
    622                   do while pos('##USERID##', _command) > 0
    623                      parse var _command part1 '##USERID##' part2
    624                      _command = part1 || cfg.SMTP.currentSMTP.userid || part2
    625                   end
    626                   do while pos('##PASSWORD##', _command) > 0
    627                      parse var _command part1 '##PASSWORD##' part2
    628                      _command = part1 || cfg.SMTP.currentSMTP.password || part2
    629                   end
    630                   do while pos('##UTCOFFSET##', _command) > 0
    631                      parse var _command part1 '##UTCOFFSET##' part2
    632                      _command = part1 || cfg.SMTP.currentSMTP.UTCOffset || part2
    633                   end
    634                   retval = ExecCmd(_command)
    635                   '@pause'
    636                end
     602            do
     603               if cfg.SMTP.currentSMTP.command = '' then /* Use internal SMTP code */
     604                  rcx = SendEmail()
     605               else                                      /* Use external command */
     606                  do
     607                     say 'Using external command(s) to send email...'
     608                     _command = cfg.SMTP.currentSMTP.Command
     609                     do while pos('##TO##', _command) > 0
     610                        parse var _command part1 '##TO##' part2
     611                        _command = part1 || email.to_list || part2
     612                     end
     613                     do while pos('##FROM##', _command) > 0
     614                        parse var _command part1 '##FROM##' part2
     615                        _command = part1 || cfg.SMTP.currentSMTP.from || part2
     616                     end
     617                     do while pos('##SUBJECT##', _command) > 0
     618                        parse var _command part1 '##SUBJECT##' part2
     619                        _command = part1 || email.subject || part2
     620                     end
     621                     do while pos('##MESSAGE_BODY_FILE##', _command) > 0
     622                        parse var _command part1 '##MESSAGE_BODY_FILE##' part2
     623                        _command = part1 || stream(email.body_file, 'c', 'query exists') || part2
     624                     end
     625                     do while pos('##HOST##', _command) > 0
     626                        parse var _command part1 '##HOST##' part2
     627                        _command = part1 || cfg.SMTP.currentSMTP.host || part2
     628                     end
     629                     do while pos('##PORT##', _command) > 0
     630                        parse var _command part1 '##PORT##' part2
     631                        _command = part1 || cfg.SMTP.currentSMTP.port || part2
     632                     end
     633                     do while pos('##USERID##', _command) > 0
     634                        parse var _command part1 '##USERID##' part2
     635                        _command = part1 || cfg.SMTP.currentSMTP.userid || part2
     636                     end
     637                     do while pos('##PASSWORD##', _command) > 0
     638                        parse var _command part1 '##PASSWORD##' part2
     639                        _command = part1 || cfg.SMTP.currentSMTP.password || part2
     640                     end
     641                     do while pos('##UTCOFFSET##', _command) > 0
     642                        parse var _command part1 '##UTCOFFSET##' part2
     643                        _command = part1 || cfg.SMTP.currentSMTP.UTCOffset || part2
     644                     end
     645                     rcx = ExecCmd(_command)
     646                  end
     647            end
    637648         else
    638649            rcx = -1
    … …  
    650661   call lineout tempfile, 'NETLABS'
    651662   call lineout tempfile, 'Initially uploaded to:'
    652    call lineout tempfile, '  <ftp://ftp.netlabs.org/incoming/fm2' || release_file || '>'
     663   call lineout tempfile, '  <ftp://ftp.netlabs.org/incoming/fm2/' || release_file || '>'
    653664   call lineout tempfile, 'Eventual location:'
    654665   call lineout tempfile, '  <ftp://ftp.netlabs.org/pub/fm2/' || release_file || '>'
    … …  
    687698   retval = -2    /* Assume error of some sort */
    688699   say "Using ReleaseTool's internal SMTP code to send email..."
    689    say 'Connecting to mail server...'
    690700   do 1
    691701      socket = ConnectToMailServer(cfg.SMTP.currentSMTP.host, cfg.SMTP.currentSMTP.port)
    … …  
    710720            leave
    711721         end
     722      parse value translate(translate(reply), ' ', '-') with . '250 AUTH ' auth_mechanisms (cfg.crlf) .
    712723      select
    713          when pos('AUTH LOGIN', reply) > 0 then
     724         when auth_mechanisms = '' then
     725            /* JBS: OK to assume no authorization? */
     726            say 'AUTH not returned by server. Assuming no authentication required...'
     727         when wordpos('LOGIN', auth_mechanisms) > 0 then
    714728            do
    715729               /* AUTH LOGIN login here */
    … …  
    733747                  end
    734748            end
    735          when pos('AUTH PLAIN', reply) > 0 then
    736             do
    737                /* JBS: Implment AUTH PLAIN here? */
     749         when wordpos('PLAIN', auth_mechanisms) > 0 then
     750            do
    738751               /*
     752                * AUTH LOGIN login here
     753                *
    739754                * "The mechanism consists of a single message from the client to the server.
    740755                * The client sends the authorization identity (identity to login as),
    … …  
    744759                * authorization identity empty to indicate that it is the same as the authentication identity."
    745760                */
    746                say 'AUTH PLAIN not yet implemented!'
    747                leave
    748             end
    749          when pos('AUTH CRAM-MD5', reply) > 0 then
    750             do
    751                /* JBS: Implment AUTH CRAM-MD5 here? */
     761               msg = cfg.SMTP.currentSMTP.userid || '00'x || cfg.SMTP.currentSMTP.userid || '00'x || cfg.SMTP.currentSMTP.password
     762               reply = SendDataAndGetServerReply(socket, 'AUTH PLAIN' EncodeB64(msg))
     763               if left(reply, 3) \= '235' then
     764                  do
     765                     say 'Authorization failed (or unexpected response to authentication).' || cfg.crlf || reply
     766                     leave
     767                  end
     768            end
     769         when wordpos('CRAM-MD5', auth_mechanisms) > 0 then
     770            do
     771/*
     772               The CRAM-MD5 protocol involves a single challenge and response cycle, and is initiated by the server:
     773
     774                   Challenge: The server sends a base64-encoded string to the client. Before encoding, it could be any random string, but the standard that currently defines CRAM-MD5 says that it is in the format of a Message-ID email header value (including angle brackets) and includes an arbitrary string of random digits, a timestamp, and the server's fully qualified domain name.
     775                   Response: The client responds with a string created as follows.
     776                       The challenge is base64-decoded.
     777                       The decoded challenge is hashed using HMAC-MD5, with a shared secret (typically, the user's password, or a hash thereof) as the secret key.
     778                       The hashed challenge is converted to a string of lowercase hex digits.
     779                       The username and a space character are prepended to the hex digits.
     780                       The concatenation is then base64-encoded and sent to the server
     781                   Comparison: The server uses the same method to compute the expected response. If the given response and the expected response match, then authentication was successful.
     782*/
     783
     784               /* JBS: Implement AUTH CRAM-MD5 here? */
    752785               /* JBS: If implemented, move to top to become "preferred" authentication? */
    753786               say 'AUTH CRAM-MD5 not yet implemented!'
    754787               leave
    755788            end
    756          otherwise /* No or unknown authorization required */
    757             /* JBS: OK to assume no authorization? */
    758             say 'Assuming no authentication required...'
     789         when wordpos('DIGEST-MD5', auth_mechanisms) > 0 then
     790            do
     791               /* JBS: Implement AUTH DIGEST-MD5 here? */
     792               /* JBS: If implemented, move to top to become "preferred" authentication? */
     793               say 'AUTH DIGEST-MD5 not yet implemented!'
     794               leave
     795            end
     796         otherwise
     797            do
     798               /* Unknown authorization required */
     799               say 'Unknown, unimplemented authorization mechanisms:' auth_mechanisms
     800               leave
     801            end
    759802      end
    760803      say 'Preparing data to send...'
    … …  
    817860               do
    818861                  say 'Unexpected response to message send:' || cfg.crlf || reply
    819                   leave
     862                  retval = -1
    820863               end
    821864            else
    … …  
    825868               end
    826869         end
    827       say 'Sending "QUIT" to server...'
    828870      reply = SendDataAndGetServerReply(socket, 'QUIT')
    829871      if left(reply, 3) \= '221' then
    … …  
    896938      email_server_port = 25
    897939
     940   say 'Retrieving this host''s name...'
    898941   myIPaddr = SockGetHostid()
    899942   rc = SockGetHostByAddr(myIPaddr, 'hoststem.')
    … …  
    901944      do
    902945         say 'Error: SockGetHostByAddr'
     946         say 'Error code:' SockSock_Errno()
     947         call SockPSock_Errno 'Error text'
     948         say 'Trying to use HOSTNAME command...'
     949         '@hostname | rxqueue'
     950         hn = ''
     951         do while queued() > 0
     952            parse pull cfg.myHostName
     953         end
     954         say 'Hostname output:' cfg.myHostName
     955/*
    903956         return (-1000)
    904       end
    905    cfg.myHostName = hoststem.name
     957*/
     958      end
     959   else
     960      cfg.myHostName = hoststem.name
     961   say 'Connecting to mail server...'
    906962   rc = SockGetHostByName(email_server_name, 'hoststem.')
    907963   if rc = 0 then
    908964      do
    909          say 'Error: SockGetHostByAddr'
     965         say 'Error: SockGetHostByName'
     966         say 'Error code:' SockSock_Errno()
     967         call SockPSock_Errno('Error text')
    910968         return (-1001)
    911969      end
    … …  
    11821240CfgInit: procedure expose (globals)
    11831241   cfg.            = ''
    1184 /*
    1185    trace '?i'
    1186 */
    11871242   cfg.file        = 'ReleaseTool.cfg'
    11881243   cfg.file_exists = (stream(cfg.file, 'c', 'query exists') \= '')
    … …  
    14751530               OKtoListEmail = 'yes'
    14761531      say;say
    1477       say 'Please enter the version of the zip file to be replaced:'
    1478       replaced_ver_zip = 'fm2-' || translate(linein(), '-', '.') || '.zip'
     1532      say 'Please enter the version of the zip file to be replaced (default:' ver.wpi || '):'
     1533      entry = strip(linein())
     1534      if entry = '' then
     1535         replaced_ver_zip = 'fm2-' || ver.wpi || '.zip'
     1536      else
     1537         replaced_ver_zip = 'fm2-' || translate(linein(), '-', '.') || '.zip'
    14791538      say;say
    14801539      say 'Data entered:'
    … …  
    14841543      say '  Zip to be replaced :' replaced_ver_zip
    14851544      say;say
    1486       call charout , 'OK to proceed with file write? (Y/n) '
     1545      call charout , 'OK to write Hobbes'' text file? (Y/n) '
    14871546      entry = translate(SysGetKey())
    14881547      say
    … …  
    18211880UploadRelease: procedure expose (globals)
    18221881  rcx = 0
     1882  upload_count = 0
    18231883  select
    18241884    when (available.RXFTP = 0 | \cfg.file_exists) then
    … …  
    18411901    otherwise
    18421902      do
    1843          retval = 0
    1844          do u = 1 to cfg.FTP.0
    1845             say 'Uploading to' cfg.FTP.u.description || '...'
    1846             if cfg.FTP.u.command \= '' then
     1903         call SysCls
     1904         do until (choice = 'A' | choice = 'Q')
     1905            say
     1906            say 'Choose which uploads to perform:'
     1907            say
     1908            say 'A) Perform all uploads'
     1909            do u = 1 to cfg.FTP.0
     1910               say u || ') Upload to' cfg.ftp.u.description
     1911            end
     1912            say 'Q) Quit, perform no (more) uploads'
     1913            say
     1914            call charout , 'Enter the letter or number of your choice: '
     1915            choice = translate(SysGetKey())
     1916            say
     1917            select
     1918               when choice = 'A' then
     1919                  do
     1920                     startat = 1
     1921                     endat = cfg.FTP.0
     1922                  end
     1923               when choice = 'Q' then
     1924                  do
     1925                     startat = 10
     1926                     endat = 1
     1927                  end
     1928               when datatype(choice) = 'NUM' then
     1929                  if choice > cfg.FTP.0 then
     1930                     iterate
     1931                  else
     1932                     do
     1933                        startat = choice
     1934                        endat = choice
     1935                     end
     1936               otherwise
     1937                  iterate
     1938            end
     1939            say
     1940            do u = startat to endat
     1941               rcx = 0
     1942               say 'Uploading to' cfg.FTP.u.description || '...'
     1943               if cfg.FTP.u.command \= '' then
     1944                  do
     1945                     say 'Using external command(s) to upload...'
     1946                     _command = cfg.FTP.u.command
     1947                     do while pos('##HOST##', _command) > 0
     1948                        parse var _command part1 '##HOST##' part2
     1949                        _command = part1 || cfg.FTP.u.host || part2
     1950                     end
     1951                     do while pos('##PORT##', _command) > 0
     1952                        parse var _command part1 '##PORT##' part2
     1953                        _command = part1 || cfg.FTP.u.port || part2
     1954                     end
     1955                     do while pos('##USERID##', _command) > 0
     1956                        parse var _command part1 '##USERID##' part2
     1957                        _command = part1 || cfg.FTP.u.userid || part2
     1958                     end
     1959                     do while pos('##PASSWORD##', _command) > 0
     1960                        parse var _command part1 '##PASSWORD##' part2
     1961                        _command = part1 || cfg.FTP.u.password || part2
     1962                     end
     1963                     do while pos('[Release-zip]', _command) > 0
     1964                        parse var _command part1 '[Release-zip]' part2
     1965                        _command = part1 || 'warpin\fm2-' || ver.wpi || '.zip' || part2
     1966                     end
     1967                     do while pos('[Hobbes-text]', _command) > 0
     1968                        parse var _command part1 '[Hobbes-text]' part2
     1969                        _command = part1 || 'warpin\fm2-' || ver.wpi || '.txt' || part2
     1970                     end
     1971                     rcx = ExecCmd(_command)
     1972                     if rcx = 0 then
     1973                        upload_count = upload_count + 1
     1974                     say
     1975                  end
     1976               else
     1977                  do
     1978                     say '   Setting up logon data...'
     1979                     if cfg.FTP.u.password = '[Hobbes-email]' then
     1980                        if left(Hobbes.uploader_email_address, 3) = 'N/A' then
     1981                           cfg.FTP.u.password = ''
     1982                        else
     1983                           cfg.FTP.u.password = Hobbes.uploader_email_address
     1984                     if (cfg.FTP.u.userid = '' | cfg.FTP.u.password = '') then
     1985                        do
     1986                           say
     1987                           say '      The userid and/or password were not found in ReleaseTool.cfg.'
     1988                           say '      You will now be prompted for the missing data.'
     1989                           say
     1990                           if cfg.FTP.u.userid = '' then
     1991                              do
     1992                                 call charout , '      Please enter the userid for' cfg.FTP.u.descriptive_hostname ||': '
     1993                                 cfg.FTP.u.userid = strip(linein())
     1994                                 say
     1995                              end
     1996                           say
     1997                           if cfg.FTP.u.password = '' then
     1998                              do
     1999                                 call charout , '      Please enter the password for' cfg.FTP.u.descriptive_hostname ||': '
     2000                                 cfg.FTP.u.password  = strip(linein())
     2001                                 say
     2002                              end
     2003                           say '      In order to avoid being prompted in the future, edit the'
     2004                           say '      ReleaseTool.cfg file to include this data.'
     2005                           say
     2006                        end
     2007                     rcx = FtpSetUser( cfg.FTP.u.host, StripNotNeeded(cfg.FTP.u.userid), StripNotNeeded(cfg.FTP.u.password), '')
     2008                     if rcx \= 1 then
     2009                        say '      Unable to set user data. Unable to continue.'
     2010                     else
     2011                        do
     2012                           do d = 1 to cfg.FTP.u.directory.0
     2013                              if cfg.FTP.u.directory.d \= '' then
     2014                                 do
     2015                                    say '   Changing directory to:' cfg.FTP.u.directory.d
     2016                                    rcx = FtpChDir(cfg.FTP.u.directory.d)
     2017                                    if rcx \= 0 then
     2018                                       do
     2019                                          say '   Unable to change directory. FTP Error:' FTPERRNO
     2020                                          iterate
     2021                                       end
     2022                                 end
     2023                              do f = 1 to cfg.FTP.u.directory.d.file.0
     2024                                 select
     2025                                    when cfg.FTP.u.directory.d.file.f = '[Release-zip]' then
     2026                                       uploadfile = 'warpin\fm2-' || ver.wpi || '.zip'
     2027                                    when cfg.FTP.u.directory.d.file.f = '[Hobbes-text]' then
     2028                                       uploadfile = 'warpin\fm2-' || ver.wpi || '.txt'
     2029                                    otherwise
     2030                                       uploadfile = cfg.FTP.u.directory.d.file.f
     2031                                 end
     2032                                 say '   Uploading:' uploadfile
     2033                                 rcx = FtpPut(uploadfile, filespec('n', uploadfile), "Binary")
     2034                                 if rcx \= 0 then
     2035                                    do
     2036                                       say '   Unable to upload. FTP Error:' FTPERRNO
     2037                                       leave
     2038                                    end
     2039                                 else
     2040                                    upload_count = upload_count + 1
     2041                              end
     2042                           end
     2043                           say '   Logging off' cfg.FTP.u.descriptive_hostname || '...'
     2044                           call FtpLogoff
     2045                           say
     2046                        end
     2047                  end
     2048/*
     2049               if rcx \= 0 then
     2050                  leave
     2051*/
     2052            end
     2053         end
     2054      end
     2055   end
     2056   '@pause'
     2057   if upload_count = 0 then
     2058      return -100
     2059   else
     2060      return rcx
     2061
     2062AnnounceToNewsgroups: procedure expose (globals)
     2063   if \cfg.file_exists then
     2064     do
     2065       say 'Unable to post to newsgroups without the configuration file:' cfg.file
     2066       say
     2067       return
     2068     end
     2069   nntp_body_file = SysTempFilename('NNTPBody.???')
     2070   call SetDefaultAnnouncementText nntp_body_file
     2071   cfg.NNTP.subject = 'FM/2' ver.full 'has been released.'
     2072   _text = '<Standard>'
     2073   do until ((option = 'C') | (option = 'Q'))
     2074      call SysCls
     2075      say
     2076      say 'News: Verify/edit content'
     2077      say
     2078      say 'Subject  :' cfg.NNTP.subject
     2079      say 'Text     :' _text
     2080      say
     2081      say 'Type "C" to confirm the above and proceed.'
     2082      say '     "Q" to abort.'
     2083      say '     "S" to edit the subject.'
     2084      say '     "T" to edit the message text (in an editor).'
     2085      say
     2086      call charout, '==> '
     2087      option = translate(SysGetKey())
     2088      say
     2089      say
     2090      select
     2091         when ((option = 'C') | (option = 'Q')) then
     2092            nop
     2093         when option = 'S' then
     2094            do
     2095               say 'Enter the Subject (followed by the ENTER key):'
     2096               cfg.NNTP.subject = linein()
     2097            end
     2098         when option = 'T' then
     2099            do
     2100               b4_timestamp = SysGetFileDateTime(nntp_body_file)
     2101               say 'The current body of the newsgroup message will now be loaded into an editor.'
     2102               say 'Make desired changes, if any, and save the file.'
     2103               say
     2104               call charout, 'Press any key when ready to load the message body into an editor: '
     2105               call SysGetKey
     2106               say
     2107               call ExecCmd cmd.editor nntp_body_file
     2108               if b4_timestamp \= SysGetFileDateTime(nntp_body_file) then
     2109                  _text = '<Modified>'
     2110            end
     2111         otherwise
     2112            nop
     2113      end
     2114   end
     2115   if option = 'Q' then
     2116      rcx = -1      /* User aborted operation */
     2117   else
     2118      do s = 1 to cfg.NNTP.0
     2119         call SysCls
     2120         say
     2121         do until ((option = 'C') | (option = 'Q'))
     2122/*
     2123            call SysCls
     2124*/
     2125            say cfg.crlf cfg.crlf cfg.crlf
     2126            say 'News: Announce release to newsgroups' cfg.crlf
     2127            say 'Verify/edit server-specific data for' cfg.NNTP.s.host
     2128            say
     2129            say 'Host     :' cfg.NNTP.s.host
     2130            say 'To       :' cfg.NNTP.s.to
     2131            say 'From     :' cfg.NNTP.s.from
     2132            say 'UserID   :' cfg.NNTP.s.userid
     2133            say 'Password :' cfg.NNTP.s.password
     2134            say
     2135            say 'Type "C" to confirm the above and send.'
     2136            say '     "Q" to abort sending this email.'
     2137            say '     "H" to change the name of the host.'
     2138            say '     "T" to change the list of newsgroups.'
     2139            say '     "F" to change the From address.'
     2140            say '     "U" to change the Userid.'
     2141            say '     "P" to change the Password.'
     2142            say
     2143            call charout, '==> '
     2144            option = translate(SysGetKey())
     2145            say
     2146            say
     2147            say
     2148            select
     2149               when option = 'H' then
     2150                  do
     2151                     say 'Enter the newsgroup host to use (followed by the ENTER key).'
     2152                     cfg.NNTP.s.host = linein()
     2153                  end
     2154               when option = 'T' then
     2155                  do
     2156                     say 'Enter a comma=separated list of newagroup(s) (followed by the ENTER key).'
     2157                     cfg.NNTP.s.to = linein()
     2158                  end
     2159               when option = 'F' then
     2160                  do
     2161 /*
     2162                     say 'F.Y.I. The Hobbes email address is:' Hobbes.uploader_email_address
     2163                     say
     2164                  if reply \= '' then
     2165                     cfg.NNTP.s.from = reply
     2166                  else
     2167                     cfg.NNTP.s.from = Hobbes.uploader_email_address
     2168 */
     2169                     say 'Enter the From email address. (followed by the ENTER key).'
     2170                     say '(You may want to disguise the address to avoid spam.)'
     2171                     cfg.NNTP.s.from = linein()
     2172                  end
     2173               when option = 'U' then
     2174                  do
     2175                     say 'Enter the UserID (followed by the ENTER key):'
     2176                     cfg.NNTP.s.userid = linein()
     2177                  end
     2178               when option = 'P' then
     2179                  do
     2180                     say 'Enter the Password (followed by the ENTER key):'
     2181                     cfg.NNTP.s.password = linein()
     2182                  end
     2183               otherwise
     2184                  nop
     2185            end
     2186         end
     2187         if option = 'C' then
     2188           do
     2189            if cfg.NNTP.s.command \= '' then
    18472190               do
    1848                   say 'Using external command(s) to upload...'
    1849                   _command = cfg.FTP.u.command
     2191                  say 'Using external command(s) to post to newsgroup(s)...'
     2192                  _command = cfg.NNTP.s.command
    18502193                  do while pos('##HOST##', _command) > 0
    18512194                     parse var _command part1 '##HOST##' part2
    1852                      _command = part1 || cfg.FTP.u.host || part2
     2195                     _command = part1 || cfg.NNTP.s.host || part2
    18532196                  end
    18542197                  do while pos('##PORT##', _command) > 0
    18552198                     parse var _command part1 '##PORT##' part2
    1856                      _command = part1 || cfg.FTP.u.port || part2
     2199                     _command = part1 || cfg.NNTP.s.port || part2
    18572200                  end
    18582201                  do while pos('##USERID##', _command) > 0
    18592202                     parse var _command part1 '##USERID##' part2
    1860                      _command = part1 || cfg.FTP.u.userid || part2
     2203                     _command = part1 || cfg.NNTP.s.userid || part2
    18612204                  end
    18622205                  do while pos('##PASSWORD##', _command) > 0
    18632206                     parse var _command part1 '##PASSWORD##' part2
    1864                      _command = part1 || cfg.FTP.u.password || part2
    1865                   end
    1866                   do while pos('[Release-zip]', _command) > 0
    1867                      parse var _command part1 '[Release-zip]' part2
    1868                      _command = part1 || 'warpin\fm2-' || ver.wpi || '.zip' || part2
    1869                   end
    1870                   do while pos('[Hobbes-text]', _command) > 0
    1871                      parse var _command part1 '[Hobbes-text]' part2
    1872                      _command = part1 || 'warpin\fm2-' || ver.wpi || '.txt' || part2
     2207                     _command = part1 || cfg.NNTP.s.password || part2
     2208                  end
     2209                  do while pos('##MESSAGE_BODY_FILE##', _command) > 0
     2210                     parse var _command part1 '##MESSAGE_BODY_FILE##' part2
     2211                     _command = part1 || stream(body_file, 'c', 'query exists') || part2
     2212                  end
     2213                  do while pos('##FROM##', _command) > 0
     2214                     parse var _command part1 '##FROM##' part2
     2215                     _command = part1 || cfg.NNTP.s.from || part2
     2216                  end
     2217                  do while pos('##TO##', _command) > 0
     2218                     parse var _command part1 '##TO##' part2
     2219                     _command = part1 || cfg.NNTP.s.to || part2
    18732220                  end
    18742221                  rcx = ExecCmd(_command)
    1875                   say
    18762222               end
    18772223            else
    18782224               do
    1879                   say '   Setting up logon data...'
    1880                   if cfg.FTP.u.password = '[Hobbes-email]' then
    1881                      if left(Hobbes.uploader_email_address, 3) = 'N/A' then
    1882                         cfg.FTP.u.password = ''
    1883                      else
    1884                         cfg.FTP.u.password = Hobbes.uploader_email_address
    1885                   if (cfg.FTP.u.userid = '' | cfg.FTP.u.password = '') then
    1886                      do
    1887                         say
    1888                         say '      The userid and/or password were not found in ReleaseTool.cfg.'
    1889                         say '      You will now be prompted for the missing data.'
    1890                         say
    1891                         if cfg.FTP.u.userid = '' then
    1892                            do
    1893                               call charout , '      Please enter the userid for' cfg.FTP.u.descriptive_hostname ||': '
    1894                               cfg.FTP.u.userid = strip(linein())
    1895                               say
    1896                            end
    1897                         say
    1898                         if cfg.FTP.u.password = '' then
    1899                            do
    1900                               call charout , '      Please enter the password for' cfg.FTP.u.descriptive_hostname ||': '
    1901                               cfg.FTP.u.password  = strip(linein())
    1902                               say
    1903                            end
    1904                         say '      In order to avoid being prompted in the future, edit the'
    1905                         say '      ReleaseTool.cfg file to include this data.'
    1906                         say
    1907                      end
    1908                   rcx = FtpSetUser( cfg.FTP.u.host, StripNotNeeded(cfg.FTP.u.userid), StripNotNeeded(cfg.FTP.u.password), '')
    1909                   if rcx \= 1 then
    1910                      say '      Unable to set user data. Unable to continue.'
    1911                   else
    1912                      do
    1913                         do d = 1 to cfg.FTP.u.directory.0
    1914                            if cfg.FTP.u.directory.d \= '' then
    1915                               do
    1916                                  say '   Changing directory to:' cfg.FTP.u.directory.d
    1917                                  rcx = FtpChDir(cfg.FTP.u.directory.d)
    1918                                  if rcx \= 0 then
    1919                                     do
    1920                                        say '   Unable to change directory. FTP Error:' FTPERRNO
    1921                                        iterate
    1922                                     end
    1923                               end
    1924                            do f = 1 to cfg.FTP.u.directory.d.file.0
    1925                               select
    1926                                  when cfg.FTP.u.directory.d.file.f = '[Release-zip]' then
    1927                                     uploadfile = 'warpin\fm2-' || ver.wpi || '.zip'
    1928                                  when cfg.FTP.u.directory.d.file.f = '[Hobbes-text]' then
    1929                                     uploadfile = 'warpin\fm2-' || ver.wpi || '.txt'
    1930                                  otherwise
    1931                                     uploadfile = cfg.FTP.u.directory.d.file.f
    1932                               end
    1933                               say '   Uploading:' uploadfile
    1934                               rcx = FtpPut(uploadfile, filespec('n', uploadfile), "Binary")
    1935                               if rcx \= 0 then
    1936                                  do
    1937                                     say '   Unable to upload. FTP Error:' FTPERRNO
    1938                                     leave
    1939                                  end
    1940                            end
    1941                         end
    1942                         say '   Logging off' cfg.FTP.u.descriptive_hostname || '...'
    1943                         call FtpLogoff
    1944                         say
    1945                      end
     2225                  cfg.NNTP.message_body = ''
     2226                  do while lines(nntp_body_file) > 0
     2227                     cfg.NNTP.message_body = cfg.NNTP.message_body || linein(nntp_body_file) || cfg.crlf
     2228                  end
     2229                  call stream nntp_body_file, 'c', 'close'
     2230                  rcx = SendNNTP(s)
    19462231               end
    1947             if rcx \= 0 then
    1948                leave
    1949          end
    1950       end
    1951   end
    1952 return rcx
    1953 
    1954 AnnounceToNewsgroups: procedure expose (globals)
    1955   if \cfg.file_exists then
    1956     do
    1957       say 'Unable to post to newsgroups without the configuration file:' cfg.file
    1958       say
    1959       return
    1960     end
    1961   nntp_body_file = SysTempFilename('NNTPBody.???')
    1962   call SetDefaultAnnouncementText nntp_body_file
    1963   cfg.NNTP.subject = 'FM/2' ver.full 'has been released.'
    1964   _text = '<Standard>'
    1965   do until ((option = 'C') | (option = 'Q'))
    1966      call SysCls
    1967      say
    1968      say 'News: Verify/edit content'
    1969      say
    1970      say 'Subject  :' cfg.NNTP.subject
    1971      say 'Text     :' _text
    1972      say
    1973      say 'Type "C" to confirm the above and proceed.'
    1974      say '     "Q" to abort.'
    1975      say '     "S" to edit the subject.'
    1976      say '     "T" to edit the message text (in an editor).'
    1977      say
    1978      call charout, '==> '
    1979      option = translate(SysGetKey())
    1980      say
    1981      say
    1982      select
    1983         when ((option = 'C') | (option = 'Q')) then
    1984            nop
    1985         when option = 'S' then
    1986            do
    1987               say 'Enter the Subject (followed by the ENTER key):'
    1988               cfg.NNTP.subject = linein()
     2232             if rcx \= 0 then 'pause'
    19892233           end
    1990         when option = 'T' then
    1991            do
    1992               b4_timestamp = SysGetFileDateTime(nntp_body_file)
    1993               say 'The current body of the newsgroup message will now be loaded into an editor.'
    1994               say 'Make desired changes, if any, and save the file.'
    1995               say
    1996               call charout, 'Press any key when ready to load the message body into an editor: '
    1997               call SysGetKey
    1998               say
    1999               call ExecCmd cmd.editor nntp_body_file
    2000               if b4_timestamp \= SysGetFileDateTime(nntp_body_file) then
    2001                  _text = '<Modified>'
    2002            end
    2003         otherwise
    2004            nop
    2005      end
    2006   end
    2007   if option = 'Q' then
    2008      rcx = -1      /* User aborted operation */
    2009   else
    2010      do s = 1 to cfg.NNTP.0
    2011         call SysCls
    2012         say
    2013         do until ((option = 'C') | (option = 'Q'))
    2014            call SysCls
    2015            say
    2016            say 'News: Verify/edit server-specific data for' cfg.NNTP.s.description
    2017            say
    2018            say 'Host     :' cfg.NNTP.s.host
    2019            say 'To       :' cfg.NNTP.s.to
    2020            say 'From     :' cfg.NNTP.s.from
    2021            say 'UserID   :' cfg.NNTP.s.userid
    2022            say 'Password :' cfg.NNTP.s.password
    2023            say
    2024            say 'Type "C" to confirm the above and send.'
    2025            say '     "Q" to abort sending this email.'
    2026            say '     "H" to change the name of the host.'
    2027            say '     "T" to change the list of newsgroups.'
    2028            say '     "F" to change the From address.'
    2029            say '     "U" to change the Userid.'
    2030            say '     "P" to change the Password.'
    2031            say
    2032            call charout, '==> '
    2033            option = translate(SysGetKey())
    2034            say
    2035            say
    2036            say
    2037            select
    2038               when option = 'H' then
    2039                  do
    2040                     say 'Enter the newsgroup host to use (followed by the ENTER key).'
    2041                     cfg.NNTP.s.host = linein()
    2042                  end
    2043               when option = 'T' then
    2044                  do
    2045                     say 'Enter a comma=separated list of newagroup(s) (followed by the ENTER key).'
    2046                     cfg.NNTP.s.to = linein()
    2047                  end
    2048               when option = 'F' then
    2049                  do
    2050 /*
    2051                     say 'F.Y.I. The Hobbes email address is:' Hobbes.uploader_email_address
    2052                     say
    2053                  if reply \= '' then
    2054                     cfg.NNTP.s.from = reply
    2055                  else
    2056                     cfg.NNTP.s.from = Hobbes.uploader_email_address
    2057 */
    2058                     say 'Enter the From email address. (followed by the ENTER key).'
    2059                     say '(You may want to disguise the address to avoid spam.)'
    2060                     cfg.NNTP.s.from = linein()
    2061                  end
    2062               when option = 'U' then
    2063                  do
    2064                     say 'Enter the UserID (followed by the ENTER key):'
    2065                     cfg.NNTP.s.userid = linein()
    2066                  end
    2067               when option = 'P' then
    2068                  do
    2069                     say 'Enter the Password (followed by the ENTER key):'
    2070                     cfg.NNTP.s.password = linein()
    2071                  end
    2072               otherwise
    2073                  nop
    2074            end
    2075         end
    2076         if option = 'C' then
    2077           do
    2078            if cfg.NNTP.s.command \= '' then
    2079               do
    2080                  say 'Using external command(s) to post to newsgroup(s)...'
    2081                  _command = cfg.NNTP.s.command
    2082                  do while pos('##HOST##', _command) > 0
    2083                     parse var _command part1 '##HOST##' part2
    2084                     _command = part1 || cfg.NNTP.s.host || part2
    2085                  end
    2086                  do while pos('##PORT##', _command) > 0
    2087                     parse var _command part1 '##PORT##' part2
    2088                     _command = part1 || cfg.NNTP.s.port || part2
    2089                  end
    2090                  do while pos('##USERID##', _command) > 0
    2091                     parse var _command part1 '##USERID##' part2
    2092                     _command = part1 || cfg.NNTP.s.userid || part2
    2093                  end
    2094                  do while pos('##PASSWORD##', _command) > 0
    2095                     parse var _command part1 '##PASSWORD##' part2
    2096                     _command = part1 || cfg.NNTP.s.password || part2
    2097                  end
    2098                  do while pos('##MESSAGE_BODY_FILE##', _command) > 0
    2099                     parse var _command part1 '##MESSAGE_BODY_FILE##' part2
    2100                     _command = part1 || stream(body_file, 'c', 'query exists') || part2
    2101                  end
    2102                  do while pos('##FROM##', _command) > 0
    2103                     parse var _command part1 '##FROM##' part2
    2104                     _command = part1 || cfg.NNTP.s.from || part2
    2105                  end
    2106                  do while pos('##TO##', _command) > 0
    2107                     parse var _command part1 '##TO##' part2
    2108                     _command = part1 || cfg.NNTP.s.to || part2
    2109                  end
    2110                  rcx = ExecCmd(_command)
    2111               end
    2112            else
    2113               do
    2114                  cfg.NNTP.message_body = ''
    2115                  do while lines(body_file) > 0
    2116                     cfg.NNTP.message_body = cfg.NNTP.message_body || linein(body_file) || cfg.crlf
    2117                  end
    2118                  call stream nntp_body_file, 'c', 'close'
    2119                  rcx = SendNNTP(s)
    2120               end
    2121             if rcx \= 0 then 'pause'
    2122           end
    2123         else
    2124            rcx = -1 /* User aborted */
    2125      end
    2126   call SysFileDelete nntp_body_file
     2234         else
     2235            rcx = -1 /* User aborted */
     2236      end
     2237   call SysFileDelete nntp_body_file
    21272238return rcx
    21282239
    … …  
    21592270               parse value NNTPReceive(socket, cfg.maxNNTPrecvbufsize) with rc server_reply
    21602271               if rc \= 0 then leave
     2272/*
    21612273               say 'NNTP: Sending initial POST...'
    21622274               rc = SockSend(socket, 'POST' || cfg.crlf)
    … …  
    21692281               parse value NNTPReceive(socket, cfg.maxNNTPrecvbufsize) with rc server_reply
    21702282               if pos('480', server_reply) > 0 then /* authentication required */
     2283*/
    21712284                  do
    21722285                     say 'NNTP: Sending userid...'
    … …  
    22162329               if pos('340', server_reply) > 0 then /* OK to send */
    22172330                  do
     2331                     parse var server_reply . '<' msg_id '>' .
    22182332                     say 'NNTP: Sending message...'
    22192333                     NNTPsig = ''
    … …  
    22212335                        NNTPsig = NNTPsig || cfg.NNTP.s.signature.i || cfg.crlf
    22222336                     end
    2223                      rc = SockSend(socket, 'From:' cfg.NNTP.s.from || cfg.crlf || ,
    2224                                            'Newsgroups:' cfg.NNTP.s.to || cfg.crlf || ,
    2225                                            'Subject:' cfg.NNTP.subject || cfg.crlf || ,
    2226                                            'User-Agent:' cfg.user_agent || cfg.crlf || ,
    2227                                            'MIME-version:' cfg.NNTP.mime_version || cfg.crlf || ,
    2228                                            'Content-Type:' cfg.NNTP.content_type || cfg.crlf || ,
    2229                                            'Content-Transfer-Encoding:' cfg.NNTP.content_transfer_encoding || cfg.crlf || ,
    2230                                            cfg.crlf || ,
    2231                                            cfg.NNTP.message_body || ,
    2232                                            cfg.NNTP.signature_preface || ,
    2233                                            NNTPsig || ,
    2234                                            cfg.closing || cfg.crlf)
     2337                     senddata = 'From:' cfg.NNTP.s.from || cfg.crlf || ,
     2338                                'Message-ID: <' || msg_id || '>' || cfg.crlf || ,
     2339                                'Newsgroups:' cfg.NNTP.s.to || cfg.crlf || ,
     2340                                'Subject:' cfg.NNTP.subject || cfg.crlf || ,
     2341                                'User-Agent:' cfg.user_agent || cfg.crlf || ,
     2342                                'MIME-version:' cfg.NNTP.mime_version || cfg.crlf || ,
     2343                                'Content-Type:' cfg.NNTP.content_type || cfg.crlf || ,
     2344                                'Content-Transfer-Encoding:' cfg.NNTP.content_transfer_encoding || cfg.crlf || ,
     2345                                'Headings: Year' || cfg.crlf || ,
     2346                                cfg.crlf || ,
     2347                                cfg.NNTP.message_body || ,
     2348                                cfg.NNTP.signature_preface || ,
     2349                                NNTPsig || ,
     2350                                cfg.closing || cfg.crlf
     2351                     rc = SockSend(socket, senddata)
    22352352                     if rc < 0 then
    22362353                        do
Note: See TracChangeset for help on using the changeset viewer.