/* Process an UltiMail arrival event.
*/
parse arg parms
message.userid.list = ''
do i = 1 to message.userid.0
  message.userid.list = message.userid.list message.userid.i
end /* do */
call say 'Mail file' message.file 'arrived for' message.userid.list

server.drive   = filespec('drive', message.file)
server.inbox   = filespec('path',  message.file)
server.inbox   = delstr(server.inbox, length(server.inbox))
server.root    = filespec('path',  server.inbox)
server.root    = delstr(server.root,  length(server.root))
server.partial = server.root'\Partial'
call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
call SysLoadFuncs

'GETHEADER' message.index

partialrc = CheckPartial()

/************* Place user customization here **********/
/* enable for paging on arrival
if partialrc = 0 then do
  if wordpos('JVK', translate(message.userid.list)) > 0 then do
    if translate(subword(header.subject, 1, 1)) = 'PAGE' then do
      text = subword(header.subject, 2, words(header.subject)-1)
      call say 'paging GCuomo from UltiMail:' text
      address CMD 'sendpage gcuomo' text
    end
  end
end
*/

/* Handle forums - IBM only! */
j = pos("FORUM:", translate(header.full))
if j > 0 then do
  parse value substr(header.full,j) with ':' forumline ')'
  forumline = '-----' strip(forumline) || ')'
  x = stream(message.file, 'c', 'open')
  x = stream(message.file, 'c', 'seek <0')
  x = lineout(message.file, forumline)
  x = stream(message.file, 'c', 'close')
end

rc = 0
/******************************************************/

return partialrc + rc



/* "Say" a message to the log. */
Say: procedure
  parse arg message
  say message
  'LOGPRINT' message
return


/* Display the header fields that we know about. */
ShowHeader:
  call say 'Message file:' message.file
  If header.from.0 > 0 then
    do i = 1 to header.from.0
      call say "From:   " header.from.i
    end
  If header.to.0 > 0 then
    do i = 1 to header.to.0
      call say "To:     " header.to.i
    end
  If header.cc.0 > 0 then
    do i = 1 to header.cc.0
      call say "CC:     " header.cc.i
    end
  If header.date.sent <> '' then call say "Date Sent:" header.date.sent
  If header.date.received <> '' then call say "Date Received:" header.date.received
  If header.subject <> '' then call say "Subject:" header.subject
  If header.content.type <> '' then call say "Content type:" header.content.type
  If header.content.subtype <> '' then call say "Content subtype:" header.content.subtype
  If header.unknown <> '' then call say "Unknown:" header.unknown
  If header.full <> '' then call say "Full:" header.full
return


