/****************************************************************************/
/*  GETMAIL.CMD - an ka9q compatible OS/2 smtp daemon                       */
/*  Copyright (C) 1995 Alex Chapman <alex@mercer.demon.co.uk>               */
/*                                                                          */
/*  This program is free software; you can redistribute it and/or modify    */
/*  it under the terms of the GNU General Public License as published by    */
/*  the Free Software Foundation; either version 2 of the License, or       */
/*  (at your option) any later version.                                     */
/*                                                                          */
/*  This program is distributed in the hope that it will be useful,         */
/*  but WITHOUT ANY WARRANTY; without even the implied warranty of          */
/*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the           */
/*  GNU General Public License for more details.                            */
/*                                                                          */
/*  You should have received a copy of the GNU General Public License       */
/*  along with this program; if not, write to the Free Software             */
/*  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.               */
/*                                                                          */
/*  Requires rxsock.zip from IBM Employee Written Software                  */
/*  <ftp://src.doc.ic.ac.uk/packages/os2/ibm/ews/rxsock.zip>                */
/*                                                                          */
/*  Last Modified: 10th August, 1995                                        */
    Version = 1.32
/****************************************************************************/

/************************************************************/
/* Change History                                           */
/************************************************************/
/* 0.1  950117  First version                               */
/* 0.11 950118  First test with post.demon.co.uk            */
/* 0.12 950118  Not writing the happy faces that I used to  */
/* 0.13 950129  Implemented dot transparency rfc821         */
/* 0.14 950129  Additional rfc821 compliance                */
/* 0.15 950130  Fixed problem with mailing lists            */
/* 0.16 950131  removed gnu license for testing             */
/* 0.17 950131  added logfile parameter                     */
/* 0.18 950203  os/2 rexx thinks ' .' == '.'                */
/* 0.19 950203  improved displayed and logged messages      */
/* 0.50 950205  Final Beta Release.                         */
/* 0.51 950206  fix to transparency handling                */
/* 1.00 950211  First Release                               */
/* 1.01 950219  Don't start if unable to determine hostname */
/* 1.10 950225  option for music when mail arrives          */
/* 1.11 950302  corrected 551 error message                 */
/* 1.12 950304  not all procedures exposed logfile          */
/* 1.13 950306  log when user terminates getmail with ctrl+c*/
/* 1.14 950306  change to only do mci calls if notify = 2   */
/* 1.15 950415  expose crlf since HELP was returning garbage*/
/* 1.16 950416  add queue mechanism                         */
/* 1.17 950416  read ka9q root directory from KA9Q env var. */
/* 1.18 950417  moved accepting message                     */
/* 1.19 950427  check ka9q_root directory                   */
/* 1.20 950508  read settings from getmail.ini              */
/* 1.21 950508  added option to deliver to a POP mailbox    */
/* 1.22 950515  allow POP independent of ka9q mailbox       */
/* 1.23 950521  moved call to readinifile                   */
/* 1.24 950523  fixed problem with local POP delivery       */
/* 1.25 950529  added spaced after tab on received line     */
/* 1.26 950531  added code to collect mail for PRM          */
/* 1.27 950531  added some more logging in RemoteMail       */
/* 1.28 950603  fixed 'problem receiving mail' bug          */
/* 1.29 950607  experimenting with better error reporting   */
/* 1.30 950621  use WARPDIS as rexx queue                   */
/* 1.31 950718  move queue settings into ini file           */
/* 1.32 950810  deliver to prm_root if directory missing    */
/************************************************************/

arg gnu rest

port = 25                                           /* SMTP port     */
crlf = d2c(13)||d2c(10)                             /* CR + LF       */
buffer = ''                                         /* Empty buffer  */
ControlQ = ''                                       /* Control Queue   */
CurrentQ = ''                                       /* Current Queue   */

