/* Modified by PJM 02-Aug-2003 for conformance to the new filter    */
/* rules in Weasel version 1.645 and later.  As far as I can tell,  */
/* the only change that this script needed, to conform to the new   */
/* filtering rules, was a change on line 46 to the PARSE ARG        */
/* statement.  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.                                          */

/* Rexx Script to communicate with the actual filter */
/* 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 "quiet"

signal on syntax name ErrorHandler

Parse Source MyOS MyInterpreter MyName
DYNFILT_BaseDirectory = FileSpec("drive",MyName)||FileSpec("path",MyName)

say "Weasel-DF-Client - (c) Copyright 2002 by Martin Kiewitz"

/* Logic: Will analyse an e-mail and extract attachments one-by-one        */
/*         After each extraction, it will ask the Global Filter to check   */
/*         the attachment for validity. If something problematic is found, */
/*         the part is cut out of the mail. Information E-Mail(s) will be  */
/*         generated by the Global Filter, so no more action is required   */

/* WEASEL reply codes: */
/*    0 - OKAY, send message unmodified */
/*    1 - OKAY, send message, but reread receivers part */
/*    2 - IGNORE, but send OKAY to client */

/* Initialize Direct/C 6-Bit En/Decoding to MIME */
call DirectC_Set6bitTable "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"

DYNFILT_Sender   = ""
DYNFILT_Receiver = ""
DYNFILT_Subject  = ""
DYNFILT_JobName  = ""

parse arg NameFile CLIENT_MsgFile
CLIENT_MsgTemp            = Left(CLIENT_MsgFile,Length(CLIENT_MsgFile)-4)".tmp"
CLIENT_SomeContentAllowed = 0

call EMAIL_InitRegionRead
MultiPartMail     = 0
MultiPartBoundary = ""
ContentEncoding   = ""
ContentName       = ""

/* === First Analyse Header ================================================ */
Do Forever
   If EMAIL_ReadRegion(CLIENT_MsgFile)=0 Then Leave
   Select
     When EMAIL_Region="FROM"    Then DYNFILT_Sender   = EMAIL_RegionData
     When EMAIL_Region="TO"      Then DYNFILT_Receiver = EMAIL_RegionData
     When EMAIL_Region="SUBJECT" Then DYNFILT_Subject  = EMAIL_RegionData
     When EMAIL_Region="CONTENT-TYPE" Then Do
         /* Analyse Content-Type - Multi-Item Region */
         Do Forever
            If EMAIL_GetItemFromRegionData()=0 Then Leave
            Select
              When EMAIL_ItemName="CONTENT-TYPE" Then Do
               Parse Value EMAIL_ItemData With EMAIL_ItemData "/"
               EMAIL_ItemData = Translate(EMAIL_ItemData)
               If EMAIL_ItemData="MULTIPART" Then MultiPartMail = 1
              End
              When EMAIL_ItemName="BOUNDARY" Then MultiPartBoundary = "--"EMAIL_ItemData
              When EMAIL_ItemName="NAME"     Then ContentName       = EMAIL_ItemData
              Otherwise Nop
            End
         End
      End
      When EMAIL_Region="CONTENT-TRANSFER-ENCODING" Then ContentEncoding = Translate(EMAIL_RegionData)
     Otherwise Nop
   End
End
DYNFILT_Sender   = EMAIL_NormalizeEmail(DYNFILT_Sender)
DYNFILT_Receiver = EMAIL_NormalizeEmailList(DYNFILT_Receiver)

ContentBegin = FILEWAIT_GetSeek(CLIENT_MsgFile)

call CLIENT_Copy 1, ContentBegin-2
call LineOut CLIENT_MsgTemp, "X-FilteredBy: Dynamic-Filter/2 v0.1 by Kiewitz, using OS/2 Rexx"
call LineOut CLIENT_MsgTemp, ""

/* Now write the header to a log-file for debugging purposes (temporary) */
OrgMsgTemp     = CLIENT_MsgTemp
CLIENT_MsgTemp = DYNFILT_BaseDirectory"logging.txt"
call FILEWAIT_ForWriteFile CLIENT_MsgTemp
call LineOut CLIENT_MsgTemp, "===================================================[DEBUG] "Date("N")" "Time('N')
call CLIENT_Copy 1, ContentBegin-2
call FILEWAIT_Close CLIENT_MsgTemp
CLIENT_MsgTemp = OrgMsgTemp

If MultiPartMail=0 Then Do
   /* Singlepart Mail */
   If Length(ContentName)=0 Then ContentName = "NoName"
   call CharOut ,"* Got Content-Part ["ContentName"]..."
   If ContentEncoding="BASE64" Then Do
      call LineIn CLIENT_MsgFile /* Read in CR-Line */
      ContentEnd = Stream(CLIENT_MsgFile, "c", "seek")
      call CLIENT_Copy ContentBegin, ContentEnd
      call CLIENT_ProcessAttachment ContentName, ContentEnd
   End
    else Do
      call CLIENT_Copy ContentBegin, FILEWAIT_GetSize(CLIENT_MsgFile)
      CLIENT_SomeContentAllowed = 1
      say "is fine."
   End
