$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 7.2-007  22-FEB-1990
$!   On 29-AUG-1991 07:57:42.15   By user MADISON 
$!
$! This VMS_SHARE Written by:
$!    Andy Harper, Kings College London UK
$!
$! Acknowledgements to:
$!    James Gray       - Original VMS_SHARE
$!    Michael Bednarek - Original Concept and implementation
$!
$! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
$! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
$!
$! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
$!       1. MAIL_VERIFICATION.COM;1
$!       2. MAIL_VER_STARTUP.COM;1
$!
$set="set"
$set symbol/scope=(nolocal,noglobal)
$f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID"))
$e="write sys$error  ""%UNPACK"", "
$w="write sys$output ""%UNPACK"", "
$ if f$trnlnm("SHARE_LOG") then $ w = "!"
$ ve=f$getsyi("version")
$ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto START
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ v=f$verify(v)
$ exit 44
$UNPACK: SUBROUTINE ! P1=filename, P2=checksum
$ if f$search(P1) .eqs. "" then $ goto file_absent
$ e "-W-EXISTS, File ''P1' exists. Skipped."
$ delete 'f'*
$ exit
$file_absent:
$ if f$parse(P1) .nes. "" then $ goto dirok
$ dn=f$parse(P1,,,"DIRECTORY")
$ w "-I-CREDIR, Creating directory ''dn'."
$ create/dir 'dn'
$ if $status then $ goto dirok
$ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped."
$ delete 'f'*
$ exit
$dirok:
$ w "-I-PROCESS, Processing file ''P1'."
$ if .not. f$verify() then $ define/user sys$output nl:
$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1'
PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET(
SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");b:=
CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(b));
LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
BEGINNING_OF(b));g:=0;LOOP EXITIF MARK(NONE)=END_OF(b);x:=ERASE_CHARACTER(1);
IF g=0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x="V" THEN APPEND_LINE;
MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;IF x="+" THEN g:=1;
ERASE_LINE;ENDIF;ELSE IF x="-" THEN IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+")=
1 THEN g:=0;ENDIF;ENDIF;ERASE_LINE;ENDIF;ENDLOOP;t:="0123456789ABCDEF";
POSITION(BEGINNING_OF(b));LOOP r:=SEARCH("`",FORWARD);EXITIF r=0;POSITION(r);
ERASE(r);x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,ERASE_CHARACTER(1))-1;
COPY_TEXT(ASCII(16*x1+x2));ENDLOOP;WRITE_FILE(b,GET_INFO(COMMAND_LINE,
"output_file"));ENDPROCEDURE;Unpacker;QUIT;
$ delete/nolog 'f'*
$ CHECKSUM 'P1'
$ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT
$ e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ ENDSUBROUTINE
$START:
$ create 'f'
X$!
X$!`09This procedure is designed to send mail verification to MX mail users
X$!`09For each mode of delivery you wish verification you need to
X$!`09enable /ACCOUNTING eg.
X$!`09SET SMTP/ACCOUNTING
X$!`09SET LOCAL/ACCOUNTING
X$!
X$!`09It will parse the log file and send messages back to each user.
X$!`09The message will not identify the messages unambiguously
X$!`09The user just gets the information that a message went to
X$!`09a particular node or user on a certain date.
X$!`09You may wish to change the queue name, or wakeup time
X$!
X$!`09This was written by:
X$!`09`09John Clement
X$!`09`09Bonner Lab
X$!`09`09Rice University
X$!`09`09`09CLEMENT@PHYSICS.RICE.EDU
X$!`09`09`09CLEMENT@RICEVM1.BITNET
X$!`09`09`09RIPHYS::CLEMENT
X$!
X$ set noon
X$ debug=0
X$ if f$trnlnm("mail_ver_debug") .nes. "" then debug=1
X$ if debug then set verify
X$ min_date=f$cvtime("-7-00:00")
X$ max_size=5
X$ on control_y then goto exit
X$`09here`09`09= f$parse(f$environment("PROCEDURE"))
X$`09location`09= f$parse(here,,,"DEVICE") + f$parse(here,,,"DIRECTORY")
X$`09name`09`09= f$parse(here,,,"name")
X$`09set def mx_dir
X$`09purge *.log
X$ if debug
X$ then
X$!`09delete `5B.*`5Dverification.dat;*`09`09`09! Debug
X$`09show sym min_date
X$`09show sym max_size
X$`09log:=/nolog
X$ else
X$`09log:=/log=mx_dir:
X$ endif
X$`09submit`09'location''name' -
X`09`09/que=fast_cl1 -`09`09`09`09! Queue name
X`09`09/after="+1:00:00" -`09`09`09! Wakeup every hour
X`09`09'log'/noprint
X$open_file:
X$ count=0
X$ if f$trnlnm("in") .nes. "" then close in
X$ file=f$search("`5B.*`5D*_ACC.DAT")`09`09`09`09! Next file
X$ if file .eqs. "" then goto exit`09`09`09`09! Done ?
X$ mod_date`09= f$cvtime(f$file_attributes(file,"rdt"))`09! Modific. date
X$ location = f$parse(file,,,"DEVICE") + f$parse(file,,,"DIRECTORY")
X$ old_count=0
X$ old_date=f$cvtim("1-jan-1980")
X$ date=old_date
X$ current_date=old_date
X$ open in /err=no_date 'location'verification.dat`09`09! Get old date
X$`09read in/end=no_date old_date
X$`09read in/end=no_date old_count
X$`09old_count=f$integer(old_count)
X$no_date:
X$ if f$trnlnm("in") .nes. "" then close in
X$! if old_date .ges. mod_date then goto open_file`09`09! Old file ?
X$ if`09f$cvtime(f$file_attributes(file,"cdt")) .lts. min_date .or. -
X`09f$file_attributes(file,"eof") .gt. max_size
X$`09then
X$`09`09new_file=f$extract(0,f$locate(";",file),file)`09! Create new log
X$`09`09create 'new_file'`09`09`09`09! New File
X$`09`09mcp`09:== $mx_exe:mcp`09`09`09`09! Setup MCP
X$`09`09mcp`09reset /all`09`09`09`09! Use new file
X$`09`09purge 'new_file'/keep=5`09`09`09`09! Purge old ones
X$`09endif
X$`09if debug
X$`09then
X$`09`09show sym old_date
X$`09`09show sym old_count
X$`09endif
X$ open in /share 'file'
X$read_record:
X$`09read in record`09/end=read_end
X$`09date=f$cvtime(f$extract(0,17,record))
X$`09if date .lts. old_date then goto read_record
X$`09if date .eqs. current_date
X$`09then
X$`09`09count=count+1`09`09`09`09`09! Number of lin
X$`09else
X$`09`09current_date=date`09`09`09`09! With same date
X$`09`09count=1
X$`09endif
X$`09if date .eqs. old_date .and. count .le. old_count then goto read_record
X$`09save`09= record
X$`09record=f$edit(record,"trim,upcase,compress")
X$`09temp=f$locate("SOURCE=",record)
X$`09if temp .ge. f$length(record) then goto read_record
X$`09temp=f$extract(temp,255,record)
X$`09temp=f$extract(0,f$locate(",",temp),temp)
X$`09'temp'
X$`09source=f$edit(source,"upcase,trim")
X$`09source=source-"@PHYSICS.RICE.EDU>"-"<"
X$`09if source .eqs. "" then goto read_record
X$!
X$!`09Kill mail to POSTMASTER, MAILER to external nodes
X$!
X$`09if f$locate("MAILER",source) .lt. f$length(source) then goto read_record
X$`09if f$locate("POSTMASTER",source) .lt. f$length(source) then goto read_re
Vcord
X$`09if f$locate(":",source) .lt. f$length(source) then goto read_record
X$`09if f$locate("@",source) .lt. f$length(source) then goto read_record
X$`09open out/write verification.txt
X$write_text:
X$`09`09temp=f$locate(",",save)
X$`09`09write out f$extract(0,temp,save)
X$`09`09save=f$extract(temp+1,255,save)
X$`09if save .nes. "" then goto write_text
X$`09close out
X$`09mail verification.txt 'source' /subj="Verification of Mail delivery"
X$`09delete verification.txt;*
X$`09goto read_record
X$read_end:
X$`09close in
X$`09if mod_date .gts. date then date=mod_date
X$`09if date .gts. old_date .or. count .ne. old_count
X$`09then
X$`09`09delete 'location'verification.dat;*
X$`09`09open out /write/err=open_file 'location'verification.dat
X$`09`09write out date
X$`09`09write out count
X$`09`09close out
X$`09endif
X$`09goto open_file
X$exit:
X$`09purge *.log/keep=2
X$`09if f$trnlnm("in") .nes. "" then close in
X$`09if f$trnlnm("out") .nes. "" then close out
X$`09exit
$ CALL UNPACK MAIL_VERIFICATION.COM;1 218956618
$ create 'f'
X$!
X$!`09This starts the mail_verificaton procedure
X$!`09It only starts it if it is not already operating
X$!
X$  TEMP = F$GETQUI("")
X$  QLOOP:
X$  QNAME = F$GETQUI("DISPLAY_QUEUE","QUEUE_NAME","*")
X$  IF QNAME .EQS. "" THEN goto not_found
X$!  WRITE SYS$OUTPUT ""
X$!  WRITE SYS$OUTPUT "QUEUE: ", QNAME
X$  JLOOP:
X$  NOACCESS = F$GETQUI("DISPLAY_JOB","JOB_INACCESSIBLE",,"ALL_JOBS")
X$  IF NOACCESS .EQS. "TRUE" THEN GOTO JLOOP
X$  IF NOACCESS .EQS. "" THEN GOTO QLOOP
X$  JNAME = F$GETQUI("DISPLAY_JOB","JOB_NAME",,"FREEZE_CONTEXT,ALL_JOBS")
X$ jname=f$edit(jname,"trim")
X$ if jname .nes. "MAIL_VERIFICATION" then goto jloop
X$!  WRITE SYS$OUTPUT "    JOB:  ", JNAME
X$`09write sys$output "Job already started:",jname
X$  exit
X$  GOTO JLOOP
X$not_found:
X$`09here`09`09= f$parse(f$environment("PROCEDURE"))
X$`09location`09= f$parse(here,,,"DEVICE") + f$parse(here,,,"DIRECTORY")
X$`09on control_y then goto end
X$`09priv=f$setprv("cmkrnl")
X$`09submit`09'location'mail_verification -
X`09`09/que=fast_cl1 -`09`09`09`09! Queue name
X`09`09/user=mailer -`09`09`09`09! User name
X`09`09/log='location'/noprint
X$end:
X$`09priv=f$setprv(priv)
X$ exit
$ CALL UNPACK MAIL_VER_STARTUP.COM;1 507593967
$ v=f$verify(v)
$ EXIT