Say 'GETMAIL.CMD - OS/2 SMTP daemon (version' version')'
Say 'Copyright (C) 1995 Alex Chapman'
Say "GETMAIL comes with ABSOLUTELY NO WARRANTY; for details type 'GETMAIL w'."
Say 'This is free software, and you are welcome to redistribute it under certain'
Say "conditions; type `GETMAIL c' for details."
Say

call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
call SysLoadFuncs

Call ReadINIFile 'GETMAIL.INI', 'GETMAIL'

If ka9q_deliver = 'YES' Then Do
  Call testmaildir mailbox
End

If pop_deliver = 'YES' Then Do
  Call testmaildir pop_mailbox
End

If prm_deliver = 'YES' Then Do
  If Right(prm_root, 1) = '\' Then Do
    prm_root = Left(prm_root, Length(prm_root) - 1)
  End
  Call testmaildir prm_root
End

Select
  When gnu = 'C' Then Do
    Call ShowConditions
    Exit 0
  End
  When gnu = 'W' Then Do
    Call ShowWarranty
    Exit 0
  End
  When gnu = 'H' | gnu = '?' Then Do
    Exit 0
  End
  When gnu = 'Q' Then Do
    Say 'The Q parameter is now obsolete, and has been superceded by the use of'
    Say 'the ini settings queue_messages and queue_name'
    Exit 0
  End
  When gnu<>'' Then Do
    Say 'Invalid parameter.  Process terminated.'
    Exit 0
  End
  Otherwise
End

If queue_messages = 'YES' Then Do
  ControlQ = queue_name
  CurrentQ = RXQUEUE('Create', ControlQ)
  If CurrentQ<>ControlQ Then Do
    Call RXQUEUE 'Delete', CurrentQ
  End
  CurrentQ = RXQUEUE('Set', ControlQ)
  Call SendMsg '<GETMAIL> START'
End

Call RxFuncAdd 'SockLoadFuncs', 'RxSock', 'SockLoadFuncs'
Call SockLoadFuncs('QUIET')

If notify = 2 Then Do
  Call RxFuncAdd 'mciRxInit','MCIAPI','mciRxInit'
  Call mciRxInit
End

signal on halt

Call Log '-------------------------------------------------------------'
Call Log 'GETMAIL version' version 'started' date() time()

if Right(mailbox, 1)<>'\' Then mailbox = mailbox || '\'
if Right(mqueue, 1)<>'\' Then mqueue = mqueue || '\'

alias. = ''

If ka9q_deliver = 'YES' Then Do
  Call GetValidMailboxes
End

If pop_deliver = 'YES' | prm_deliver = 'YES' Then Do
  alias.!default = 'DELIVER'
End

hosts_file = SysSearchPath('ETC','HOSTS')

destination = SockGetHostID()
Say 'local host' destination
Call Log 'local host (ID)' destination
If destination = '255.255.255.255' Then Do
  Say 'Unable to determine local hostname'
  Say
  Say 'The most likely problem is that you have not executed the following'
  Say 'command at an os/2 command prompt:'
  Say
  Say 'ifconfig lo xxx.yyy.zz.ww'
  Say
  Say 'Open an OS/2 Window or Full Screen session and type that command, replacing'
  Say 'xxx.yyy.zz.ww with your IP address, or with 127.0.0.1 (if you don''t have a'
  Say 'fixed IP address).'
  Say
  Say 'You must also include a record of the following format in' hosts_file
  Say
  Say 'xxx.yyy.zz.ww hostname.demon.co.uk hostname'
  Call SendMsg '<GETMAIL> FAIL IP-ADDRESS'
  Exit 999
End

retcode = SockGetHostByAddr(destination, 'host.!')
If retcode < 0 Then Do
  Say 'SockGetHostByName()' errno
  Call SendMsg '<GETMAIL> FAIL SOCK' errno
  Exit errno
End

ip_address = destination
Parse Upper var host.!name destination

