/* Checked by PJM 01-Aug-2003 for conformance to the new filter     */
/* rules in Weasel version 1.645 and later.  As far as I can tell,  */
/* this script needs no change to conform to the new filtering      */
/* rules.  Be aware, however, that I am not the original author of  */
/* this filter.  It should probably not be trusted until Martin     */
/* Kiewitz has checked it.                                          */

/* Actual filter Script to check files and communicate with Clients */
/* Written by Kiewitz in year 2002 */
/* INCLUDE filewait */
/* INCLUDE email-code */
/* INCLUDE error-handler */

call RxFuncAdd "SysLoadFuncs", "RexxUtil", "SysLoadFuncs"
call SysLoadFuncs
call RxFuncAdd "XtraLoadFuncs", "XtraRexx", "XtraLoadFuncs"
call XtraLoadFuncs

signal on syntax name ErrorHandler

Parse Source MyOS MyInterpreter MyName
DYNFILT_BaseDirectory = FileSpec("drive",MyName)||FileSpec("path",MyName)
DYNFILT_SendMailDir   = DYNFILT_BaseDirectory"SendMail\"
DYNFILT_LogFile       = DYNFILT_BaseDirectory"FTP\Filtering.log"

ConfigFile = DYNFILT_BaseDirectory"config"
Parse Value LineIn(ConfigFile) With DYNFILT_MailRoot "#"
DYNFILT_MailRoot          = Strip(DYNFILT_MailRoot, Trailing)
Parse Value LineIn(ConfigFile) With DYNFILT_EmailMine "#"
DYNFILT_EmailMine         = Strip(DYNFILT_EmailMine, Trailing)
Parse Value LineIn(ConfigFile) With DYNFILT_EmailAdmin "#"
DYNFILT_EmailAdmin        = Strip(DYNFILT_EmailAdmin, Trailing)
Parse Value LineIn(ConfigFile) With DYNFILT_SendMailDuration "#"

/* Duration in seconds */
DYNFILT_SendMailDuration  = Strip(DYNFILT_SendMailDuration, Trailing)
Parse Value LineIn(ConfigFile) With DYNFILT_ForceMailDuration "#"
DYNFILT_ForceMailDuration = Strip(DYNFILT_ForceMailDuration, Trailing)
call Stream ConfigFile, "c", "close"

/* Logic: 1) Waits for *.job in Jobs-directory                     */
/*        2) Check .dta-contents                                   */
/*        3) Allow attachment    -> Rename .job to .ok, kill .dta  */
/*           Disallow attachment -> Kills .job, Rename .dta to FTP */
/*        4) Send out informational e-mails to filtered user and   */
/*           administrator                                         */

/* Normalize Admin's E-Mail */
DYNFILT_EmailAdmin = EMAIL_NormalizeEmail(DYNFILT_EmailAdmin)

DYNFILT_Sender         = ""
DYNFILT_Receiver       = ""
DYNFILT_Subject        = ""
DYNFILT_JobName        = ""
DYNFILT_SendMailTimer  = 0
DYNFILT_ForceMailTimer = 0

say ""
say "Dynamic-Filter v0.2 - (c) Copyright 2002 by Martin Kiewitz - FREE FOR ANY USE"

ShowWaitingMsg         = 1

Do Forever
   If ShowWaitingMsg Then Do
      call CharOut, "ù Waiting for action..."
      ShowWaitingMsg = 0
   End

   call SysFileTree "Jobs\*.job", "Jobs.", "FO"
   If Jobs.0>0 Then Do
      say "ok"; ShowWaitingMsg = 1
      say "ù Processing jobs..."

      CurJob = 1
      Do Jobs.0
         call DYNFILT_ProcessJob Jobs.CurJob
         CurJob = CurJob+1
      End
   End

   call SysSleep 1
   If DYNFILT_SendMailTimer>0 Then Do
      /* Process Timers */
      DYNFILT_SendMailTimer  = DYNFILT_SendMailTimer-1
      DYNFILT_ForceMailTimer = DYNFILT_ForceMailTimer-1
      If DYNFILT_SendMailTimer=0 | DYNFILT_ForceMailTimer=0 Then Do
         say "ok"; ShowWaitingMsg = 1
         say "ù Sending outbound mail..."
         call DYNFILT_ProcessMailToSend
         DYNFILT_SendMailTimer = 0; DYNFILT_ForceMailTimer = 0
      End
   End
