home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 35 Internet / 35-Internet.zip / wrpdis20.zip / GETMAIL.CMD < prev    next >
OS/2 REXX Batch file  |  1996-04-21  |  33KB  |  969 lines
  1. /****************************************************************************/
  2. /*  GETMAIL.CMD - an ka9q compatible OS/2 smtp daemon                       */
  3. /*  Copyright (C) 1995,1996 Alex Chapman <alex@budgetweb.com>               */
  4. /*                                                                          */
  5. /*  This program is free software; you can redistribute it and/or modify    */
  6. /*  it under the terms of the GNU General Public License as published by    */
  7. /*  the Free Software Foundation; either version 2 of the License, or       */
  8. /*  (at your option) any later version.                                     */
  9. /*                                                                          */
  10. /*  This program is distributed in the hope that it will be useful,         */
  11. /*  but WITHOUT ANY WARRANTY; without even the implied warranty of          */
  12. /*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the           */
  13. /*  GNU General Public License for more details.                            */
  14. /*                                                                          */
  15. /*  You should have received a copy of the GNU General Public License       */
  16. /*  along with this program; if not, write to the Free Software             */
  17. /*  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.               */
  18. /*                                                                          */
  19. /*  Requires rxsock.zip from IBM Employee Written Software                  */
  20. /*  <ftp://src.doc.ic.ac.uk/packages/os2/ibm/ews/rxsock.zip>                */
  21. /*                                                                          */
  22. /*  Last Modified: 21st April, 1996                                         */
  23.     Version = 1.37
  24. /****************************************************************************/
  25.  
  26. /************************************************************/
  27. /* Change History                                           */
  28. /************************************************************/
  29. /* 0.1  950117  First version                               */
  30. /* 0.11 950118  First test with post.demon.co.uk            */
  31. /* 0.12 950118  Not writing the happy faces that I used to  */
  32. /* 0.13 950129  Implemented dot transparency rfc821         */
  33. /* 0.14 950129  Additional rfc821 compliance                */
  34. /* 0.15 950130  Fixed problem with mailing lists            */
  35. /* 0.16 950131  removed gnu license for testing             */
  36. /* 0.17 950131  added logfile parameter                     */
  37. /* 0.18 950203  os/2 rexx thinks ' .' == '.'                */
  38. /* 0.19 950203  improved displayed and logged messages      */
  39. /* 0.50 950205  Final Beta Release.                         */
  40. /* 0.51 950206  fix to transparency handling                */
  41. /* 1.00 950211  First Release                               */
  42. /* 1.01 950219  Don't start if unable to determine hostname */
  43. /* 1.10 950225  option for music when mail arrives          */
  44. /* 1.11 950302  corrected 551 error message                 */
  45. /* 1.12 950304  not all procedures exposed logfile          */
  46. /* 1.13 950306  log when user terminates getmail with ctrl+c*/
  47. /* 1.14 950306  change to only do mci calls if notify = 2   */
  48. /* 1.15 950415  expose crlf since HELP was returning garbage*/
  49. /* 1.16 950416  add queue mechanism                         */
  50. /* 1.17 950416  read ka9q root directory from KA9Q env var. */
  51. /* 1.18 950417  moved accepting message                     */
  52. /* 1.19 950427  check ka9q_root directory                   */
  53. /* 1.20 950508  read settings from getmail.ini              */
  54. /* 1.21 950508  added option to deliver to a POP mailbox    */
  55. /* 1.22 950515  allow POP independent of ka9q mailbox       */
  56. /* 1.23 950521  moved call to readinifile                   */
  57. /* 1.24 950523  fixed problem with local POP delivery       */
  58. /* 1.25 950529  added spaced after tab on received line     */
  59. /* 1.26 950531  added code to collect mail for PRM          */
  60. /* 1.27 950531  added some more logging in RemoteMail       */
  61. /* 1.28 950603  fixed 'problem receiving mail' bug          */
  62. /* 1.29 950607  experimenting with better error reporting   */
  63. /* 1.30 950621  use WARPDIS as rexx queue                   */
  64. /* 1.31 950718  move queue settings into ini file           */
  65. /* 1.32 950810  deliver to prm_root if directory missing    */
  66. /* 1.33 951018  removed unimplemented commands from help    */
  67. /* 1.34 951023  handle Demon's mail forwarding option       */
  68. /* 1.35 951029  corrected SockGetHostByAddr error messages  */
  69. /* 1.36 960421  support '#' comments in alias file          */
  70. /* 1.37 960421  improve detection of multi-hop route        */
  71. /************************************************************/
  72.  
  73. arg gnu rest
  74.  
  75. port = 25                                           /* SMTP port     */
  76. crlf = d2c(13)||d2c(10)                             /* CR + LF       */
  77. buffer = ''                                         /* Empty buffer  */
  78. ControlQ = ''                                       /* Control Queue   */
  79. CurrentQ = ''                                       /* Current Queue   */
  80.  
  81. Say 'GETMAIL.CMD - OS/2 SMTP daemon (version' version')'
  82. Say 'Copyright (C) 1995 Alex Chapman'
  83. Say "GETMAIL comes with ABSOLUTELY NO WARRANTY; for details type 'GETMAIL w'."
  84. Say 'This is free software, and you are welcome to redistribute it under certain'
  85. Say "conditions; type `GETMAIL c' for details."
  86. Say
  87.  
  88. call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
  89. call SysLoadFuncs
  90.  
  91. Call ReadINIFile 'GETMAIL.INI', 'GETMAIL'
  92.  
  93. If ka9q_deliver = 'YES' Then Do
  94.   Call testmaildir mailbox
  95. End
  96.  
  97. If pop_deliver = 'YES' Then Do
  98.   Call testmaildir pop_mailbox
  99. End
  100.  
  101. If prm_deliver = 'YES' Then Do
  102.   If Right(prm_root, 1) = '\' Then Do
  103.     prm_root = Left(prm_root, Length(prm_root) - 1)
  104.   End
  105.   Call testmaildir prm_root
  106. End
  107.  
  108. alt_destination. = 0
  109. If mail_forward_option = 'YES' Then  Do
  110.   Call ReadMailDomainFile mail_forward_file
  111. End
  112.  
  113. Select
  114.   When gnu = 'C' Then Do
  115.     Call ShowConditions
  116.     Exit 0
  117.   End
  118.   When gnu = 'W' Then Do
  119.     Call ShowWarranty
  120.     Exit 0
  121.   End
  122.   When gnu = 'H' | gnu = '?' Then Do
  123.     Exit 0
  124.   End
  125.   When gnu = 'Q' Then Do
  126.     Say 'The Q parameter is now obsolete, and has been superceded by the use of'
  127.     Say 'the ini settings queue_messages and queue_name'
  128.     Exit 0
  129.   End
  130.   When gnu<>'' Then Do
  131.     Say 'Invalid parameter.  Process terminated.'
  132.     Exit 0
  133.   End
  134.   Otherwise
  135. End
  136.  
  137. If queue_messages = 'YES' Then Do
  138.   ControlQ = queue_name
  139.   CurrentQ = RXQUEUE('Create', ControlQ)
  140.   If CurrentQ<>ControlQ Then Do
  141.     Call RXQUEUE 'Delete', CurrentQ
  142.   End
  143.   CurrentQ = RXQUEUE('Set', ControlQ)
  144.   Call SendMsg '<GETMAIL> START'
  145. End
  146.  
  147. Call RxFuncAdd 'SockLoadFuncs', 'RxSock', 'SockLoadFuncs'
  148. Call SockLoadFuncs('QUIET')
  149.  
  150. If notify = 2 Then Do
  151.   Call RxFuncAdd 'mciRxInit','MCIAPI','mciRxInit'
  152.   Call mciRxInit
  153. End
  154.  
  155. signal on halt
  156.  
  157. Call Log '-------------------------------------------------------------'
  158. Call Log 'GETMAIL version' version 'started' date() time()
  159.  
  160. if Right(mailbox, 1)<>'\' Then mailbox = mailbox || '\'
  161. if Right(mqueue, 1)<>'\' Then mqueue = mqueue || '\'
  162.  
  163. alias. = ''
  164.  
  165. If ka9q_deliver = 'YES' Then Do
  166.   Call GetValidMailboxes
  167. End
  168.  
  169. If pop_deliver = 'YES' | prm_deliver = 'YES' Then Do
  170.   alias.!default = 'DELIVER'
  171. End
  172.  
  173. hosts_file = SysSearchPath('ETC','HOSTS')
  174.  
  175. destination = SockGetHostID()
  176. Say 'local host' destination
  177. Call Log 'local host (ID)' destination
  178. If destination = '255.255.255.255' Then Do
  179.   Say 'Unable to determine local hostname'
  180.   Say
  181.   Say 'The most likely problem is that you have not executed the following'
  182.   Say 'command at an os/2 command prompt:'
  183.   Say
  184.   Say 'ifconfig lo xxx.yyy.zz.ww'
  185.   Say
  186.   Say 'Open an OS/2 Window or Full Screen session and type that command, replacing'
  187.   Say 'xxx.yyy.zz.ww with your IP address, or with 127.0.0.1 (if you don''t have a'
  188.   Say 'fixed IP address).'
  189.   Say
  190.   Say 'You must also include a record of the following format in' hosts_file
  191.   Say
  192.   Say 'xxx.yyy.zz.ww hostname.demon.co.uk hostname'
  193.   Call SendMsg '<GETMAIL> FAIL IP-ADDRESS'
  194.   Exit 999
  195. End
  196.  
  197. retcode = SockGetHostByAddr(destination, 'host.!')
  198. If retcode < 0 Then Do
  199.   Say 'SockGetHostByAddr()' errno
  200.   Call SendMsg '<GETMAIL> FAIL SOCK' errno
  201.   Exit errno
  202. End
  203.  
  204. ip_address = destination
  205. Parse Upper var host.!name destination
  206.  
  207. Say 'local host' destination
  208. Call Log 'local host (name)' destination
  209. If destination = 'HOST.!NAME' Then Do
  210.   Say 'Unable to determine local hostname'
  211.   Say
  212.   Say 'The most likely cause is that you have not included a line in your'
  213.   Say 'etc/hosts file ('hosts_file') for your own host.  The record'
  214.   Say 'should have the following format:'
  215.   Say
  216.   Say ip_address 'hostname.demon.co.uk hostname'
  217.   Say
  218.   Say 'Where hostname.demon.co.uk and hostname are changed to reflect your'
  219.   Say 'hostname and domain etc.'
  220.   Call SendMsg '<GETMAIL> FAIL HOST.!NAME'
  221.   Exit 999
  222. End
  223.  
  224. If alt_destination.0 <> 0 Then Do
  225.   Do x = 1 to alt_destination.0
  226.     Say 'alternative mail domain' alt_destination.x
  227.     Call Log 'alternative mail domain' alt_destination.x
  228.   End
  229. End
  230.  
  231. /* Get a socket for accepting connections */
  232. socket=SockSocket('AF_INET', 'SOCK_STREAM', '0')
  233. If socket < 0 Then Do
  234.   Say 'SockSocket()' errno
  235.   Call SendMsg '<GETMAIL> FAIL SOCK' errno
  236.   Exit errno
  237. End
  238.  
  239.  
  240. /* Bind the socket */
  241. server.!family = 'AF_INET'
  242. server.!port   = port
  243. server.!addr   = 'INADDR_ANY'
  244.  
  245. retcode = SockBind(socket,'server.!')
  246. If retcode < 0 Then Do
  247.   Say 'SockBind()' errno
  248.   Call SendMsg '<GETMAIL> FAIL SOCK' errno
  249.   Exit errno
  250. End
  251.  
  252. Do Forever
  253.   Say 'Listening...'
  254.   Call SendMsg '<GETMAIL> INFO LISTENING' socket
  255.  
  256.   /* Listen for clients */
  257.   retcode = SockListen(socket, 1)
  258.   If retcode < 0 Then Do
  259.     Say 'SockListen()' errno
  260.     Call SendMsg '<GETMAIL> FAIL SOCK' errno
  261.     Call CleanUp socket
  262.     Exit errno
  263.   End
  264.  
  265.   /* Accept a connection */
  266.   newsock = SockAccept(socket, 'client.!')
  267.   If newsock < 0 Then Do
  268.     If errno = ENOTSOCK Then Do
  269.       Call SendMsg '<GETMAIL> TERMINATED'
  270.       If notify = 2 Then Do
  271.         call mciRxExit
  272.       End
  273.       Call log 'Program terminated by socket being killed'
  274.       Say 'Program terminated'
  275.       Exit 0
  276.     End
  277.     Say 'SockAccept()' errno
  278.     Call SendMsg '<GETMAIL> FAIL SOCK' errno
  279.     Call CleanUp socket
  280.     Exit errno
  281.   End
  282.   Call SendMsg '<GETMAIL> INFO ACCEPTING' socket
  283.  
  284.   /* Get client name */
  285.   retcode = SockGetHostByAddr(client.!addr, 'host.!')
  286.   If retcode = 0 Then Do
  287.     Say 'SockGetHostByAddr()' errno
  288.     Call SendMsg '<GETMAIL> FAIL SOCK' errno
  289.     Call CleanUp socket
  290.     Exit errno
  291.   End
  292.  
  293.   client = host.!name
  294.   Say 'connection from' client 'at' date() time()
  295.   Call Log 'connection from' client 'at' date() time()
  296.  
  297.   Call MySockSend newsock, '220' destination ' GETMAIL OS/2 smtp daemon version' version
  298.  
  299.   endclient = 0
  300.   mailfrom  = ''
  301.   mailto    = ''
  302.   heloplace = ''
  303.   rcptto    = ''
  304.   Do Until endclient = 1
  305.     reply = GetResponse(newsock)
  306.     Parse Upper var reply command .
  307.     Select
  308.       When command = 'HELO' Then Do
  309.         Parse var reply . heloplace .
  310.         Call Log 'heloplace' heloplace
  311.         Call MySockSend newsock, '250' destination
  312.       End
  313.       When command = 'QUIT' Then Do
  314.         Say 'closing connection at client request'
  315.         Call Log 'closing connection'
  316.         Call MySockSend newsock, '221' destination ' closing channel'
  317.         endclient = 1
  318.       End
  319.       When command = 'HELP' Then Do
  320.         Parse Upper var reply . parm
  321.         If parm = '' Then Do
  322.           Say 'client requested general help'
  323.           Call Log 'general help requested'
  324.           Call SendHelp ''
  325.         End
  326.         Else Do
  327.           Say 'client requested help on' parm
  328.           Call Log 'help on' parm 'requested'
  329.           Call SendHelp parm
  330.         End
  331.       End
  332.       When command = 'MAIL' Then Do
  333.         If heloplace = '' Then Do
  334.           Call Log 'MAIL FROM before HELO'
  335.           Call MySockSend newsock, '503 Bad sequence of commands'
  336.         End
  337.         Else Do
  338.           If mailfrom <> '' Then Do
  339.             Call Log 'been given a MAIL FROM more than once'
  340.             Call MySockSend newsock, '503 Bad sequence of commands'
  341.           End
  342.           Else Do
  343.             Parse var reply . ':' . '<' mailfrom '>' .
  344.             Call Log 'MAIL FROM' mailfrom
  345.             Say 'Mail from' mailfrom
  346.             Call MySockSend newsock, '250 OK'
  347.           End
  348.         End
  349.       End
  350.       When command = 'RCPT' Then Do
  351.         If heloplace = '' Then Do
  352.           Call Log 'RCPT TO before HELO'
  353.           Call MySockSend newsock, '503 Bad sequence of commands'
  354.         End
  355.         Else Do
  356.           Parse var reply . ':' rcptto
  357.           Call Log 'RCPT TO' rcptto
  358.           If Left(rcptto, 2) = '<@' Then Do
  359.             Parse Upper var rcptto . '<' route':'username'@'hostname '>' .
  360.             Call Log 'route' route
  361.           End
  362.           Else Do
  363.             Parse Upper var rcptto . '<' username'@'hostname '>' .
  364.           End
  365.           Call Log 'username' username 'hostname' hostname
  366.           Select
  367.             When Pos('%', rcptto)<>0 Then Do
  368.               Call Log 'unknown user (%)'
  369.               Call MySockSend newsock, '550 unknown user' rcptto
  370.             End
  371.             When ValidDestination(hostname) = 0 Then Do
  372.               Call Log 'unknown destination'
  373.               Call MySockSend newsock, '551 User not local; You are talking to' destination
  374.             End
  375.             When alias.username = '' & alias.!default = '' Then Do
  376.               Call Log 'unknown user (no default alias)'
  377.               Call MySockSend newsock, '550 unknown user' username
  378.             End
  379.             Otherwise
  380.               Call Log 'okay, good destination'
  381.               Call Log 'username' username 'alias.username' alias.username
  382.               Call Log 'alias.!default' alias.!default
  383.               Call MySockSend newsock, '250 OK'
  384.               If alias.username = '' Then Do
  385.                 If alias.!default = 'DELIVER' Then Do
  386.                   mailto = mailto Strip(Left(username,8))
  387.                 End
  388.                 Else Do
  389.                   mailto = mailto alias.!default
  390.                 End
  391.               End
  392.               Else Do
  393.                 mailto = mailto alias.username
  394.               End
  395.           End
  396.         End
  397.       End
  398.       When command = 'DATA' Then Do
  399.         Call Log 'just received a DATA line'
  400.         Call MySockSend newsock, '354 Start mail input; end with <CRLF>.<CRLF>'
  401.         mail. = 0
  402.         numline = 0
  403.         inheader = 1
  404.         Do Until line = '.' & Length(line) = 1
  405.           line = GetResponse(newsock)
  406.           if line <> '.' | Length(line) <> 1 Then Do
  407.             numline = numline + 1
  408.             If line = '' Then inheader = 0
  409.             If Left(line, 1) = '.' Then Do   /* Transparency, as per rfc821 */
  410.               line = Substr(line, 2)
  411.             End
  412.             If Left(line, 5) = 'From ' & inheader = 0 Then Do
  413.               line = '>' || line
  414.             End
  415.             mail.numline = line
  416.             line = ''           /* Not interested in line if we get in here */
  417.           End
  418.           Else Do
  419.             numline = numline + 1
  420.             mail.numline = ''     /* blank line to separate messages */
  421.           End
  422.         End
  423.         mail.0 = numline
  424.         retcode = DeliverMail()
  425.         mailto = ''
  426.         mailfrom = ''
  427.         rcptto = ''
  428.         Call MySockSend newsock, retcode
  429.         Call NotifyUser retcode
  430.       End
  431.       When command = 'NOOP' Then Do
  432.         Call Log 'just received a NOOP (no operation) command'
  433.         Call MySockSend newsock, '250 OK'
  434.       End
  435.       When command = 'RSET' Then Do
  436.         Call Log 'just received a RSET (reset) command'
  437.         mailto = ''
  438.         mailfrom = ''
  439.         rcptto = ''
  440.         Call MySockSend newsock, '250 OK'
  441.       End
  442.       Otherwise
  443.         Call Log 'unknown request'
  444.         Call MySockSend newsock, '500 Syntax error, command unrecognised'
  445.     End
  446.   End
  447.   Call Log 'client quit requested'
  448.   Call SockSoClose(newsock)
  449. End
  450.  
  451. /* cannot get here */
  452. Call halt
  453. Exit 0
  454.  
  455. /* Close every socket */
  456. halt:
  457.  
  458.   If notify = 2 Then Do
  459.     call mciRxExit
  460.   End
  461.   If CurrentQ <> '' Then Do
  462.     Call RXQUEUE 'Set', CurrentQ
  463.   End
  464.   Call log 'Program terminated by user pressing CTRL+C'
  465.   Say 'Closing socket...'
  466.   Call SendMsg '<GETMAIL> TERMINATED'
  467.   Call CleanUp socket
  468.   Exit 0
  469.  
  470. /* Close smtp receiving socket */
  471. CleanUp: Procedure expose crlf logfile ControlQ CurrentQ socket
  472.  
  473.   retcode = SockSoClose(socket)
  474.   If retcode < 0 Then Do
  475.     Say 'SockSoClose()' errno
  476.     Call SendMsg '<GETMAIL> FAIL SOCK' errno
  477.     Exit errno
  478.   End
  479.   Return
  480.  
  481. ReadMailDomainFile: Procedure expose crlf logfile ControlQ CurrentQ,
  482.                                      alt_destination.
  483.  
  484.   Parse arg file
  485.   If Stream(file, 'c', 'open read') <> 'READY:' Then Do
  486.     Call Log 'alternative mail domain file missing' file
  487.     Return
  488.   End
  489.   num = 0
  490.   Do While Lines(file)<>0
  491.     num = num + 1
  492.     domain = LINEIN(file)
  493.     Parse Upper var domain alt_destination.num
  494.   End
  495.   retcode = Stream(file, 'c', 'close')
  496.   alt_destination.0 = num
  497.   Call Log 'Alternative mail domains:' num
  498.   Return
  499.  
  500.  
  501. ValidDestination: Procedure expose crlf logfile ControlQ CurrentQ,
  502.                                    destination alt_destination.
  503.  
  504.   Parse arg hostname
  505.   retcode = 0
  506.   If hostname = destination Then Do
  507.     retcode = 1
  508.   End
  509.   Else If alt_destination.0 <> 0 Then Do
  510.     Do x = 1 to alt_destination.0
  511.       If alt_destination.x = hostname Then retcode = x + 1
  512.     End
  513.   End
  514.   Call Log 'ValidDestination('hostname') = 'retcode
  515.   Return retcode
  516.  
  517. MySockSend: Procedure expose crlf logfile ControlQ CurrentQ
  518.  
  519.   Parse arg socket, data
  520.   If Right(data, 2)<>crlf Then data=data||crlf
  521.   retcode = 0
  522.   Do While retcode < Length(data)
  523.     retcode = SockSend(socket, data)
  524.     If retcode < 0 Then Do
  525.       Say 'SockSend()' errno
  526.       Call SendMsg '<GETMAIL> FAIL SOCK' errno
  527.       Call CleanUp socket
  528.       Exit errno
  529.     End
  530.     If retcode < Length(data) Then Do
  531.       data = Substr(data, retcode + 1)
  532.       retcode = 0
  533.     End
  534.   End
  535.   Return
  536.  
  537. GetResponse: Procedure expose crlf buffer logfile ControlQ CurrentQ
  538.  
  539.   Parse arg socket .
  540.   Do While Pos(crlf, buffer) = 0
  541.     retcode = SockRecv(socket, 'data', 10000)
  542.     If retcode < 0 Then Do
  543.       Say 'SockRecv()' errno
  544.       Call SendMsg '<GETMAIL> FAIL SOCK' errno
  545.       Call CleanUp socket
  546.       Exit errno
  547.     End
  548.     buffer = buffer || data
  549.   End
  550.   data = Left(buffer, Pos(crlf, buffer) - 1)
  551.   buffer = Substr(buffer, Pos(crlf, buffer) + 2)
  552.   Return data
  553.  
  554. GetValidMailboxes: Procedure expose mailbox aliasfile alias. logfile crlf,
  555.                                     ControlQ CurrentQ
  556.  
  557.   Call SysFileTree mailbox||'*.txt', 'file', 'FO'
  558.   Do i = 1 to file.0
  559.     Parse Upper value FileSpec('name', file.i) with username '.' .
  560.     alias.username = username
  561.   End
  562.   username = '!junk'
  563.   If Stream(aliasfile, 'c', 'open read') <> 'READY:' Then Do
  564.     Call Log 'alias file missing' aliasfile
  565.     Return
  566.   End
  567.   Do While Lines(aliasfile)<>0
  568.     curline = LINEIN(aliasfile)
  569.     If Left(curline, 1)<>'#' Then Do
  570.       If Left(curline, 1)<>' ' Then Do
  571.         Parse var curline username rest
  572.         Parse Upper var username username
  573.         If username <> 'DEFAULT' Then Do
  574.           alias.username = rest
  575.         End
  576.         Else Do
  577.           Parse Upper var rest rest
  578.           alias.!default = rest
  579.         End
  580.       End
  581.       Else Do
  582.         Parse var curline rest
  583.         If rest<>'' Then Do
  584.           alias.username = alias.username rest
  585.         End
  586.         Else Do
  587.           username = '!junk'
  588.         End
  589.       End
  590.     End
  591.   End
  592.   retcode = Stream(aliasfile, 'c', 'close')
  593.   Return
  594.  
  595. DeliverMail:  Procedure expose mail. mailto alias. sequence mqueue mailbox,
  596.                                destination mailfrom client version logfile,
  597.                                crlf ControlQ CurrentQ pop_deliver pop_mailbox,
  598.                                ka9q_deliver prm_deliver prm_root
  599.  
  600.   retcode = 0
  601.   Call Log 'DeliverMail->'mailto
  602.   Do while (mailto <> '' & retcode = 0)
  603.     Parse var mailto next mailto
  604.     If Pos('@', next) = 0 Then Do /* local mail box */
  605.       retcode = LocalMail(next)
  606.       If retcode = 0 Then Do
  607.         Say 'received mail for' next
  608.       End
  609.       Call Log 'LocalMail('next')='retcode
  610.     End
  611.     Else Do /* needs to be posted on */
  612.       Call Log 'post note to' next
  613.       retcode = RemoteMail(next)
  614.       If retcode = 0 Then Do
  615.         Say 'received mail and forwarded to' next
  616.       End
  617.       Call Log 'RemoteMail('next')='retcode
  618.     End
  619.   End
  620.   If retcode = 0 Then Do
  621.     Call Log '250 OK mail delivered'
  622.     Return '250 OK'
  623.   End
  624.   Else Do
  625.     Say 'Problem receiving mail'
  626.     Call Log '452 insufficient system storage'
  627.     Return '452 Insufficient system storage'
  628.   End
  629.   Return '451 daemon program error'
  630.  
  631. LocalMail: Procedure expose mail. mailbox client version logfile,
  632.                             destination mailfrom crlf ControlQ CurrentQ,
  633.                             pop_deliver pop_mailbox ka9q_deliver,
  634.                             prm_deliver prm_root
  635.  
  636.   arg userid
  637.   retcode = 0
  638.   If ka9q_deliver = 'YES' Then Do
  639.     Call Log 'deliver note to local ka9q mailbox' userid
  640.     retcode = Localka9qMail(userid)
  641.   End
  642.   If retcode = 0 & pop_deliver = 'YES' Then Do
  643.     Call Log 'deliver note to local pop mailbox ('pop_mailbox')'
  644.     retcode = LocalPOPMail()
  645.   End
  646.   If retcode = 0 & prm_deliver = 'YES' Then Do
  647.     Call Log 'deliver note to local prm mailbox ('prm_root'\'userid'\)'
  648.     retcode = LocalPRMMail(userid)
  649.   End
  650.   Return retcode
  651.  
  652. Localka9qMail: Procedure expose mail. mailbox client version logfile,
  653.                                 destination mailfrom crlf ControlQ CurrentQ
  654.  
  655.   arg userid
  656.   file = mailbox || Strip(Left(userid,8))
  657.   txt = file || '.txt'
  658.   If OpenAppend(txt)<>0 Then Do
  659.     Call Log 'Error opening' txt
  660.     retcode = 1
  661.   End
  662.   Else Do
  663.     rline = 'From' mailfrom date() time()
  664.     retcode = LINEOUT(txt, rline)
  665.     rline = 'Received: from' client 'by' destination
  666.     rline = rline || d2c(13) || d2c(10) || d2c(9)       /* CR LF TAB */
  667.     rline = rline || ' with OS/2 GETMAIL SMTP' version ';' date('N') time('N')
  668.     rline = rline || 'GMT'  /* This should be determined from TZ or GTZ */
  669.     retcode = LINEOUT(txt, rline)
  670.     Do i = 1 to mail.0
  671.       retcode = LINEOUT(txt, mail.i)
  672.     End
  673.     retcode = Stream(txt, 'c', 'close')
  674.     retcode = 0
  675.   End
  676.   Return retcode
  677.  
  678. LocalPOPMail:  Procedure expose mail. pop_mailbox client version logfile,
  679.                                 destination mailfrom crlf ControlQ CurrentQ
  680.  
  681.   rline = 'Received: from' client 'by' destination
  682.   rline = rline || d2c(13) || d2c(10) || d2c(9)       /* CR LF TAB */
  683.   rline = rline || 'with OS/2 GETMAIL SMTP' version ';' date('N') time('N')
  684.   rline = rline || 'GMT'  /* This should be determined from TZ or GTZ */
  685.   template = pop_mailbox||'\msg?????.txt'
  686.   file = SysTempFileName(template)
  687.   If file = '' Then Do
  688.     Call Log 'Error determining POP mailfile'
  689.     Return 1
  690.   End
  691.   If OpenAppend(file)<>0 Then Do
  692.     Call Log 'Error opening POP mailfile' file
  693.     Return 1
  694.   End
  695.   retcode = LINEOUT(file, rline)
  696.   Do i = 1 to mail.0
  697.     retcode = LINEOUT(file, mail.i)
  698.   End
  699.   retcode = Stream(file, 'c', 'close')
  700.   Return 0
  701.  
  702. LocalPRMMail:  Procedure expose mail. prm_root client version logfile,
  703.                                 destination mailfrom crlf ControlQ CurrentQ
  704.  
  705.   arg userid
  706.   rline = 'Received: from' client 'by' destination
  707.   rline = rline || d2c(13) || d2c(10) || d2c(9)       /* CR LF TAB */
  708.   rline = rline || 'with OS/2 GETMAIL SMTP' version ';' date('N') time('N')
  709.   rline = rline || 'GMT'  /* This should be determined from TZ or GTZ */
  710.   template = prm_root'\'userid'\msg?????.txt'
  711.   file = SysTempFileName(template)
  712.   If file = '' Then Do
  713.     Say 'PRM InBasket missing - delivering to default' prm_root
  714.     Call Log 'Local PRM mailbox' prm_root'\'userid 'does not exist'
  715.     Call Log 'mail will be delivered to' prm_root
  716.     template = prm_root'\msg?????.txt'
  717.     file = SysTempFileName(template)
  718.     If file = '' Then Do
  719.       Call Log 'Error determining PRM mailfile'
  720.       Return 1
  721.     End
  722.   End
  723.   If OpenAppend(file)<>0 Then Do
  724.     Call Log 'Error opening mailfile' file
  725.     Return 1
  726.   End
  727.   retcode = LINEOUT(file, rline)
  728.   Do i = 1 to mail.0
  729.     retcode = LINEOUT(file, mail.i)
  730.   End
  731.   retcode = Stream(file, 'c', 'close')
  732.   Return 0
  733.  
  734. RemoteMail: Procedure expose mail. sequence mqueue destination logfile,
  735.                              mailfrom client version crlf ControlQ CurrentQ
  736.  
  737.   Parse arg userid
  738.   Parse var userid username '@' host
  739.   number = IncrementSequence(sequence)
  740.   If number = -1 Then Do
  741.     Return 1
  742.   End
  743.   txt = mqueue || number || '.txt'
  744.   wrk = mqueue || number || '.wrk'
  745.   lck = mqueue || number || '.lck'
  746.   If Stream(lck, 'c', 'query exists') <> '' Then Do
  747.     Call Log 'mail file locked' lck
  748.     Return 1
  749.   End
  750.   If Stream(lck, 'c', 'open write') <> 'READY:' Then Do
  751.     Call Log 'unable to lock' lck
  752.     Return 1
  753.   End
  754.   retcode = Stream(lck, 'c', 'close')
  755.   If Stream(wrk, 'c', 'query exists') <> '' Then Do
  756.     Call Log 'wrk file already exists' wrk
  757.     Return 1
  758.   End
  759.   If Stream(txt, 'c', 'query exists') <> '' Then Do
  760.     Call Log 'txt file already exists' txt
  761.     Return 1
  762.   End
  763.   If Stream(wrk, 'c', 'open write') <> 'READY:' Then Do
  764.     Call Log 'unable to open wrk file' wrk
  765.     Return 1
  766.   End
  767.   retcode = LINEOUT(wrk, host)
  768.   retcode = LINEOUT(wrk, mailfrom)
  769.   retcode = LINEOUT(wrk, userid)
  770.   retcode = Stream(wrk, 'c', 'close')
  771.   If Stream(txt, 'c', 'open write') <> 'READY:' Then Do
  772.     Call Log 'unable to open txt file' txt
  773.     Return 1
  774.   End
  775.   rline = 'Received: from' client 'by' destination
  776.   rline = rline || d2c(13) || d2c(10) || d2c(9)
  777.   rline = rline || 'with OS/2 GETMAIL SMTP' version ';' date() time()
  778.   retcode = LINEOUT(txt, rline)
  779.   Do i = 1 to mail.0
  780.     retcode = LINEOUT(txt, mail.i)
  781.   End i
  782.   retcode = Stream(txt, 'c', 'close')
  783.   Call SysFileDelete lck
  784.   Return 0
  785.  
  786. IncrementSequence: Procedure expose logfile crlf ControlQ CurrentQ
  787.  
  788.   arg file
  789.   If Stream(file, 'c', 'open') <> 'READY:' Then Do
  790.     Call Log 'unable to open sequence file' file
  791.     Return -1
  792.   End
  793.   number = LINEIN(file)
  794.   number = number + 1
  795.   retcode = Stream(file, 'c', 'seek =1')
  796.   retcode = LINEOUT(file, number)
  797.   retcode = Stream(file, 'c', 'close')
  798.   Return number
  799.  
  800. OpenAppend: Procedure expose logfile crlf ControlQ CurrentQ
  801.  
  802.   arg file
  803.   retcode = Stream(file, 'c', 'open write')
  804.   /* Add some code here to handle if there is a null at the end of the file */
  805.   If retcode <> 'READY:' Then Do
  806.     Call Log 'unable to openappend' file
  807.     Return 1
  808.   End
  809.   Else Do
  810.     Return 0
  811.   End
  812.  
  813. Log: Procedure expose logfile crlf ControlQ CurrentQ
  814.  
  815.   Parse arg line
  816.   retcode = Stream(logfile, 'c', 'open write')
  817.   retcode = LINEOUT(logfile, line)
  818.   retcode = Stream(logfile, 'c', 'close')
  819.   Return
  820.  
  821. NotifyUser: Procedure expose notify mail_wav crlf ControlQ CurrentQ
  822.  
  823.   Parse arg retcode
  824.   If Left(retcode, 3) <> '250' Then Return
  825.   Select
  826.     When notify = 2 Then Do                     /* Play mail_wav wav file */
  827.       /* Open the default digital audio device for exclusive use */
  828.       rc = mciRxSendString('open waveaudio alias wave wait', 'RetStr', '0', '0')
  829.  
  830.       /* Check for an error, call a function to return an error string */
  831.       If rc <> 0 Then Do
  832.         MacRC = mciRxGetErrorString(rc, 'ErrStVar')
  833.       End
  834.  
  835.       /* Load a digital audio file */
  836.       rc = mciRxSendString('load wave' mail_wav 'wait', 'RetStr', '0', '0')
  837.  
  838.       /* Obtain the ID for the device context that was just opened */
  839.       DevID = mciRxGetDeviceID(wave)
  840.  
  841.       /* Set the time format to milliseconds */
  842.       Call mciRxSendString 'set wave time format ms', 'RetStr', '0', '0'
  843.  
  844.       /* Determine whether the microphone connection enable */
  845.       Call mciRxSendString 'connector wave query type microphone wait',
  846.                            ,'RetStr', '0', '0'
  847.  
  848.       /* Query the length of the opened file, value is in millseconds */
  849.       Call mciRxSendString 'status wave length wait', 'RetStr', '0', '0'
  850.  
  851.       /* Play the multimedia file, wait for completion */
  852.       Call mciRxSendString 'play wave wait', 'RetStr', '0', '0'
  853.  
  854.       /* "Rewind" to the beginning of the file */
  855.       Call mciRxSendString 'seek wave to start wait', 'RetStr', '0', '0'
  856.  
  857.       /* Close the device context */
  858.       Call mciRxSendString 'close wave', 'RetStr', '0', '0'
  859.     End
  860.     When notify = 1 Then Do /* beep */
  861.       Call Beep 524, 250
  862.     End
  863.     When notify = 0 Then Do /* nothing */
  864.     End
  865.     Otherwise
  866.       Say 'Invalid notify option'
  867.       Call halt
  868.   End
  869.   Return
  870.  
  871.  
  872. SendHelp: Procedure expose newsock version logfile crlf ControlQ CurrentQ
  873.  
  874.   arg command
  875.   If command = '' Then Do
  876.     Call MySockSend newsock, '214-GETMAIL OS/2 smtp daemon version' version
  877.     Call MySockSend newsock, '214  HELO MAIL RCPT RSET HELP NOOP QUIT'
  878.   End
  879.   Else Do
  880.     Call MySockSend newsock, '214 No help available for this command'
  881.   End
  882.   Return
  883.  
  884. SendMsg: Procedure expose ControlQ CurrentQ
  885.  
  886.   Parse arg message
  887.   If ControlQ <> '' & ControlQ <> 'CONTROLQ' Then Do
  888.     Queue message
  889.   End
  890.   Return
  891.  
  892. testmaildir:  Procedure
  893.  
  894.   Parse arg dir
  895.   Call SysFileTree dir, 'file', 'D'
  896.   If file.0 <> 1 Then Do
  897.     Say 'Unable to locate mail directory ('dir')'
  898.     Exit 1
  899.   End
  900.   Return
  901.  
  902. ReadINIFile:
  903.  
  904.   arg inifile, application
  905.   file = SysSearchPath('PATH',inifile)
  906.   If file = '' Then Do
  907.     Say 'Unable to find' inifile
  908.     Exit 1
  909.   End
  910.   app = ''
  911.   ini. = 0
  912.   retcode = Stream(file, 'c', 'open read')
  913.   If retcode <> 'READY:' Then Do
  914.     Say 'Unable to open' file
  915.     Exit 2
  916.   End
  917.   Do While Lines(file) <> 0
  918.     line = LINEIN(file)
  919.     If Left(line, 1) = '[' Then Do
  920.       Parse Upper var line '[' app ']' .
  921.     End
  922.     Else Do
  923.       If line <> '' & Left(line, 1) <> '#' Then Do
  924.         If app = '' Then Do
  925.           Say 'Invalid line in' file 'expected [application_name]'
  926.           Exit 1
  927.         End
  928.         If app = application | app = 'DEFAULT' Then Do
  929.           Parse var line varname '=' varvalue
  930.           Parse Upper var varname varname
  931.           varname = Strip(varname)
  932.           varvalue = Strip(varvalue)
  933.           If ini.varname = 0 | app = application Then Do
  934.             retcode = Value(varname, varvalue)
  935.             ini.varname = 1
  936.           End
  937.         End
  938.       End
  939.     End
  940.   End
  941.   retcode = Stream(file, 'c', 'close')
  942.   Return
  943.  
  944. ShowWarranty:
  945.   Say 'Because the program is licensed free of charge, there is no warranty'
  946.   Say 'for the program, to the extent permitted by applicable law.  Except when'
  947.   Say 'otherwise stated in writing the copyright holders and/or other parties'
  948.   Say 'provide the program "as is" without warranty of any kind, either expressed'
  949.   Say 'or implied, including, but not limited to, the implied warranties of'
  950.   Say 'merchantability and fitness for a particular purpose.  The entire risk as'
  951.   Say 'to the quality and performance of the program is with you.  Should the'
  952.   Say 'program prove defective, you assume the cost of all necessary servicing,'
  953.   Say 'repair or correction.'
  954.   Say
  955.   Say 'Read the GNU PUBLIC LICENSE for full details'
  956.   Return
  957.  
  958. ShowConditions:
  959.   Say 'You may copy and distribute verbatim copies of the Program''s'
  960.   Say 'source code as you receive it, in any medium, provided that you'
  961.   Say 'conspicuously and appropriately publish on each copy an appropriate'
  962.   Say 'copyright notice and disclaimer of warranty; keep intact all the'
  963.   Say 'notices that refer to this License and to the absence of any warranty;'
  964.   Say 'and give any other recipients of the Program a copy of this License'
  965.   Say 'along with the Program.'
  966.   Say
  967.   Say 'Read the GNU PUBLIC LICENSE for full details'
  968.   Return
  969.