/*******************************************/
/*                                         */
/*                RetR V 1.1               */
/*                                         */
/*     Sends an automatically generated    */
/*   Return receive Message to the sender  */
/*                                         */
/*          For Support mail to :          */
/*                                         */
/*    RetR-Support@amiga.prima.ruhr.de     */
/*                                         */
/*******************************************/

; $VER: RetR V1.1 (16.01.1997) by Carsten Becker

PARSE ARG user
IF ~Open(config,'UULib:Config','R')
 THEN IF ~Open(config,'S:UUConfig','R')
       THEN DO
             Say 'The Config-File "UULib:Config" or "S:UUConfig" could not be opened !'
             Exit 10
            END
defuser  = '*'
domain   = '*'
host     = '*'
retrdir  = '*'
timezone = '*'
sendmail = '*'
DO WHILE ~Eof(config)
 line=ReadLn(config)
 line=Upper(line)

 IF Left(line,8,'*') = 'USERNAME'
  THEN DO
        defuser = Right(line,Length(line)-8)
        defuser = Strip(defuser)
        IF Left(defuser,1) = ':'
         THEN defuser = Right(defuser,Length(defuser)-1)
        defuser = Strip(defuser)
        defuser = Strip(defuser,'B','"')
        defuser = Strip(defuser)
        IF Length(defuser) = 0
         THEN defuser = '*'
       END

 IF Left(line,10,'*') = 'DOMAINNAME'
  THEN DO
        domain = Right(line,Length(line)-10)
        domain = Strip(domain)
        IF Left(domain,1) = ':'
         THEN domain = Right(domain,Length(domain)-1)
        domain = Strip(domain)
        domain = Strip(domain,'B','"')
        domain = Strip(domain)
        IF Length(domain) = 0
         THEN domain = '*'
       END

 IF Left(line,8,'*') = 'HOSTNAME'
  THEN DO
        host = Right(line,Length(line)-8)
        host = Strip(host)
        IF Left(host,1) = ':'
         THEN host = Right(host,Length(host)-1)
        host = Strip(host)
        host = Strip(host,'B','"')
        host = Strip(host)
        IF Length(host) = 0
         THEN host = '*'
       END

 IF Left(line,8,'*') = 'TIMEZONE'
  THEN DO
        timezone = Right(line,Length(line)-8)
        timezone = Strip(timezone)
        IF Left(timezone,1) = ':'
         THEN timezone = Right(timezone,Length(timezone)-1)
        timezone = Strip(timezone)
        timezone = Strip(timezone,'B','"')
        timezone = Strip(timezone)
        IF Length(timezone) = 0
         THEN timezone = '*'
       END

 IF Left(line,8,'*') = 'SENDMAIL'
  THEN DO
        sendmail = Right(line,Length(line)-8)
        sendmail = Strip(sendmail)
        IF Left(sendmail,1) = ':'
         THEN sendmail = Right(sendmail,Length(sendmail)-1)
        sendmail = Strip(sendmail)
        sendmail = Strip(sendmail,'B','"')
        sendmail = Strip(sendmail)
        IF Length(sendmail) = 0
         THEN sendmail = '*'
       END

 IF Left(line,7,'*') = 'RETRDIR'
  THEN DO
        retrdir = Right(line,Length(line)-7)
        retrdir = Strip(retrdir)
        IF Left(retrdir,1) = ':'
         THEN retrdir = Right(retrdir,Length(retrdir)-1)
        retrdir = Strip(retrdir)
        retrdir = Strip(retrdir,'B','"')
        retrdir = Strip(retrdir)
        IF Length(retrdir) = 0
         THEN retrdir = '*'
       END

END
Close(config)

user = Strip(user)
IF Length(user) = 0
 THEN user = defuser
IF host ~= '*'
 THEN domain = host
IF retrdir = '*'
 THEN retrdir = 'AutoMail:'
IF timezone = '*'
 THEN timezone = '+0100'