Say 'local host' destination
Call Log 'local host (name)' destination
If destination = 'HOST.!NAME' Then Do
  Say 'Unable to determine local hostname'
  Say
  Say 'The most likely cause is that you have not included a line in your'
  Say 'etc/hosts file ('hosts_file') for your own host.  The record'
  Say 'should have the following format:'
  Say
  Say ip_address 'hostname.demon.co.uk hostname'
  Say
  Say 'Where hostname.demon.co.uk and hostname are changed to reflect your'
  Say 'hostname and domain etc.'
  Call SendMsg '<GETMAIL> FAIL HOST.!NAME'
  Exit 999
End

/* Get a socket for accepting connections */
socket=SockSocket('AF_INET', 'SOCK_STREAM', '0')
If socket < 0 Then Do
  Say 'SockSocket()' errno
  Call SendMsg '<GETMAIL> FAIL SOCK' errno
  Exit errno
End


/* Bind the socket */
server.!family = 'AF_INET'
server.!port   = port
server.!addr   = 'INADDR_ANY'

retcode = SockBind(socket,'server.!')
If retcode < 0 Then Do
  Say 'SockBind()' errno
  Call SendMsg '<GETMAIL> FAIL SOCK' errno
  Exit errno
End

Do Forever
  Say 'Listening...'
  Call SendMsg '<GETMAIL> INFO LISTENING' socket

  /* Listen for clients */
  retcode = SockListen(socket, 1)
  If retcode < 0 Then Do
    Say 'SockListen()' errno
    Call SendMsg '<GETMAIL> FAIL SOCK' errno
    Exit errno
  End

  /* Accept a connection */
  newsock = SockAccept(socket, 'client.!')
  If newsock < 0 Then Do
    If errno = ENOTSOCK Then Do
      Call SendMsg '<GETMAIL> TERMINATED'
      If notify = 2 Then Do
        call mciRxExit
      End
      Call log 'Program terminated by socket being killed'
      Say 'Program terminated'
      Exit 0
    End
    Say 'SockAccept()' errno
    Call SendMsg '<GETMAIL> FAIL SOCK' errno
    Exit errno
  End
  Call SendMsg '<GETMAIL> INFO ACCEPTING' socket

  /* Get client name */
  retcode = SockGetHostByAddr(client.!addr, 'host.!')
  If retcode = 0 Then Do
    Say 'SockGetHostByName()' errno
    Call SendMsg '<GETMAIL> FAIL SOCK' errno
    Exit errno
  End

  client = host.!name
  Say 'connection from' client 'at' date() time()
  Call Log 'connection from' client 'at' date() time()

  Call MySockSend newsock, '220' destination ' GETMAIL OS/2 smtp daemon version' version

  endclient = 0
  mailfrom  = ''
  mailto    = ''
  heloplace = ''
  rcptto    = ''
  Do Until endclient = 1
    reply = GetResponse(newsock)
    Parse Upper var reply command .
    Select
      When command = 'HELO' Then Do
        Parse var reply . heloplace .
        Call Log 'heloplace' heloplace
        Call MySockSend newsock, '250' destination
      End
      When command = 'QUIT' Then Do
        Say 'closing connection at client request'
        Call Log 'closing connection'
        Call MySockSend newsock, '221' destination ' closing channel'
        endclient = 1
      End
      When command = 'HELP' Then Do
        Parse Upper var reply . parm
        If parm = '' Then Do
          Say 'client requested general help'
          Call Log 'general help requested'
          Call SendHelp ''
        End
        Else Do
          Say 'client requested help on' parm
          Call Log 'help on' parm 'requested'
          Call SendHelp parm
        End
      End
      When command = 'MAIL' Then Do
        If heloplace = '' Then Do
          Call Log 'MAIL FROM before HELO'
          Call MySockSend newsock, '503 Bad sequence of commands'
        End
        Else Do
          If mailfrom <> '' Then Do
            Call Log 'been given a MAIL FROM more than once'
            Call MySockSend newsock, '503 Bad sequence of commands'
          End
          Else Do
            Parse var reply . ':' . '<' mailfrom '>' .
            Call Log 'MAIL FROM' mailfrom
            Say 'Mail from' mailfrom
            Call MySockSend newsock, '250 OK'
          End
        End
      End
      When command = 'RCPT' Then Do
        If heloplace = '' Then Do
          Call Log 'RCPT TO before HELO'
          Call MySockSend newsock, '503 Bad sequence of commands'
        End
        Else Do
          Parse var reply . ':' rcptto
          Call Log 'RCPT TO' rcptto
          Parse Upper var rcptto . '<' username'@'hostname '>' .
          Call Log 'username' username 'hostname' hostname
          Select
            When Pos(':', rcptto)<>0 | Pos('%', rcptto)<>0 Then Do
              Call Log 'unknown user' rcptto
              Call MySockSend newsock, '550 unknown user' rcptto
            End
            When hostname <> destination Then Do
              Call Log 'unknown destination'
              Call MySockSend newsock, '551 User not local; please try' destination
            End
            When alias.username = '' & alias.!default = '' Then Do
              Call Log 'unknown user'
              Call MySockSend newsock, '550 unknown user' username
            End
            Otherwise
              Call Log 'okay, good destination'
              Call Log 'username' username 'alias.username' alias.username
              Call Log 'alias.!default' alias.!default
              Call MySockSend newsock, '250 OK'
              If alias.username = '' Then Do
                If alias.!default = 'DELIVER' Then Do
                  mailto = mailto Strip(Left(username,8))
                End
                Else Do
                  mailto = mailto alias.!default
                End
              End
              Else Do
                mailto = mailto alias.username
              End
          End
        End
      End
      When command = 'DATA' Then Do
        Call Log 'just received a DATA line'
        Call MySockSend newsock, '354 Start mail input; end with <CRLF>.<CRLF>'
        mail. = 0
        numline = 0
        inheader = 1
        Do Until line = '.' & Length(line) = 1
          line = GetResponse(newsock)
          if line <> '.' | Length(line) <> 1 Then Do
            numline = numline + 1
            If line = '' Then inheader = 0
            If Left(line, 1) = '.' Then Do   /* Transparency, as per rfc821 */
              line = Substr(line, 2)
            End
            If Left(line, 5) = 'From ' & inheader = 0 Then Do
              line = '>' || line
            End
            mail.numline = line
            line = ''           /* Not interested in line if we get in here */
          End
          Else Do
            numline = numline + 1
            mail.numline = ''     /* blank line to separate messages */
          End
        End
        mail.0 = numline
        retcode = DeliverMail()
        mailto = ''
        mailfrom = ''
        rcptto = ''
        Call MySockSend newsock, retcode
        Call NotifyUser retcode
      End
      When command = 'NOOP' Then Do
        Call Log 'just received a NOOP (no operation) command'
        Call MySockSend newsock, '250 OK'
      End
      When command = 'RSET' Then Do
        Call Log 'just received a RSET (reset) command'
        mailto = ''
        mailfrom = ''
        rcptto = ''
        Call MySockSend newsock, '250 OK'
      End
      When command = 'VRFY' | command = 'EXPN' Then Do
        Call Log 'just received command' command
        Call MySockSend newsock, '502 Command not implemented, yet...'
      End
      When command = 'SEND' | command = 'SOML' | command = 'SAML' Then Do
        Call Log 'just received command' command
        Call MySockSend newsock, '502 Command not implemented'
      End
      Otherwise
        Call Log 'unknown request'
        Call MySockSend newsock, '500 Syntax error, command unrecognised'
    End
  End
  Call Log 'client quit requested'
  Call SockSoClose(newsock)