End
  else Do /* MIME Multipart Mail */
   Do Forever /* Search for first occurance of boundary */
      ContentEnd   = Stream(CLIENT_MsgFile, "c", "seek")
      CurLine      = LineIn(CLIENT_MsgFile)
      If Left(CurLine, Length(MultiPartBoundary))=MultiPartBoundary | Stream(CLIENT_MsgFile)\="READY" Then Leave
   End
   /* Copy Message Header to New Message */
   call CLIENT_Copy ContentBegin, ContentEnd

   Do Forever
      /* Read-In Content-Header */
      call EMAIL_InitRegionRead
      ContentEncoding = ""
      ContentName     = ""
      Do Forever
         If EMAIL_ReadRegion(CLIENT_MsgFile)=0 Then Leave
         Select
           When EMAIL_Region="CONTENT-TYPE" Then Do
            /* Analyse Content-Type - Multi-Item Region */
            Do Forever
               If EMAIL_GetItemFromRegionData()=0 Then Leave
               Select
                 When EMAIL_ItemName="NAME"     Then ContentName       = EMAIL_ItemData
                 Otherwise Nop
               End
            End
           End
           When EMAIL_Region="CONTENT-TRANSFER-ENCODING" Then ContentEncoding = Translate(EMAIL_RegionData)
           Otherwise Nop
         End
      End
      /* Got Content-Header Header */
      If Length(ContentEncoding)>0 Then Do
         If Length(ContentName)=0 Then ContentName = "NoName"
         call CharOut ,"* Got Content-Part ["ContentName"]..."
         If ContentEncoding="BASE64" Then Do
            call CLIENT_ProcessAttachment ContentName, ContentBegin
            ContentEnd = FILEWAIT_GetSeek(CLIENT_MsgFile)
         End
           else Do
            /* Some Content is still left */
            Do Forever /* Search for first occurance of boundary */
               ContentEnd   = Stream(CLIENT_MsgFile, "c", "seek")
               CurLine      = LineIn(CLIENT_MsgFile)
               If Left(CurLine, Length(MultiPartBoundary))=MultiPartBoundary | Stream(CLIENT_MsgFile)\="READY" Then Leave
            End
            /* dont copy last boundary */
            call CLIENT_Copy ContentBegin, ContentEnd
            CLIENT_SomeContentAllowed = 1
            say "is fine."
         End
         ContentBegin = ContentEnd
      End
      If Stream(CLIENT_MsgFile)\="READY" Then Leave
   End
   /* Ending Boundary & CR */
   call LineOut CLIENT_MsgTemp, MultiPartBoundary"--"
   call LineOut CLIENT_MsgTemp, ""
End
call FILEWAIT_Close CLIENT_MsgFile
call FILEWAIT_Close CLIENT_MsgTemp

If CLIENT_SomeContentAllowed Then Do
   /* Some Content was allowed, so send this message out */
   say "* E-mail allowed to pass system"
   call FILEWAIT_ForReplaceFile CLIENT_MsgFile, CLIENT_MsgTemp
   exit 0
End
 else Do
   /* No Content got through filter, so don't send further */
   say "* E-Mail got filtered completely"
   call SysFileDelete CLIENT_MsgTemp
   exit 2
End
exit

/* Base64 Attachment Processing, will decode data to temporary file and */
/* generate job for Dynamic Filter                                      */
/*  - Waits for result and filters out attachment, if required          */
CLIENT_ProcessAttachment:
   Parse Arg ContentName, ContentBegin

   /* ContentBegin - Absolute Begin of Content-Header (incl. Boundary) */
   /* DataBegin    - Begin of Content-Base64-Data                      */
   /* ContentEnd   - End of Content-Base64-Data (w/o Boundary)         */

   DataBegin   = FILEWAIT_GetSeek(CLIENT_MsgFile)

   /* Generate a new Job-ID */
   JobMainFile = SysTempFileName(DYNFILT_BaseDirectory"Jobs\?????.job")
   JobBaseFile = Left(JobMainFile,Length(JobMainFile)-4)
   JobTempFile = JobBaseFile".tmp"

   /* Close file, so DirectC can access it */
   call FILEWAIT_Close CLIENT_MsgFile

   ContentEnd = DirectC_DecodeFrom6bitViaFile(CLIENT_MsgFile, DataBegin, JobBaseFile".dta")

   call FILEWAIT_ForReadFile CLIENT_MsgFile
   call FILEWAIT_Seek CLIENT_MsgFile, ContentEnd

   /* Remove Drive/Path information from ContentName */
   ContentName = FileSpec("name", ContentName)

   /* Generate .JOB file... */
   call LineOut JobTempFile, DYNFILT_Sender
   call LineOut JobTempFile, DYNFILT_Receiver
   call LineOut JobTempFile, DYNFILT_Subject
   call LineOut JobTempFile, ContentName
   call FILEWAIT_Close JobTempFile
   call FILEWAIT_ForReplaceFile JobMainFile, JobTempFile

   /* Now wait for reply from Main Filter Script */
   TimeOutTimer = 300 /* 60 seconds */
   Do Forever
      call XtraSleep 200
      If FILEWAIT_FileExists(JobMainFile)=0 Then Leave
      TimeOutTimer = TimeOutTimer-1
      If TimeOutTimer=0 Then Leave
   End
   If FILEWAIT_FileExists(JobBaseFile".ok") Then Do
      /* File allowed... */
      call SysFileDelete JobBaseFile".ok"
      call CLIENT_Copy ContentBegin, ContentEnd
      CLIENT_SomeContentAllowed = 1
      say "is allowed."
   End
    else say "is bad."
   return

CLIENT_Copy:
   Procedure Expose CLIENT_MsgFile CLIENT_MsgTemp
   Parse Arg StartPos, EndPos
   call FILEWAIT_Seek CLIENT_MsgFile, StartPos
   if (EndPos>StartPos) Then Do
      TempBuffer = CharIn(CLIENT_MsgFile, StartPos, EndPos-StartPos)
      call CharOut CLIENT_MsgTemp, TempBuffer
   End
   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