IF sendmail = '*'
 THEN sendmail = 'UUCP:C/SendMail >NIL:'
IF (Right(retrdir,1) ~= ':') & (Right(retrdir,1) ~= '/')
 THEN retrdir = retrdir + '/'
IF user = '*'
 THEN DO
       Say 'You MUST define a user name, either by giving RetR the user name as a'
       Say 'parameter or by defining the "UserName" variable in "UULib:Config"'
       Say 'or in "S:UUConfig" !'
       Exit 10
      END
IF domain = '*'
 THEN DO
       Say 'You MUST define a domain name in "UULib:Config" or in "S:UUConfig" by'
       Say 'defining the "DomainName" or - even better - the "HostName" variable !'
       Exit 10
      END
tempdir = 'T:'
true    = 1
false   = 0
msglen  = 0

IF ~Open(msgfile,retrdir||'RetR.'||user||'.Msg','R')
 THEN DO
       Say 'A Messagefile "'||retrdir||'RetR.'||user||'.Msg" is required'
       Say 'to send Receipt Requests for User "'||user||'" !!!'
       Exit 10
      END
Close(msgfile)

from    = '*'       /* Mail-Adr from From: Header */
rname   = '*'       /* RealName from From: Header */
to      = '*'       /* To:                 Header */
subject = '*'       /* Subject:            Header */
msgid   = '*'       /* Message-ID:         Header */
return  = '*'       /* Return-Receipt-To:  Header */
date    = '*'       /* Date:               Header */
line    = '*'
DO WHILE (Length(line) ~= 0) & ~Eof(stdin)
 line=ReadLn(stdin)
 msglen = msglen + Length(line) + 1

 IF Upper(Left(line,5,'*')) = 'FROM:'
  THEN DO
        fline = Right(line,Length(line)-5)
        fline = Strip(fline)

        fline = Translate(fline,'(','<')         /* Switch '<>' to '()' */
        fline = Translate(fline,')','>')

        stelle1 = Pos('"',fline,1)               /* Switch '""' to '()' */
        DO WHILE stelle1 ~= 0
         stelle2 = Pos('"',fline,stelle1+1)
         IF stelle2 ~= 0
          THEN DO
                fline = Left(fline,stelle1-1)||'('||SubStr(fline,stelle1+1,stelle2-stelle1-1)||')'||Right(fline,Length(fline)-stelle2)
                stelle1 = Pos('"',fline,1)
               END
          ELSE stelle1 = 0
        END

        stelle1 = Pos('(',fline,1)
        IF stelle1 ~= 0
         THEN DO
               stelle2 = Pos(')',fline,stelle1+1)
               IF stelle2 ~= 0
                THEN DO
                      str1 = SubStr(fline,stelle1+1,stelle2-stelle1-1)
                      str2 = DelStr(fline,stelle1,stelle2-stelle1+1)
                      str1 = Strip(str1)
                      str2 = Strip(str2)
                      bra = Left(str2,1,'*')
                      ket = Right(str2,1,'*')
                      IF (bra = '(') & (ket = ')')
                       THEN str2 = SubStr(str2,2,Length(str2)-2)
                      IF (bra = '<') & (ket = '>')
                       THEN str2 = SubStr(str2,2,Length(str2)-2)
                      IF (bra = '"') & (ket = '"')
                       THEN str2 = SubStr(str2,2,Length(str2)-2)
                      IF Pos('@',str1,1) = 0
                       THEN DO
                             from  = str2
                             rname = str1
                            END
                       ELSE DO
                             from  = str1
                             rname = str2
                            END
                      fline = '*'
                     END
              END  /* '(' and ')' checking */

        IF (Length(rname) = 0) | (rname = '*')
         THEN rname = 'Unknown'
       END  /* From: Header */

 IF Upper(Left(line,3,'*')) = 'TO:'
  THEN DO
        tline = Right(line,Length(line)-3)
        tline = Strip(tline)
        DO WHILE Right(tline,1) = ','
         nextline = ReadLn(stdin)
         msglen = msglen + Length(nextline) + 1
         nextline = Strip(nextline)
         tline = tline||nextline
        END

        stelle = Pos(domain,tline,1)
        IF stelle = 0
         THEN to = tline
         ELSE DO
               stelle2 = stelle+Length(domain)-1
               stelle1 = 0
               stelle  = Pos(' ',tline,1)
               DO WHILE (stelle ~= 0) & (stelle < stelle2)
                stelle1 = stelle
                stelle = Pos(' ',tline,stelle1+1)
               END
               stelle1 = stelle1 + 1
               tline = SubStr(tline,stelle1,stelle2-stelle1+1,' ')

               stelle = LastPos(',',tline)
               IF stelle ~= 0
                THEN tline = Right(tline,Length(tline)-stelle)
               tline = Strip(tline)

               tline = Translate(tline,'(','<')
               tline = Translate(tline,')','>')

               tline = Strip(tline)
               tline = Strip(tline,'B','"')
               tline = Strip(tline)
               tline = Strip(tline,'B','(')
               tline = Strip(tline)
               tline = Strip(tline,'B',')')
               to = Strip(tline)
              END
        IF Length(to) = 0
         THEN to = 'Unknown'
       END  /* To: Header */

 IF Upper(Left(line,8,'*')) = 'SUBJECT:'
  THEN DO
        sline = Right(line,Length(line)-8)
        sline = Strip(sline)
        IF Length(sline) = 0
         THEN subject = '<None>'
         ELSE subject = sline
       END  /* Subject: Header */

 IF Upper(Left(line,11,'*')) = 'MESSAGE-ID:'
  THEN DO
        mline = Right(line,Length(line)-11)
        mline = Strip(mline)
        mline = Strip(mline,'B','<')
        mline = Strip(mline)
        mline = Strip(mline,'B','>')
        msgid = Strip(mline)
        IF Length(msgid) = 0
         THEN msgid = ' '
       END  /* Message-ID: Header */

 IF Upper(Left(line,18,'*')) = 'RETURN-RECEIPT-TO:'
  THEN DO
        rline = Right(line,Length(line)-18)
        rline = Strip(rline)
        DO WHILE Right(rline,1) = ','
         nextline = ReadLn(stdin)
         msglen = msglen + Length(nextline) + 1
         nextline = Strip(nextline)
         rline = rline||nextline
        END

        stelle = Pos('@',rline,1)
        IF stelle = 0
         THEN return = 'Empty'
         ELSE DO
               stelle2 = Pos(' ',rline,stelle)
               IF stelle2 = 0
                THEN stelle2 = Length(rline)
                ELSE stelle2 = stelle2 - 1
               stelle1 = 0
               stelle = Pos(' ',rline,1)
               DO WHILE (stelle ~= 0) & (stelle < stelle2)
                stelle1 = stelle
                stelle = Pos(' ',rline,stelle1+1)
               END
               stelle1 = stelle1 + 1
               rline = SubStr(rline,stelle1,stelle2-stelle1+1,' ')

               rline = Translate(rline,'(','<')
               rline = Translate(rline,')','>')

               rline = Strip(rline)
               rline = Strip(rline,'B','"')
               rline = Strip(rline)
               rline = Strip(rline,'B','(')
               rline = Strip(rline)
               rline = Strip(rline,'B',')')
               rline = Strip(rline)
               IF Length(rline) = 0
                THEN return = 'Empty'
                ELSE return = rline
              END
       END  /* Return-Receipt-To: Header */

 IF Upper(Left(line,5,'*')) = 'DATE:'
  THEN DO
        dline = Right(line,Length(line)-5)
        dline = Strip(dline)
        IF Length(dline) = 0
         THEN date = ' '
         ELSE date = dline
       END  /* Date: Header */