End

/* cannot get here */
Call halt
Exit 0

/* Close every socket */
halt:

  If notify = 2 Then Do
    call mciRxExit
  End
  If CurrentQ <> '' Then Do
    Call RXQUEUE 'Set', CurrentQ
  End
  Call log 'Program terminated by user pressing CTRL+C'
  Say 'Closing socket...'
  Call SendMsg '<GETMAIL> TERMINATED'
  retcode = SockSoClose(socket)
  If retcode < 0 Then Do
    Say 'SockSoClose()' errno
    Call SendMsg '<GETMAIL> FAIL SOCK' errno
    Exit errno
  End
  Exit 0

MySockSend: Procedure expose crlf logfile ControlQ CurrentQ

  Parse arg socket, data
  If Right(data, 2)<>crlf Then data=data||crlf
  retcode = 0
  Do While retcode < Length(data)
    retcode = SockSend(socket, data)
    If retcode < 0 Then Do
      Say 'SockSend()' errno
      Call SendMsg '<GETMAIL> FAIL SOCK' errno
      Exit errno
    End
    If retcode < Length(data) Then Do
      data = Substr(data, retcode + 1)
      retcode = 0
    End
  End
  Return

GetResponse: Procedure expose crlf buffer logfile ControlQ CurrentQ

  Parse arg socket .
  Do While Pos(crlf, buffer) = 0
    retcode = SockRecv(socket, 'data', 10000)
    If retcode < 0 Then Do
      Say 'SockRecv()' errno
      Call SendMsg '<GETMAIL> FAIL SOCK' errno
      Exit errno
    End
    buffer = buffer || data
  End
  data = Left(buffer, Pos(crlf, buffer) - 1)
  buffer = Substr(buffer, Pos(crlf, buffer) + 2)
  Return data

