OS/2 Shareware BBS: 8 Other/08-Other.zip/rxjis096.zip/mimesend.cmd

OS/2 REXX Batch file | 1997-08-07 | 11KB | 348 lines

/* product name: RXJIS                                                */
/* Version:      0.85                                                 */
/* author:       YANO Takashi                                         */
/* target:       OS/2 Warp J3.0+                                      */
/* module name:  MIMESEND.CMD                                         */
/* source name:  MIMESEND.CMD                                         */
/* compiler:     N.A.                                                 */
/* address:      [e-mail] or [e-mail]     */
/* comment:      RXJIS is a utility functions for REXX.               */
/*               It encodes and decodes JIS 7 bit strings and MIME    */
/*               format strings.                                      */
/*                                                                    */
/*               MIMESEND.CMD is a sample program how to use          */
/*               RXJIS. I am using it with PostRoadMailer 1.03a.      */
/*               It converts a mail message with PC Kanji codes       */
/*               into MIME or JIS7bit mail message.                   */
/*                                                                    */
/* how to use:   MIMESEND fn                                          */
/*               fn is a mail message file. The converted result is   */
/*               in fn. The original is lost.                         */
/*                                                                    */
/* history:      1996-2-5 initial release                             */
/*               1996-2-14 0.10 fix small bugs                        */
/*                         missing REXXUTIL loading.                  */
/*                         if NOMIME is missing, novalue occurs.      */
/*               1996-2-19 remove trace                               */
/*               1996-10-20 Avoid to put duplicated headers.          */
/*                                                                    */
/*                                                                    */
/*                                                                    */
/*                                                                    */
arg fn
signal on novalue
call rxfuncadd 'SysLoadFuncs', 'REXXUTIL', 'SysLoadFuncs' /* A@0.10 */
call SysLoadFuncs                                         /* A@0.10 */
call rxfuncdrop 'RxJisLoadFuncs'
call rxfuncadd 'RxJisLoadFuncs', 'RXJIS', 'RxJisLoadFuncs'
call RxJisLoadFuncs
if stream(fn, 'c', 'query exists') = '' then exit
call LoadHeader fn
call LoadBody fn
call stream fn, 'c', 'close'
call CheckIfNomimeHost
i = 1
j = 1
newheader.1 = 'MIME-Version: 1.0'
do while i <= header.0
   select
      when translate(word(header.i, 1)) = 'SUBJECT:' then parse value processsubject(i, j) with i j
      when translate(word(header.i, 1)) = 'REPLY-TO:' then parse value processreplyto(i, j) with i j
      when translate(word(header.i, 1)) = 'FROM:' then parse value processaddress(i, j) with i j
      when translate(word(header.i, 1)) = 'TO:' then parse value processaddress(i, j) with i j
      when translate(word(header.i, 1)) = 'CC:' then parse value processaddress(i, j) with i j
      when translate(word(header.i, 1)) = 'BCC:' then parse value processaddress(i, j) with i j
      when wordpos(translate(word(header.i, 1)), 'MIME-VERSION: CONTENT-TYPE: CONTENT-TRANSFER-ENCODING:') > 0 then i = i + 1 /* A@0.85 */
   otherwise
      j = j + 1
      newheader.j = header.i
      i = i + 1
   end  /* select */
end /* do */
if iso2022jp then do
   j = j + 1
   newheader.j = 'Content-Type: text/plain; charset="ISO-2022-JP"'
   j = j + 1
   newheader.j = 'Content-Transfer-Encoding: 7bit'
   do i = 1 to body.0
      if body.i <> '' then body.i = RxJisToJis(body.i)
   end /* do */
end  /* Do */
else do
   j = j + 1
   newheader.j = 'Content-Type: text/plain; charset="US-ASCII"'
   j = j + 1
   newheader.j = 'Content-Transfer-Encoding: 7bit'