End
exit

DYNFILT_ProcessJob:
   Parse Arg JobInfoFile

   JobBaseFile = Left(JobInfoFile,Length(JobInfoFile)-4)
   JobMainFile = JobBaseFile".job"
   JobDataFile = JobBaseFile".dta"

   /* Read In Job-Base Information */
   call FILEWAIT_ForReadFile JobMainFile
   DYNFILT_Sender   = LineIn(JobMainFile)
   DYNFILT_Receiver = LineIn(JobMainFile)
   DYNFILT_Subject  = LineIn(JobMainFile)
   DYNFILT_JobName  = LineIn(JobMainFile)
   call FILEWAIT_Close JobMainFile

   call DYNFILT_ToLog DYNFILT_JobName" ("EMAIL_ExtractEmail(DYNFILT_Sender)" to "EMAIL_ExtractEmailList(DYNFILT_Receiver)")..."

   /* First try to detect file via Signatures */
   CheckType = DYNFILT_CheckDataFile(JobDataFile)
   If Length(CheckType)>0 Then Do
      call DYNFILT_ToLogCR ""
      call DYNFILT_ToLogCR " ÀÄ> "CheckType" detected and filtered!"
      call DYNFILT_DisallowJob JobBaseFile, CheckType
      return
   End

   /* Finally check for unwanted file-extensions */
   CheckType = DYNFILT_CheckFileExtension(DYNFILT_JobName)
   If Length(CheckType)>0 Then Do
      call DYNFILT_ToLogCR ""
      call DYNFILT_ToLogCR " ÀÄ> "CheckType" detected and filtered!"
      call DYNFILT_DisallowJob JobBaseFile, CheckType
      return
   End
   call DYNFILT_ToLogCR "fine"
   call DYNFILT_AllowJob JobBaseFile
   return

DYNFILT_CheckFileExtension:
   Procedure
   Parse Arg ContentName
   TempPos = LastPos(".", ContentName)
   FileExtension = Translate(SubStr(ContentName, TempPos+1))
   Select
     When FileExtension="EXE"  Then return "Executeable"
     When FileExtension="COM"  Then return "Executeable"
     When FileExtension="VBS"  Then return "Visual Virus Script"
     When FileExtension="WSH"  Then return "Visual Virus Script"
     When FileExtension="SHS"  Then return "Scrap File (be careful!)"
     When FileExtension="BAT"  Then return "Batch script"
     When FileExtension="CMD"  Then return "Command script"
     When FileExtension="JS"   Then return "Java Script"
     When FileExtension="PIF"  Then return "Windows PIF"
     When FileExtension="LNK"  Then return "Windows Link (be careful!)"
     When FileExtension="SCR"  Then return "Windows Screensaver (be careful!)"
     When FileExtension="MPG"  Then return "MPEG-Multimedia"
     When FileExtension="MPEG" Then return "MPEG-Multimedia"
     When FileExtension="MPE"  Then return "MPEG-Multimedia"
     When FileExtension="AVI"  Then return "AVI-Multimedia"
     When FileExtension="PPS"  Then return "Powerpoint"
     When FileExtension="PPT"  Then return "Powerpoint"
     When FileExtension="MP3"  Then return "MP3-Multimedia"
     When FileExtension="WAV"  Then return "WAVE-Multimedia"
     When FileExtension="MOV"  Then return "Quicktime-Multimedia"
     Otherwise Nop
   End
   return ""