/* Check the message to see if it's a partial message.
   If it is, keep track of it.
*/
CheckPartial:
  j = pos("CONTENT-TYPE:", translate(header.full))
  if j = 0 then return 0
  parse value substr(translate(header.full),j) with ':' contype ';' typedata
  if contype <> "MESSAGE/PARTIAL" then return 0
  typedata = translate(typedata,' ','0D0A09'x);
  parse var typedata  'ID=' uniqueid . ';'
  parse var typedata  'NUMBER=' seqnum . ';'
  parse var typedata  'TOTAL=' total . ';'
  if total = '' then total = '?'
  call say 'Partial message, ID='uniqueid', part' seqnum 'of' total'.'

  address CMD '@move' message.file server.partial
  if rc = 0 then
    message.file = server.drive || server.partial'\'filespec('name', message.file)

  /* Lock out all other partial file processing while we process. */
  partiallock = server.drive || server.partial'\PARTIAL.LK'
  do forever
    if stream(partiallock, 'c', 'open write') = 'READY:' then leave
    call SysSleep 5 /* wait 5 seconds and retry */
  end

  call SysFileTree server.drive || server.partial'\PARTIAL.*', 'files', 'FO'
  do i = 1 to files.0
    line = linein(files.i)
    call stream files.i, 'c', 'close'
    parse var line  maxnum id
    if id = uniqueid then leave
  end /* do */

  if id = uniqueid then /* we found a match */ do
    if seqnum = total then maxnum = total
    mustinsert = 1
    call linein files.i
    do j = 1
      line.j = linein(files.i)
      if line.j = '' then /* we're at the end of the file */ do
        if mustinsert then
          line.j = seqnum message.file
        else
          j = j - 1
        leave
       end
      else /* not at the end of the file */ do
        parse var line.j num .
        if num = seqnum then mustinsert = 0 /* never insert duplicate part numbers */
        if mustinsert & (num > seqnum) then /* need to insert this record here */ do
          k = j + 1
          line.k = line.j
          line.j = seqnum message.file
          j = k
          mustinsert = 0
        end
       end
    end
    line.0 = j
    if maxnum = line.0 then /* we have all the parts */ do
      call Assemble
      call stream files.i, 'c', 'close'
      call SysFileDelete files.i
     end
    else /* still have to wait for parts */ do
      call lineout files.i, maxnum id, 1
      do j = 1 to line.0
        call lineout files.i, line.j
      end
      call stream files.i, 'c', 'close'
     end
   end
  else /* this is the first */ do
    files.i = SysTempFileName(server.drive || server.partial'\PARTIAL.???')
    if seqnum = total then maxnum = total
    else maxnum = '?'
    call lineout files.i, maxnum uniqueid
    call lineout files.i, seqnum message.file
    call stream files.i, 'c', 'close'
   end

  /* Free the partial file processing lock now. */
  call stream 'partiallock', 'c', 'close'
return 1


Assemble:
  call say 'All pieces for partial message' uniqueid 'have arrived.'
  files.merge = SysTempFileName(server.drive || server.partial'\JWM?????.NOT')
  hdr.merge = 1
  do j = 1 to line.0
    hdr.part = 1
    hdr.word = ''
    parse var line.j  . filename
    do forever
      line = linein(filename)
      if stream(filename, 's') <> 'READY' then leave
      if hdr.part then do
        if line = '' then do /* end of header for this part */
          hdr.word = ''
          hdr.part = 0
          iterate
         end
        if \hdr.merge then iterate /* we've got the whole header already */
        if j > 1 then iterate /* ignore the header for parts 2 to n */
        if (substr(line,1,1) = '' | substr(line,1,1) = '09'x) then
          if hdr.word = '' then iterate /* part of a header line we're ignoring */
          else nop
        else do
          hdr.word = HeaderItemCheck(line, 'H')
          if hdr.word = '' then iterate
         end
       end
      else
        if hdr.merge then do
          if line = '' then /* end of merged header */
            hdr.merge = 0
          else
            if (substr(line,1,1) = '' | substr(line,1,1) = '09'x) then
              if hdr.word = '' then iterate /* part of a header line we're ignoring */
              else nop
            else do
              hdr.word = HeaderItemCheck(line, 'B')
              if hdr.word = '' then iterate
             end
         end
      call lineout files.merge, line
    end /* do */
    call stream filename, 'c', 'close'
    call SysFileDelete filename
  end /* do */
  call stream files.merge, 'c', 'close'
  call say "Message assembled; calling UMAILER."
  address CMD 'umailer.exe -lamail -dest' server.drive || server.inbox '-to' message.userid.list '<' files.merge
  call say "UMAILER completed; assembled message ready for delivery."
  call SysFileDelete files.merge
return


HeaderItemCheck: procedure
  parse upper arg  word ':' , type
  parse var  word  dash1 '-' dash2
  Select
  when dash1 = 'CONTENT' & dash2 <> '' then body = 1
  when word = 'MESSAGE-ID' then body = 1
  when word = 'ENCRYPTED' then body = 1
  when word = 'MIME-VERSION' then body = 1
  when word = 'SUBJECT' then body = 1
  otherwise body = 0
  End

  if type = 'H' then
    if body then return ''
    else return word
  else
    if body then return word
    else return ''