end  /* Do */
newheader.0 = j
tfn = value('TMP', , 'OS2ENVIRONMENT')
if tfn = '' then tfn = workingdir
if right(tfn, 1) <> '\' then tfn = tfn || '\'
tfn = SysTempFileName(tfn || '????')
do i = 1 to newheader.0
   call lineout tfn, newheader.i
end /* do */
call lineout tfn, ''
do i = 1 to body.0
   call lineout tfn, body.i
end /* do */
call stream tfn, 'C', 'CLOSE'
'@COPY' tfn fn
call SysFileDelete tfn
exit

processreplyto: procedure expose header. newheader. nomimeisrequired
arg i, j
c = words(header.i)
h = word(header.i, 1)
a = word(header.i, c)
j = j + 1
if words(header.i) = 2 then newheader.j = h a
else do
   c = wordindex(header.i, words(header.i))
   m = wordindex(header.i, 2)
   n = strip(substr(header.i, m, c - m))
   if dbvalidate(header.i) = 0 then do
      if left(n, 1) <> '"' & n <> '' then n = '"' || n || '"'
   end  /* Do */
   else do
      options 'EXMODE'
      if dbwidth(n) <> length(n) then do
         n = RxJisToJis(n)
         if nomimeisrequired = 0 then n = '=?ISO-2022-JP?B?' || RxJisToBase64(n) || '?='
      end  /* Do */
      if n <> '' then n = '"' || n || '"'
   end  /* Do */
   newheader.j = h n a
end  /* Do */
return i + 1 j

CheckIfNomimeHost: procedure expose header. nomimeaddress. nomimeisrequired workingdir errorlog
parse source . . a
workingdir = filespec('D', a) || filespec('P', a)
errorlog = workingdir || 'errorlog.log'
f = workingdir || 'NOMIME'
nomimeisrequired = 0 /* A@0.10 */
if stream(f, 'c', 'query exists') = '' then return
nomimeaddress = ''
i = 0
do while lines(f)
   parse upper value linein(f) with a
   a = strip(a)
   if a = '' then iterate
   if pos(left(a, 1), '#;*') > 0 then iterate
   i = i + 1
   nomimeaddress.i = word(a, 1)
end /* do */
call stream f, 'c', 'close'
nomimeaddress.0 = i
i = 1
do while i <= header.0
   select
      when translate(word(header.i, 1)) = 'TO:' then i = checkdestaddress(i)
      when translate(word(header.i, 1)) = 'CC:' then i = checkdestaddress(i)
      when translate(word(header.i, 1)) = 'BCC:' then i = checkdestaddress(i)
   otherwise
      i = i + 1
   end  /* select */
end /* do */
return

checkdestaddress: procedure expose header. nomimeaddress. nomimeisrequired
arg i
line = header.i
i = i + 1
do while i <= header.0
   a = header.i
   if left(a, 1) <> ' ' then leave
   i = i + 1
   line = line a
end /* do */
do j = 1 to nomimeaddress.0
   n = pos(nomimeaddress.j, translate(line))
   if n = 0 then iterate
   nomimeisrequired = 1
   leave
end /* do */
if nomimeisrequired = 0 then return i
line = translate(subword(line, 2), ' ', '09'x)
do while line <> ''
   do j = 1 by 1
      t = gettoken()
      if t = '' | t = ',' then leave
      t.j = t
   end /* do */
   j = j - 1
   parse var t.j with '<' a '>'
   if a = '' then a = t.j
   do z = 1 to nomimeaddress.0
      if translate(right(a, length(nomimeaddress.z))) = nomimeaddress.z then return i
   end /* do */
end /* do */
nomimeisrequired = 0
return i

gettoken: procedure expose line
parse value strip(line) with t line
if left(t, 1) = ',' then do
   parse var t 2 a
   line = a line
   return t
end  /* Do */
zdsl = '"<'
zdsr = '">'
i = pos(left(t, 1), zdsl)
if i = 0 then do
   i = pos(',', t)
   if i = 0 then return t
   if i > 1 then do
      line = substr(t, i) line
      t = left(t, i - 1)
   end  /* Do */
   else do
      t = left(t, 1)
      line = substr(t, 2) line
   end  /* Do */
   return t