DYNFILT_CheckDataFile:
   Procedure
   Parse Arg JobDataFile

   /* Read in check-buffer */
   CheckHandle = FileOpen(JobDataFile)
   CheckData   = FileRead(CheckHandle, 4096)
   call FileClose CheckHandle

   /* Now check that buffer for known signatures */
   Header2B = Left(CheckData,2)

   /* === EXECUTEABLES === */
   If Header2B="MZ" | Header2B="ZM" Then
      If FilterGetWord(9)<4096 Then
         If FilterGetWord(11)<=FilterGetWord(13) Then
            return "MZ-EXE"

   If Header2B="LE" Then
      If FilterGetByte(3)<50 Then
         If FilterGetByte(4)<100 Then
            If FilterGetByte(85)<20 Then
               return "LE-EXE"

   If Header2B="NE" Then
      If FilterGetByte(3)<50 Then
         If FilterGetByte(4)<100 Then
            If FilterGetWord(35)<4096 Then
               return "NE-EXE"

   /* === ARCHIVES === */
   If Header2B="PK" Then
      If FilterGetWord(5)<64 Then Do
         TempBuffer = SubStr(CheckData,3,2)
         If TempBuffer=D2C(1)||D2C(2) Then
            return "ZIP-Archive"
         If TempBuffer=D2C(3)||D2C(4) Then
            return "ZIP-Archive"
         If TempBuffer=D2C(5)||D2C(6) Then
            return "ZIP-Archive"
      End

   If Header2B="Ra" Then
      If SubStr(CheckData,3,5)="r!"D2C(26)||D2C(7)||D2C(0) Then
         return "RAR-Archive"

   If Header2B=D2C(96)||D2C(234) Then
      If FilterGetWord(3)<8192 Then
         If FilterGetByte(6)<64 Then
            If FilterGetByte(7)<64 Then
               If FilterGetByte(8)<32 Then
                  return "ARJ-Archive"

   If SubStr(CheckData,3,3)="-lh" Then
      If FilterGetByte(6)>47 | FilterGetByte(6)<54 Then
         If SubStr(CheckData,7,1)="-" Then
            return "LZH-Archive"

   If FilterGetByte(1)=26 Then
      If FilterGetByte(2)<10 Then
         return "ARC-Archive"

   /* Multimedia File Types */
   If Header2B=D2C(0)||D2C(0) Then Do
      If FilterGetByte(3)=1 Then
         If FilterGetByte(4)=186 | FilterGetByte(4)=179 Then
            return "MPEG-Multimedia"
      If SubStr(CheckData,5,4)="moov" Then
         return "Quicktime-Multimedia"
   End

   If Left(CheckData,4)="RIFF" Then Do
      TempBuffer = SubStr(CheckData,9,4)
      If TempBuffer="WAVEfmt " Then
         return "WAVE-Multimedia"
      If TempBuffer="AVI LIST" Then
         return "AVI-Multimedia"
   End

   /* End here, if nothing known is found */
   return ""

FilterGetByte:
   Procedure Expose CheckData
   Parse Arg StrPos
   return c2d(SubStr(CheckData,StrPos,1))

FilterGetWord:
   Procedure Expose CheckData
   Parse Arg StrPos
   return c2d(Reverse(SubStr(CheckData,StrPos,2)))

/* Allowing a Job -> Rename .job to .ok and kill .dta */
DYNFILT_AllowJob:
   Parse Arg JobBaseFile
   call SysFileDelete JobBaseFile".dta"
   call FILEWAIT_ForReplaceFile JobBaseFile".ok", JobBaseFile".job"
   return