GetValidMailboxes: Procedure expose mailbox aliasfile alias. logfile crlf,
                                    ControlQ CurrentQ

  Call SysFileTree mailbox||'*.txt', 'file', 'FO'
  Do i = 1 to file.0
    Parse Upper value FileSpec('name', file.i) with username '.' .
    alias.username = username
  End
  username = '!junk'
  If Stream(aliasfile, 'c', 'open read') <> 'READY:' Then Do
    Call Log 'alias file missing' aliasfile
    Return
  End
  Do While Lines(aliasfile)<>0
    curline = LINEIN(aliasfile)
    If Left(curline, 1)<>' ' Then Do
      Parse var curline username rest
      Parse Upper var username username
      If username <> 'DEFAULT' Then Do
        alias.username = rest
      End
      Else Do
        Parse Upper var rest rest
        alias.!default = rest
      End
    End
    Else Do
      Parse var curline rest
      If rest<>'' Then Do
        alias.username = alias.username rest
      End
      Else Do
        username = '!junk'
      End
    End
  End
  retcode = Stream(aliasfile, 'c', 'close')
  Return

DeliverMail:  Procedure expose mail. mailto alias. sequence mqueue mailbox,
                               destination mailfrom client version logfile,
                               crlf ControlQ CurrentQ pop_deliver pop_mailbox,
                               ka9q_deliver prm_deliver prm_root

  retcode = 0
  Call Log 'DeliverMail->'mailto
  Do while (mailto <> '' & retcode = 0)
    Parse var mailto next mailto
    If Pos('@', next) = 0 Then Do /* local mail box */
      retcode = LocalMail(next)
      If retcode = 0 Then Do
        Say 'received mail for' next
      End
      Call Log 'LocalMail('next')='retcode
    End
    Else Do /* needs to be posted on */
      Call Log 'post note to' next
      retcode = RemoteMail(next)
      If retcode = 0 Then Do
        Say 'received mail and forwarded to' next
      End
      Call Log 'RemoteMail('next')='retcode
    End
  End
  If retcode = 0 Then Do
    Call Log '250 OK mail delivered'
    Return '250 OK'
  End
  Else Do
    Say 'Problem receiving mail'
    Call Log '452 insufficient system storage'
    Return '452 Insufficient system storage'
  End
  Return '451 daemon program error'

LocalMail: Procedure expose mail. mailbox client version logfile,
                            destination mailfrom crlf ControlQ CurrentQ,
                            pop_deliver pop_mailbox ka9q_deliver,
                            prm_deliver prm_root

  arg userid
  retcode = 0
  If ka9q_deliver = 'YES' Then Do
    Call Log 'deliver note to local ka9q mailbox' userid
    retcode = Localka9qMail(userid)
  End
  If retcode = 0 & pop_deliver = 'YES' Then Do
    Call Log 'deliver note to local pop mailbox ('pop_mailbox')'
    retcode = LocalPOPMail()
  End
  If retcode = 0 & prm_deliver = 'YES' Then Do
    Call Log 'deliver note to local prm mailbox ('prm_root'\'userid'\)'
    retcode = LocalPRMMail(userid)
  End
  Return retcode