end  /* Do */
zd = substr(zdsr, i, 1)
i = 2
line = t line
t = ''
do while line <> ''
   i = pos(zd, line, i)
   if i = 0 then do
      t = t || line
      line = ''
      leave
   end  /* Do */
   if i = 1 then do
      parse var line a 2 line
      t = t || a
      leave
   end  /* Do */
   if substr(line, i - 1, 1) <> '\' then do
      a = left(line, i)
      line = substr(line, i + 1)
      t = t || a
      if pos(left(line, 1), ' ,') > 0 then leave
      t = t || gettoken()
      leave
   end  /* Do */
   i = i + 1
end /* do */
return t

LoadHeader: procedure expose header.
arg fn
do i = 1 by 1 while lines(fn)
   header.i = linein(fn)
   if header.i = '' then do
      header.0 = i - 1
      leave
   end  /* Do */
end /* do */
return

LoadBody: procedure expose body. iso2022jp
arg fn
options 'EXMODE'
iso2022jp = 0
do i = 1 by 1 while lines(fn)
   body.i = linein(fn)
   if dbvalidate(body.i) = 0 then iterate
   if dbwidth(body.i) = length(body.i) then iterate
   iso2022jp = 1
end /* do */
body.0 = i - 1
return

processaddress: procedure expose nomimeisrequired header. newheader.
arg i, j
zi = i
line = header.i
i = i + 1
do while i <= header.0
   a = header.i
   if left(a, 1) <> ' ' then leave
   i = i + 1
   line = line a
end /* do */
if dbvalidate(line) = 0 then do
   do m = zi to i - 1
      j = j + 1
      newheader.j = header.m
   end /* do */
   return i j
end  /* Do */
options 'EXMODE'
zh = word(line, 1)
line = translate(subword(line, 2), ' ', '09'x)
do m = 1 by 1 while line <> ''
   do z = 1 by 1
      t = gettoken()
      if t = '' then leave
      if t = ',' & z > 2 then leave
      if t = ',' & z = 2 then do
         if pos('@', t.1) > 0 then leave
      end  /* Do */
      t.z = t
   end /* do */
   t.0 = z - 1
   n = ''
   do z = 1 to t.0 - 1
      if z = 2 & t.2 = ',' then n = n || t.z
      else n = n t.z
      say 1 t.z
   end /* do */
   n = strip(n)
   if left(n, 1) <> '"' & n <> '' then n = '"' || n || '"'
   a = t.z t
   if dbwidth(n) <> length(n) then do
      n = RxJisToJis(n)
      if nomimeisrequired = 0 then n = '=?ISO-2022-JP?B?' || RxJisToBase64(n) || '?='
   end  /* Do */
   j = j + 1
   if m = 1 then newheader.j = zh n a
   else newheader.j = copies(' ', length(zh)) n a
end /* do */
return i j

processsubject: procedure expose nomimeisrequired header. newheader.
parse arg i, j
options 'EXMODE'
do n = 1 by 1
   if i > header.0 then leave
   if n > 1 & left(header.i, 1) <> '' then leave
   if dbvalidate(header.i) = 0 then do
      j = j + 1
      newheader.j = header.i
      i = i + 1
      iterate
   end  /* Do */
   if dbwidth(header.i) = length(header.i) then do
      j = j + 1
      newheader.j = header.i
      i = i + 1
      iterate
   end  /* Do */
   if n = 1 then parse var header.i h b
   else do
      h = ' '
      b = header.i
   end  /* Do */
   b = RxJisToJis(strip(b))
   j = j + 1
   if nomimeisrequired then newheader.j = h b
   else newheader.j = h '=?ISO-2022-JP?B?' || RxJisToBase64(b) || '?='
   i = i + 1
end /* do */
return i j

novalue:
call lineout errorlog, date('S') time() condition('C') '@' sigl
call lineout errorlog, date('S') time() condition('D')
call lineout errorlog, date('S') time() condition('I')
call stream errorlog, 'c', 'close'
exit