/* Disallowing a Job -> Kill .job and move .dta to FTP              */
/*                      Remember Job for sending notification later */
DYNFILT_DisallowJob:
   Parse Arg JobBaseFile, FilteredCause
   call SysFileDelete JobBaseFile".job"
   DYNFILT_JobName = DYNFILT_DynamicRename(JobBaseFile".dta", DYNFILT_BaseDirectory"FTP\"DYNFILT_JobName)
   /* Make Notifications to Admin & Receiver */
   call DYNFILT_MakeNotification DYNFILT_EmailAdmin, "admin.pst",    FilteredCause
   call DYNFILT_MakeNotification DYNFILT_Receiver,   "userinfo.pst", FilteredCause
   return

/* This will make a Notifications                                 */
/* It expects Destination to be in normalized E-Mail format       */
DYNFILT_MakeNotification:
   Parse Arg Destination, Template, FilteredCause
   If EMAIL_IsEmailList(Destination) Then Do
      /* Generate temp. file to send out message NOW, cause multi-receivers */
      DestFile = SysTempFileName(DYNFILT_SendMailDir"?????.tmp")
   End
    else Do
      /* Put data into SendMail directory for later processing */
      Destination = EMAIL_ExtractEmail(Destination)
      Parse Value Destination With DestName "@" DestDomain

      /* Generate a filename for that destination */
      DestDir  = DYNFILT_SendMailDir||DestDomain
      DestFile = DestDir"\"DestName
      call SysMkDir DestDir
   End

   If FILEWAIT_FileExists(DestFile)=0 Then
      call LineOut DestFile, Template
   call LineOut DestFile, DYNFILT_Sender
   call LineOut DestFile, DYNFILT_Receiver
   call LineOut DestFile, DYNFILT_Subject
   call LineOut DestFile, DYNFILT_JobName
   call LineOut DestFile, FilteredCause
   call FILEWAIT_Close DestFile

   If EMAIL_IsEmailList(Destination) Then Do
      /* Send Mail now and immediately delete Content-File */
      call DYNFILT_SendMail DYNFILT_Receiver, DestFile
      call SysFileDelete DestFile
   End
    else Do
      /* Finally set Timers for Outbound Mail */
      DYNFILT_SendMailTimer = DYNFILT_SendMailDuration
      If DYNFILT_ForceMailTimer=0 Then
         DYNFILT_ForceMailTimer = DYNFILT_ForceMailDuration
   End
   return

/* This will search and process SendMail-directory and send out */
/*  Notifications.                                              */
DYNFILT_ProcessMailToSend:
   Procedure Expose DYNFILT_SendMailDir DYNFILT_MailRoot DYNFILT_BaseDirectory DYNFILT_EmailMine DYNFILT_LogFile

   /* Look into SendMail directory for any E-Mail Domains */
   call SysFileTree DYNFILT_SendMailDir"*", "EmailDomains", "do"
   If EmailDomains.0=0 Then Leave

   CurDomain = 1
   Do Forever
      /* Search every domain directory for files */
      call SysFileTree EmailDomains.CurDomain"\*", "EmailNames", "fo"
      If EmailNames.0>0 Then Do
         EmailDomain = EmailDomains.CurDomain
         EmailDomain = SubStr(EmailDomain, LastPos("\",EmailDomains.CurDomain)+1)
         CurName = 1
         Do Forever
            EmailName    = FileSpec("name", EmailNames.CurName)
            EmailAddress = '"" <'EmailName'@'EmailDomain'>'

            /* Send E-Mail out and kill Content-File */
            call DYNFILT_SendMail EmailAddress, EmailNames.CurName
            call SysFileDelete EmailNames.CurName

            CurName = CurName+1
            If CurName>EmailNames.0 Then Leave
         End
      End

      /* Kill Domain-Directory */
      call SysRmDir EmailDomains.CurDomain

      CurDomain = CurDomain+1
      If CurDomain>EmailDomains.0 Then Leave
   End
   return

DYNFILT_SendMail:
   Procedure Expose DYNFILT_MailRoot DYNFILT_BaseDirectory DYNFILT_EmailMine DYNFILT_LogFile
   Parse Arg MailReceivers, ContentListFile

   ReceiverEmailList = EMAIL_ExtractEmailList(MailReceivers)

   call DYNFILT_ToLog "Sending mail to "ReceiverEmailList"..."

   /* Read in ContentListFile */
   TemplateFile  = LineIn(ContentListFile)
   TotalContents = 1
   Do Forever
      ContentSender.TotalContents   = LineIn(ContentListFile)
      If Stream(ContentListFile)\="READY" Then Leave
      ContentReceiver.TotalContents = LineIn(ContentListFile)
      ContentSubject.TotalContents  = LineIn(ContentListFile)
      ContentName.TotalContents     = LineIn(ContentListFile)
      ContentFiltered.TotalContents = LineIn(ContentListFile)
      TotalContents = TotalContents+1
   End
   TotalContents = TotalContents-1
   call FILEWAIT_Close ContentListFile

   TemplateFile = DYNFILT_BaseDirectory"Templates\"TemplateFile
   MsgFile = SysTempFileName(DYNFILT_MailRoot"forward\?????.tmp")
   call CharOut MsgFile, 'V000'D2C(0)||D2C(0)||D2C(0)||D2C(0)||D2C(0)||D2C(1)
   call CharOut MsgFile, DYNFILT_EmailMine
   call CharOut MsgFile, "("ReceiverEmailList")"
   call LineOut MsgFile, "From: "DYNFILT_EmailMine
   call LineOut MsgFile, "To: "MailReceivers

   Do Forever
      CurLine = LineIn(TemplateFile)
      If Left(CurLine,10)="$FILTERED_" | Stream(TemplateFile)\="READY" Then Leave
      call LineOut MsgFile, CurLine
   End

   CurContent = 1
   Select
     When CurLine="$FILTERED_ADMININFO" Then Do
      Do Forever
         If Length(ContentSubject.CurContent)>0 Then Do
            Sender = EMAIL_ExtractEmail(ContentSender.CurContent)
            Receiver = EMAIL_ExtractEmailList(ContentReceiver.CurContent)
            call LineOut MsgFile, '"'ContentSubject.CurContent'" ('Sender') -> ('Receiver')'
            call LineOut MsgFile, ' - 'ContentName.CurContent' ('ContentFiltered.CurContent')'
            /* Now scan through Contents searching the same subject to combine */
            ScanContent = CurContent
            Do Forever
               ScanContent = ScanContent+1
               If ScanContent>TotalContents Then Leave
               If ContentSubject.CurContent=ContentSubject.ScanContent Then
                  If ContentSender.CurContent=ContentSender.ScanContent Then
                     If ContentReceiver.CurContent=ContentReceiver.ScanContent Then Do
                        call LineOut MsgFile, ' - 'ContentName.ScanContent' ('ContentFiltered.ScanContent')'
                        ContentSubject.ScanContent = ""
                     End
            End
            call LineOut MsgFile, ''
         End
         CurContent = CurContent+1
         If CurContent>TotalContents Then Leave
      End
     End
     When CurLine="$FILTERED_USERINFO" Then Do
      Do Forever
         If Length(ContentSubject.CurContent)>0 Then Do
            Sender = EMAIL_ExtractEmail(ContentSender.CurContent)
            Receiver = EMAIL_ExtractEmail(ContentReceiver.CurContent)
            call LineOut MsgFile, '"'ContentSubject.CurContent'" ('Sender')'
            call LineOut MsgFile, ' - 'ContentName.CurContent
            /* Now scan through Contents searching the same subject to combine */
            ScanContent = CurContent
            Do Forever
               ScanContent = ScanContent+1
               If ScanContent>TotalContents Then Leave
               If ContentSubject.CurContent=ContentSubject.ScanContent Then
                  If ContentSender.CurContent=ContentSender.ScanContent Then
                     If ContentReceiver.CurContent=ContentReceiver.ScanContent Then Do
                        call LineOut MsgFile, ' - 'ContentName.ScanContent
                        ContentSubject.ScanContent = ""
                     End
            End
            call LineOut MsgFile, ''
         End
         CurContent = CurContent+1
         If CurContent>TotalContents Then Leave
      End
     End
     Otherwise Nop
   End

   Do Forever
      If Stream(TemplateFile)\="READY" Then Leave
      CurLine = LineIn(TemplateFile)
      call LineOut MsgFile, CurLine
   End
   call FILEWAIT_Close TemplateFile
   call FILEWAIT_Close MsgFile

   call DYNFILT_ToLogCR "ok"

   /* Rename MsgFile to .fwd, so it will get processed and send by Weasel */
   FinalMsgFile = Left(MsgFile,Length(MsgFile)-4)".fwd"
   call FILEWAIT_ForReplaceFile FinalMsgFile, MsgFile
   return

/* ========================================================================= */

DYNFILT_DynamicRename:
   Procedure
   Parse Arg CurFile, NewFile
   NumExtension = ""; CurNumber = 0
   NewFile      = SubStr(NewFile,3) /* Cut the drive-letter from NewFile */

   Do Forever
      If Stream(NewFile||NumExtension,'c','query exists')='' Then Do
         '@move 'CurFile' "'NewFile||NumExtension'"'
         If Stream(CurFile,'c','query exists')='' Then Leave
      End
      CurNumber    = CurNumber+1
      NumExtension = "."CurNumber
   End
   return FileSpec("name", NewFile||NumExtension)

DYNFILT_ToLog:
   Procedure Expose DYNFILT_LogFile
   Parse Arg LogLine
   LogLine = Left(Time(),5)" "LogLine
   call CharOut ,LogLine
   call CharOut DYNFILT_LogFile, LogLine
   return

DYNFILT_ToLogCR:
   Procedure Expose DYNFILT_LogFile
   Parse Arg LogLine
   call LineOut ,LogLine
   call LineOut DYNFILT_LogFile, LogLine
   call Stream DYNFILT_LogFile, "c", "close"
   return

/* ========================================================================= */
/*  INCLUDEd C:\Rexx\filewait */
/* ========================================================================= */

/* ------------------------------------------------------------------------- */
/*  FILE-WAIT Library - by Kiewitz in 2002                                   */
/* ------------------------------------------------------------------------- */

/* All of these routines will wait a maximum of 60 seconds for getting xs */
/*  Timeout will be 300 (60*5) */

/* Will wait for read access. Will return false, if file is not found or */
/*  killed during trying for access */
FILEWAIT_ForReadFile:
   Procedure
   Parse Arg Filename
   Do 300
      If Length(Stream(Filename,"c", "query exists"))=0 Then return 0
      If Stream(Filename,"c","open read")="READY:" Then return 1
      call XtraSleep 200
   End
   return 0

/* Will wait for read access on the specified file even if the file is not */
/*  found. If timeout -> Error-Message and script abort */
FILEWAIT_ForMustReadFile:
   Procedure
   Parse Arg Filename
   Do 300
      If Stream(Filename,"c","open read")="READY:" Then return 1
      call XtraSleep 200
   End
   say "Rexx: No MustRead-Access on file "Filename
   exit

/* Will wait for write access on the specified file. */
/*  If timeout -> Error-Message and Exit */
FILEWAIT_ForWriteFile:
   Procedure
   Parse Arg Filename
   Do 300
      If Stream(Filename,"c","open write")="READY:" Then return 1
      call XtraSleep 200
   End
   say "Rexx: No Write-Access on file "Filename
   exit

/* Will wait for read/write access on the specified file. */
/*  If timeout -> Error-Message and Exit */
FILEWAIT_ForReadWriteFile:
   Procedure
   Parse Arg Filename
   Do 300
      If Stream(Filename,"c","open")="READY:" Then return 1
      call XtraSleep 200
   End
   say "Rexx: No ReadWrite-Access on file "Filename
   exit

/* Will wait for killing specified file. */
/*  If timeout -> Error-Message and Exit */
FILEWAIT_ForKillFile:
   Procedure
   Parse Arg Filename
   Do 300
      rc = SysFileDelete(Filename)
      If rc\=5 & rc\=32 Then return 1
      call XtraSleep 200
   End
   say "Rexx: Kill denied on file "Filename
   exit

/* Will wait for killing and replacing specified file. */
/*  If timeout -> Error-Message from FILEWAIT_ForKillFile and Exit */
FILEWAIT_ForReplaceFile:
   Procedure
   Parse Arg OrgFile, ReplaceFile
   call FILEWAIT_ForKillFile OrgFile
   '@ren 'ReplaceFile' 'FileSpec("name",OrgFile)
   return 1

FILEWAIT_Close:
   Procedure
   Parse Arg Filename
   call Stream Filename, "c", "close"
   return

FILEWAIT_FileExists:
   Procedure
   Parse Arg Filename
   if length(stream(Filename,"c","query exists"))>0 Then return 1
   return 0

FILEWAIT_Seek:
   Procedure
   Parse Arg Filename, Offset
   call Stream Filename,"c","seek ="Offset
   return

FILEWAIT_GetSeek:
   Procedure
   Parse Arg Filename
   return Stream(Filename,"c","seek")

FILEWAIT_GetSize:
   Procedure
   Parse Arg Filename
   return Stream(Filename,"c","query size")

/* ========================================================================= */
/*  INCLUDEd C:\Rexx\email-code */
/* ========================================================================= */

/* ------------------------------------------------------------------------- */
/*  E-Mail Library - by Kiewitz in 2002                                      */
/* ------------------------------------------------------------------------- */

EMAIL_NormalizeEmail:
   Procedure
   Parse Arg EmailString

   EmailName   = ""; Email = ""
   If Left(EmailString,1)='"' Then Do
      Parse Value EmailString With '"' EmailName '"' EmailString
      EmailString = Strip(EmailString)
   End

   TmpPos = Pos('<', EmailString)
   If TmpPos>0 Then Do
      If TmpPos>1 Then Do
         EmailName   = Strip(Left(EmailString,TmpPos-1))
         EmailString = SubStr(EmailString,TmpPos)
      End
      Parse Value EmailString With "<" Email ">"
   End
    else Email = EmailString
   If Length(Email)=0 Then return ""
   return '"'EmailName'" <'Email'>'

EMAIL_NormalizeEmailList:
   Procedure
   Parse Arg EmailString

   EmailList = ""
   Do Forever
      TmpPos = 1
      If Left(EmailString,1)='"' Then TmpPos = Pos('"',EmailString,2)+1
      TmpPos2 = Pos(",",EmailString,TmpPos)
      If TmpPos2=0 Then TmpPos2 = Length(EmailString)+1
      Email = Left(EmailString,TmpPos2-1)
      EmailString = Strip(SubStr(EmailString,TmpPos2+1),Leading)

      Email = EMAIL_NormalizeEmail(Email)
      If Length(Email)>0 Then Do
         If Length(EmailList)>0 Then
            EmailList = EmailList", "Email
           else
            EmailList = Email
      End
      if Length(EmailString)=0 Then Leave
   End
   return EmailList

EMAIL_IsEmailList:
   Procedure
   Parse Arg EmailString

   TmpPos = Pos('"',EmailString,2)+1
   TmpPos = Pos(",",EmailString,TmpPos)
   If TmpPos>0 Then return 1
   return 0

EMAIL_ExtractEmail:
   Procedure
   Parse Arg EmailString
   Parse Value EmailString With '"' '"' '<' Email '>'
   return Email

EMAIL_ExtractEmailList:
   Procedure
   Parse Arg EmailString
   EmailList = ""
   Do Forever
      TmpPos = Pos('"',EmailString,2)+1
      TmpPos = Pos(",",EmailString,TmpPos)
      If TmpPos=0 Then Leave
      EmailList   = EmailList||EMAIL_ExtractEmail(Left(EmailString,TmpPos-1))","
      EmailString = SubStr(EmailString,TmpPos+1)
   End
   EmailList = EmailList||EMAIL_ExtractEmail(EmailString)
   return EmailList

/* E-Mail Header Read Routines */

EMAIL_InitRegionRead:
   Procedure Expose EMAIL_RegionLine EMAIL_Region EMAIL_RegionData EMAIL_ItemName EMAIL_ItemData
   EMAIL_RegionLine = "first"
   EMAIL_Region     = ""; EMAIL_RegionData = ""
   EMAIL_ItemName   = ""; EMAIL_ItemData   = ""
   return

EMAIL_ReadRegion:
   Procedure Expose EMAIL_RegionLine EMAIL_Region EMAIL_RegionData
   Parse Arg MsgFile
   /* Read new Line, if no previous line available */
   If EMAIL_RegionLine="first" Then EMAIL_RegionLine = EMAIL_LineIn(MsgFile)
   /* End of Header/File ? */
   If Length(EMAIL_RegionLine)=0 Then Do
      EMAIL_Region     = ""
      EMAIL_RegionData = ""
      return 0
   End
   /* Extract Region-Name */
   Parse Value EMAIL_RegionLine With EMAIL_Region ": " EMAIL_RegionData
   EMAIL_Region = Strip(Translate(EMAIL_Region))

   Do Forever
      EMAIL_RegionLine = EMAIL_LineIn(MsgFile)
      If Length(EMAIL_RegionLine)=0 | Left(EMAIL_RegionLine,1)<>" " Then Leave
      EMAIL_RegionData = EMAIL_RegionData" "Strip(EMAIL_RegionLine)
   End
   return 1

EMAIL_LineIn:
   Procedure
   Parse Arg MsgFile
   return Translate(LineIn(MsgFile), " ", D2C(9))

EMAIL_GetItemFromRegionData:
   Procedure Expose EMAIL_Region EMAIL_RegionData EMAIL_ItemName EMAIL_ItemData

   If Length(EMAIL_ItemName)=0 Then Do
      /* First access */
      EMAIL_ItemName = EMAIL_Region
      Parse Value EMAIL_RegionData With EMAIL_ItemData ";" EMAIL_RegionData
      EMAIL_ItemData = Strip(EMAIL_ItemData)
      EMAIL_RegionData = Strip(EMAIL_RegionData, Leading)
      return 1
   End

   TempPos = Pos("=",EMAIL_RegionData)
   If TempPos<1 Then Do
      EMAIL_ItemName = ""; EMAIL_ItemData = ""
      return 0
   End

   Parse Value EMAIL_RegionData With EMAIL_ItemName "=" EMAIL_RegionData
   EMAIL_ItemName   = Translate(Strip(EMAIL_ItemName))
   EMAIL_RegionData = Strip(EMAIL_RegionData, Leading)
   If Left(EMAIL_RegionData,1)='"' Then
      Parse Value EMAIL_RegionData With '"' EMAIL_ItemData '"' ';' EMAIL_RegionData
    else Parse Value EMAIL_RegionData With EMAIL_ItemData ';' EMAIL_RegionData
   EMAIL_RegionData = Strip(EMAIL_RegionData, Leading)
   return 1

/* ========================================================================= */
/*  INCLUDEd C:\Rexx\error-handler */
/* ========================================================================= */

/* ------------------------------------------------------------------------- */
/*  ERROR-HANDLER Library - by Kiewitz in 2002                               */
/* ------------------------------------------------------------------------- */

/* signal on syntax name ErrorHandler */
/* signal on halt name Halt */

ErrorHandler:
   say SIGL" +++   "SourceLine(SIGL)
   say "Error "rc" at line "SIGL": "ErrorText(rc)
   say " - Please note this message and press Strg-Break"
   Do Forever
      call SysSleep 30
   End
   exit