END  /* Header durchsuchen */

DO WHILE ~Eof(stdin)
 dummy=ReadLn(stdin)
 msglen = msglen + Length(dummy) + 1
END
msglen = msglen - 1

IF (return = 'Empty') & (from ~= '*')
 THEN return = from

IF return ~= '*'
 THEN DO
       IF ~Open(logfile,retrdir||'RetR.'||user||'.Log','R')
        THEN DO
              Open(logfile,retrdir||'RetR.'||user||'.Log','W')
              Close(logfile)
              exists = false
             END
        ELSE DO
              exists = false
              DO WHILE ~Eof(logfile)
               dummy=ReadLn(logfile)
               IF Pos(Left(msgid,40,' '),dummy,1) ~= 0
                THEN DO
                      exists = true
                      Leave
                     END
              END
              Close(logfile)
             END
       IF ~exists
        THEN DO
              Open(tempfile,tempdir||'RetR.'||user||'.Tmp','W')
              Open(msgfile,retrdir||'RetR.'||user||'.Msg','R')
              WriteLn(tempfile,'X-Mailer: RetR V1.1 (16.01.1997) by Carsten Becker')
              DO WHILE ~Eof(msgfile)
               line=ReadLn(msgfile)
               DO WHILE (Upper(Left(line,9)) = 'X-MAILER:') & ~Eof(msgfile)
                line=ReadLn(msgfile)
               END
               DO WHILE Length(line) > 0
                stelle = Pos('%',line)
                IF stelle = 0
                 THEN DO
                       WriteCh(tempfile,line)
                       line = ''
                      END
                 ELSE DO
                       WriteCh(tempfile,Left(line,stelle-1))
                       line = Right(line,Length(line)-stelle)
                       symb = Left(line,1)
                       found = false
                       IF symb = 'e'
                        THEN DO
                              WriteCh(tempfile,from)
                              found = true
                             END
                       IF symb = 'r'
                        THEN DO
                              WriteCh(tempfile,rname)
                              found = true
                             END
                       IF symb = 't'
                        THEN DO
                              WriteCh(tempfile,to)
                              found = true
                             END
                       IF symb = 's'
                        THEN DO
                              WriteCh(tempfile,subject)
                              found = true
                             END
                       IF symb = 'm'
                        THEN DO
                              WriteCh(tempfile,msgid)
                              found = true
                             END
                       IF symb = 'R'
                        THEN DO
                              WriteCh(tempfile,return)
                              found = true
                             END
                       IF symb = 'd'
                        THEN DO
                              WriteCh(tempfile,date)
                              found = true
                             END
                       IF symb = 'D'
                        THEN DO
                              WriteCh(tempfile,Left(Date('W'),3)||', '||Date('N')||' '||Time('N')||' '||timezone)
                              found = true
                             END
                       IF symb = 'l'
                        THEN DO
                              WriteCh(tempfile,msglen)
                              found = true
                             END
                       IF symb = '%'
                        THEN DO
                              WriteCh(tempfile,'%')
                              found = true
                             END
                       IF ~found
                        THEN WriteCh(tempfile,'%'||symb)
                       line = Right(line,Length(line)-1)
                      END
               END
               WriteCh(tempfile,X2C('0a'))
              END  /* Eof msgfile */
              Close(msgfile)
              Close(tempfile)

              ADDRESS COMMAND sendmail||' <'||tempdir||'RetR.'||user||'.Tmp'

              logline = Date('E')||' '||Time('N')
              logline = logline||'  '||Left(msgid,40,' ')
              logline = logline||' '||return||' ('||rname||')'
              Open(logfile,retrdir||'RetR.'||user||'.Log','A')
              DO WHILE ~Eof(logfile)
               dummy=ReadLn(logfile)
              END
              WriteLn(logfile,logline)
              Close(logfile)

             END  /* Send Return Receipt */

      END  /* Return Receipt */

Exit 0