Localka9qMail: Procedure expose mail. mailbox client version logfile,
                                destination mailfrom crlf ControlQ CurrentQ

  arg userid
  file = mailbox || Strip(Left(userid,8))
  txt = file || '.txt'
  If OpenAppend(txt)<>0 Then Do
    Call Log 'Error opening' txt
    retcode = 1
  End
  Else Do
    rline = 'From' mailfrom date() time()
    retcode = LINEOUT(txt, rline)
    rline = 'Received: from' client 'by' destination
    rline = rline || d2c(13) || d2c(10) || d2c(9)       /* CR LF TAB */
    rline = rline || ' with OS/2 GETMAIL SMTP' version ';' date('N') time('N')
    rline = rline || 'GMT'  /* This should be determined from TZ or GTZ */
    retcode = LINEOUT(txt, rline)
    Do i = 1 to mail.0
      retcode = LINEOUT(txt, mail.i)
    End
    retcode = Stream(txt, 'c', 'close')
    retcode = 0
  End
  Return retcode

LocalPOPMail:  Procedure expose mail. pop_mailbox client version logfile,
                                destination mailfrom crlf ControlQ CurrentQ

  rline = 'Received: from' client 'by' destination
  rline = rline || d2c(13) || d2c(10) || d2c(9)       /* CR LF TAB */
  rline = rline || 'with OS/2 GETMAIL SMTP' version ';' date('N') time('N')
  rline = rline || 'GMT'  /* This should be determined from TZ or GTZ */
  template = pop_mailbox||'\msg?????.txt'
  file = SysTempFileName(template)
  If file = '' Then Do
    Call Log 'Error determining POP mailfile'
    Return 1
  End
  If OpenAppend(file)<>0 Then Do
    Call Log 'Error opening POP mailfile' file
    Return 1
  End
  retcode = LINEOUT(file, rline)
  Do i = 1 to mail.0
    retcode = LINEOUT(file, mail.i)
  End
  retcode = Stream(file, 'c', 'close')
  Return 0

LocalPRMMail:  Procedure expose mail. prm_root client version logfile,
                                destination mailfrom crlf ControlQ CurrentQ

  arg userid
  rline = 'Received: from' client 'by' destination
  rline = rline || d2c(13) || d2c(10) || d2c(9)       /* CR LF TAB */
  rline = rline || 'with OS/2 GETMAIL SMTP' version ';' date('N') time('N')
  rline = rline || 'GMT'  /* This should be determined from TZ or GTZ */
  template = prm_root'\'userid'\msg?????.txt'
  file = SysTempFileName(template)
  If file = '' Then Do
    Say 'PRM InBasket missing - delivering to default' prm_root
    Call Log 'Local PRM mailbox' prm_root'\'userid 'does not exist'
    Call Log 'mail will be delivered to' prm_root
    template = prm_root'\msg?????.txt'
    file = SysTempFileName(template)
    If file = '' Then Do
      Call Log 'Error determining PRM mailfile'
      Return 1
    End
  End
  If OpenAppend(file)<>0 Then Do
    Call Log 'Error opening mailfile' file
    Return 1
  End
  retcode = LINEOUT(file, rline)
  Do i = 1 to mail.0
    retcode = LINEOUT(file, mail.i)
  End
  retcode = Stream(file, 'c', 'close')
  Return 0

