$! ----------------------------------------------------------------------------------------
$! DCL Procedure for OpenVMS 7.3-2, developed on DS15
$! Werner Raksts - Central data processing section at GKSS research centre, Germany -
$! Written : 2005-08-31 - many thanks to Tom Wade for his suggestions
$! Description :
$! Search within PMDF_QUEUE-tree for messages with DNS-Problems and rename them.
$! More and more sites do DNS-Reverse Lookups and don't accept mails that fail.
$! Those messages are marked mostly with 4.2.1 or 4.5.1 codes, which makes it
$! temporary and PMDF tries again and again. To stop this senseless waste
$! of bandwitch and resources, this batch should run from time to time (depending
$! on the local needings). The Procedure looks in the whole PMDF_QUEUE-Tree
$! for messages (*.%%;) containing MX or DNS error messages (feel free to extend
$! the list when new phrases are seen) and renames them off PMDF's processing scheme.
$! Call:
$! To make it as easy as possible, I'm starting this from PMDF_TABLE (see at end)
$! Changes :
$!  2005-08-31 WR Tom Wade made some suggestions for safer string detection
$!  2005-08-31 WR included resubmit of this little helper
$!  2005-09-01 TW changed the code to look for binary characters directly
$! --------------------------------------------------------------------------------
$ START:
$  INFILE=f$search("PMDF_QUEUE:[000000...]*.%%;")
$! Don't test files (ZZ*.00) just processed by PMDF
$ fnm = F$Parse (INFILE,,, "NAME")
$ If F$Extract (0, 2, fnm) .eqs. "ZZ" then goto start
$! Don't try to read more files than available, but resubmit this procedure
$ IF INFILE .EQS. "" THEN GOTO SUB_MIT
$! Some necessary setup
$ CTLA=0
$ bound=0
$ ctrl_a[0,8]=1
$ delimiter = ctrl_a + ctrl_a + "Boundary"
$!
$! Search within an File for "History-entries"
$ OPEN/READ/ERR=M_OUT MIN 'INFILE'
$ MLOOP:
$  READ/END=M_OUT MIN MLINE
$! prevent unnecessary short and long line processing
$   IF f$length(MLINE) .GT. 127 THEN GOTO MLOOP
$   IF f$length(MLINE) .LT.   7 THEN GOTO MLOOP
$! we're not interested in regular Boundaries
$   IF f$locate("--Boundary",MLINE) .EQ. 0 THEN GOTO MLOOP
$! here we check for "^A^ABoundary" and increase the counter
$ If F$Locate (delimiter, mline) .eq. 0 THEN ctla=ctla+1
$! read and count until we've found the second occourance marking the history-section
$   IF CTLA .EQ. 2
$   THEN
$     ILOP:
$      READ/END=M_OUT MIN MLINE
$! we stop processing when found the third occourance of "delimiter"
$      IF f$locate(delimiter,MLINE) .EQ. 0 THEN GOTO M_OUT
$! we've found the first block of history and searching for error indicating strings
$      f1=f$locate("Failed MX lookup",MLINE)
$      f2=f$locate("DNS FAILURE",MLINE)
$      f3=f$locate("dns problems",MLINE)
$      f4=f$locate("verify sender address",MLINE)
$      f5=f$locate("Sender address rejected",MLINE)
$      mlen=f$length(MLINE)
$! Let's see if we can rename the file and leave because finding an error phrase
$      if f1 .lt. mlen .or.  f2 .lt. mlen .or. f3 .lt. mlen .or. f4 .lt. mlen .or. f5 .lt. mlen
$      THEN
$       NEWNAME=INFILE-".00;"+".MX-FAIL"
$! Let's go - rename the file out of PMDF-reachability
$       RENAME/NOLOG 'INFILE' 'NEWNAME'
$! If someone wants to enable /LOG with the batch, this might be useful uncomment
$!        WRITE SYS$OUTPUT "''INFILE' -> ''NEWNAME'"
$       GOTO M_OUT
$      ENDIF
$      CTLA=0
$     GOTO ILOP
$    ENDIF
$  GOTO MLOOP
$ M_OUT:
$  CLOSE MIN
$  GOTO START
$ EXIT
$! finally resubmit the procedure if necessary
$ SUB_MIT:
$  SUBMIT/QUEUE=SYS$BATCH/after="+ 00:57:00.00"/noLOG PMDF_TABLE:MX_ERR.COM
$ EXIT
$! ---------------------------------------------------------------------------------------