RemoteMail: Procedure expose mail. sequence mqueue destination logfile,
                             mailfrom client version crlf ControlQ CurrentQ

  Parse arg userid
  Parse var userid username '@' host
  number = IncrementSequence(sequence)
  If number = -1 Then Do
    Return 1
  End
  txt = mqueue || number || '.txt'
  wrk = mqueue || number || '.wrk'
  lck = mqueue || number || '.lck'
  If Stream(lck, 'c', 'query exists') <> '' Then Do
    Call Log 'mail file locked' lck
    Return 1
  End
  If Stream(lck, 'c', 'open write') <> 'READY:' Then Do
    Call Log 'unable to lock' lck
    Return 1
  End
  retcode = Stream(lck, 'c', 'close')
  If Stream(wrk, 'c', 'query exists') <> '' Then Do
    Call Log 'wrk file already exists' wrk
    Return 1
  End
  If Stream(txt, 'c', 'query exists') <> '' Then Do
    Call Log 'txt file already exists' txt
    Return 1
  End
  If Stream(wrk, 'c', 'open write') <> 'READY:' Then Do
    Call Log 'unable to open wrk file' wrk
    Return 1
  End
  retcode = LINEOUT(wrk, host)
  retcode = LINEOUT(wrk, mailfrom)
  retcode = LINEOUT(wrk, userid)
  retcode = Stream(wrk, 'c', 'close')
  If Stream(txt, 'c', 'open write') <> 'READY:' Then Do
    Call Log 'unable to open txt file' txt
    Return 1
  End
  rline = 'Received: from' client 'by' destination
  rline = rline || d2c(13) || d2c(10) || d2c(9)
  rline = rline || 'with OS/2 GETMAIL SMTP' version ';' date() time()
  retcode = LINEOUT(txt, rline)
  Do i = 1 to mail.0
    retcode = LINEOUT(txt, mail.i)
  End i
  retcode = Stream(txt, 'c', 'close')
  Call SysFileDelete lck
  Return 0

IncrementSequence: Procedure expose logfile crlf ControlQ CurrentQ

  arg file
  If Stream(file, 'c', 'open') <> 'READY:' Then Do
    Call Log 'unable to open sequence file' file
    Return -1
  End
  number = LINEIN(file)
  number = number + 1
  retcode = Stream(file, 'c', 'seek =1')
  retcode = LINEOUT(file, number)
  retcode = Stream(file, 'c', 'close')
  Return number

OpenAppend: Procedure expose logfile crlf ControlQ CurrentQ

  arg file
  retcode = Stream(file, 'c', 'open write')
  /* Add some code here to handle if there is a null at the end of the file */
  If retcode <> 'READY:' Then Do
    Call Log 'unable to openappend' file
    Return 1
  End
  Else Do
    Return 0
  End

Log: Procedure expose logfile crlf ControlQ CurrentQ

  Parse arg line
  retcode = Stream(logfile, 'c', 'open write')
  retcode = LINEOUT(logfile, line)
  retcode = Stream(logfile, 'c', 'close')
  Return

NotifyUser: Procedure expose notify mail_wav crlf ControlQ CurrentQ

  Parse arg retcode
  If Left(retcode, 3) <> '250' Then Return
  Select
    When notify = 2 Then Do                     /* Play mail_wav wav file */
      /* Open the default digital audio device for exclusive use */
      rc = mciRxSendString('open waveaudio alias wave wait', 'RetStr', '0', '0')

      /* Check for an error, call a function to return an error string */
      If rc <> 0 Then Do
        MacRC = mciRxGetErrorString(rc, 'ErrStVar')
      End

      /* Load a digital audio file */
      rc = mciRxSendString('load wave' mail_wav 'wait', 'RetStr', '0', '0')

      /* Obtain the ID for the device context that was just opened */
      DevID = mciRxGetDeviceID(wave)

      /* Set the time format to milliseconds */
      Call mciRxSendString 'set wave time format ms', 'RetStr', '0', '0'

      /* Determine whether the microphone connection enable */
      Call mciRxSendString 'connector wave query type microphone wait',
                           ,'RetStr', '0', '0'

      /* Query the length of the opened file, value is in millseconds */
      Call mciRxSendString 'status wave length wait', 'RetStr', '0', '0'

      /* Play the multimedia file, wait for completion */
      Call mciRxSendString 'play wave wait', 'RetStr', '0', '0'

      /* "Rewind" to the beginning of the file */
      Call mciRxSendString 'seek wave to start wait', 'RetStr', '0', '0'

      /* Close the device context */
      Call mciRxSendString 'close wave', 'RetStr', '0', '0'
    End
    When notify = 1 Then Do /* beep */
      Call Beep 524, 250
    End
    When notify = 0 Then Do /* nothing */
    End
    Otherwise
      Say 'Invalid notify option'
      Call halt
  End
  Return


SendHelp: Procedure expose newsock version logfile crlf ControlQ CurrentQ

  arg command
  If command = '' Then Do
    Call MySockSend newsock, '214-GET OS/2 smtp daemon version' version
    Call MySockSend newsock, '214-Use HELP command for additional information'
    Call MySockSend newsock, '214- HELO MAIL RCPT RSET SEND SAML VRFY EXPN HELP'
    Call MySockSend newsock, '214  NOOP QUIT TURN'
  End
  Else Do
    Call MySockSend newsock, '214 No help available for this command'
  End
  Return

SendMsg: Procedure expose ControlQ CurrentQ

  Parse arg message
  If ControlQ <> '' & ControlQ <> 'CONTROLQ' Then Do
    Queue message
  End
  Return

testmaildir:  Procedure

  Parse arg dir
  Call SysFileTree dir, 'file', 'D'
  If file.0 <> 1 Then Do
    Say 'Unable to locate mail directory ('dir')'
    Exit 1
  End
  Return

ReadINIFile:

  arg inifile, application
  file = SysSearchPath('PATH',inifile)
  If file = '' Then Do
    Say 'Unable to find' inifile
    Exit 1
  End
  app = ''
  ini. = 0
  retcode = Stream(file, 'c', 'open read')
  If retcode <> 'READY:' Then Do
    Say 'Unable to open' file
    Exit 2
  End
  Do While Lines(file) <> 0
    line = LINEIN(file)
    If Left(line, 1) = '[' Then Do
      Parse Upper var line '[' app ']' .
    End
    Else Do
      If line <> '' & Left(line, 1) <> '#' Then Do
        If app = '' Then Do
          Say 'Invalid line in' file 'expected [application_name]'
          Exit 1
        End
        If app = application | app = 'DEFAULT' Then Do
          Parse var line varname '=' varvalue
          Parse Upper var varname varname
          varname = Strip(varname)
          varvalue = Strip(varvalue)
          If ini.varname = 0 | app = application Then Do
            retcode = Value(varname, varvalue)
            ini.varname = 1
          End
        End
      End
    End
  End
  retcode = Stream(file, 'c', 'close')
  Return

ShowWarranty:
  Say 'Because the program is licensed free of charge, there is no warranty'
  Say 'for the program, to the extent permitted by applicable law.  Except when'
  Say 'otherwise stated in writing the copyright holders and/or other parties'
  Say 'provide the program "as is" without warranty of any kind, either expressed'
  Say 'or implied, including, but not limited to, the implied warranties of'
  Say 'merchantability and fitness for a particular purpose.  The entire risk as'
  Say 'to the quality and performance of the program is with you.  Should the'
  Say 'program prove defective, you assume the cost of all necessary servicing,'
  Say 'repair or correction.'
  Say
  Say 'Read the GNU PUBLIC LICENSE for full details'
  Return

ShowConditions:
  Say 'You may copy and distribute verbatim copies of the Program''s'
  Say 'source code as you receive it, in any medium, provided that you'
  Say 'conspicuously and appropriately publish on each copy an appropriate'
  Say 'copyright notice and disclaimer of warranty; keep intact all the'
  Say 'notices that refer to this License and to the absence of any warranty;'
  Say 'and give any other recipients of the Program a copy of this License'
  Say 'along with the Program.'
  Say
  Say 'Read the GNU PUBLIC LICENSE for full details'
  Return