From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX"  4-OCT-1989 05:53
To:	MRGATE::"ARISIA::EVERHART"
Subj:	MAIL tidy program

Received: From UCBVAX.BERKELEY.EDU by GIZMO.SRI.COM with TCP; Tue,  3 OCT 89 19:04:22 PDT
Received: by ucbvax.Berkeley.EDU (5.61/1.37)
	id AA28968; Tue, 3 Oct 89 18:58:25 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews
	for info-vax@kl.sri.com (info-vax@kl.sri.com)
	(contact usenet@ucbvax.Berkeley.EDU if you have questions)
Date: 3 Oct 89 13:18:59 GMT
From: mcsun!ukc!strath-cs!nott-cs!clan.nott.ac.uk!cczjtw@uunet.uu.net  (John Whitehorn)
Organization: Cripps Computing Centre, University of Nottingham
Subject: MAIL tidy program
Message-Id: <8185@robin.cs.nott.ac.uk>
Sender: info-vax-request@kl.sri.com
To: info-vax@kl.sri.com


	This was send out on the "UK" VAXVMS list a couple of weeks ago, and a
number of people suggested it went to a larger audience:
	Under V4 we had a program that would tidy up VMSMAIL.DAT i.e. remove
entries from VMSMAIL.DAT for nonexistent users, (but checking for dummy
FORWARDs) this no longer worked with V5.
	There has also been some info. on the net about the undocumented
callable MAIL routines, so I've written a FORTRAN program that will check the
file  VMSMAIL_PROFILE.DATA and remove entries that are not in SYSUAF:
1) and have no FORWARD set
2) are not in an EXCLUDES list
3) have FORWARD set, but the FORWARD is a valid username or contains any of the
   characters "@" "%" ":" "." (FORWARD is to another system)

	John Whitehorn

--------------------------------- cut here -----------------------------------
	program mail_tidy
c
c
CDEC$	IDENT 'V05-013'
c
c
c J.T. Whitehorn
c Cripps Computing Centre
c University of Nottingham
c University Park
c Nottingham
c NG7 2RD
c
c 0602-484848 ext. 2918
c      
c 27-Jun-1898
c
c Mod history
c
c V05-001   27-Jun-1989   JTW
c                         Base program
c
c V05-002    5-Sep-1989   JTW
c                         Check forward set
c
c V05-003    5-Sep-1989   JTW
c                         Check none forwarded user exists
c
c V05-004    5-Sep-1989   JTW
c                         Check forwarded user exists
c
c V05-005    5-Sep-1989   JTW
c                         Check none existent forwarded user valid:
c                           allow if contains "@","%",":","." 
c
c V05-006    5-Sep-1989   JTW
c                         Check user exists
c
c V05-007    5-Sep-1989   JTW
c                         Change write to lib$put_output
c
c V05-008    6-Sep-1989   JTW
c                         Add MAIL$USER_DELETE_INFO
c
c V05-009    6-Sep-1989   JTW
c                         Place SYS$FAO and LIB$PUT_OUTPUT at end of loop
c
c V05-010    6-Sep-1989   JTW
c                         Change name to MAIL_TIDY
c
c V05-011    6-Sep-1989   JTW
c                         Add file of excludes
c
c V05-012   19-Sep-1989   JTW
c                         Tidy up coding
c
c V05-013   19-Sep-1989   JTW
c                         Correct delete coding
c

	implicit integer*4 (a-z)

	include '($maildef)'

	structure /itmlst/
	 union
	  map
	   integer*2 buflen,
	1            code
	   integer*4 bufadr,
	1            retlenadr
	  end map
	  map
	   integer*4 end_list
	  end map
	 end union
	end structure

	character*31 username,
	1            excludes(100)

	character*128 forward

	character*256 msgbuf

	logical delete

	record / itmlst / null_list
	record / itmlst / in_list(2)
	record / itmlst / out_list(3)
	record / itmlst / del_list(2)


	open(unit=21,
	1    file='CCC$MANAGER:MAIL_TIDY.EXCLUDES',
	1    status='OLD')

	excludes(1)='SYSTEM'

	max=2
10	read(21,'(a31)',end=20)excludes(max)
	max=max+1
	goto 10
20	close(unit=21)

	null_list.end_list=0

	in_list(1).buflen=4
	in_list(1).bufadr=0
	in_list(1).retlenadr=0
	in_list(2).end_list=0

	out_list(1).buflen=31
	out_list(1).code=mail$_user_return_username
	out_list(1).bufadr=%loc(username)
	out_list(1).retlenadr=%loc(len_username)
	out_list(2).buflen=128
	out_list(2).code=mail$_user_forwarding
	out_list(2).bufadr=%loc(forward)
	out_list(2).retlenadr=%loc(len_forward)
	out_list(3).end_list=0

	del_list(1).code=mail$_user_username
	del_list(1).bufadr=%loc(username)
	del_list(1).retlenadr=0
	del_list(2).end_list=0

	context=0
	status=mail$user_begin(context,null_list,null_list)
	loop=0
	do while ( status )
	  loop=loop+1
	  if ( loop .eq. 1 ) then
	     in_list(1).code=mail$_user_first
	  elseif ( loop .eq. 2 ) then
	     in_list(1).code=mail$_user_next
	  endif
	  status=mail$user_get_info(context,in_list,out_list)
	  if ( status ) then
	     delete=.false.
	     report_type=0
	     if ( len_forward .ne. 0 ) then
	        uaf_status=check_uaf(forward,len_forward)
	        if ( uaf_status ) then
	           report_type=1
	        else
	           call str$find_first_substring(forward(1:len_forward),
	1                                        index,
	1                                        sub_index,
	1                                        '@',
	1                                        '%',
	1                                        ':',
	1                                        '.')
	           if ( index .eq. 0 ) then
	              uaf_status=check_uaf(username,len_username)
	              if ( uaf_status ) then
	                 report_type=2
	              else
	                 delete=.true.
	                 do i=1,max
	                   if ( username(1:len_username) .eq. 
	1                       excludes(i)(1:len_username) ) 
	1                     delete=.false.
	                 end do
	                 if ( delete ) then
	                    report_type=3
	                 else
	                    report_type=5
	                 endif
	              endif
	           else
	              report_type=1
	           endif
	        endif
	     else
	        uaf_status=check_uaf(username,len_username)
	        if ( .not. uaf_status ) then
	           delete=.true.
	           do i=1,max
	             if ( username(1:len_username) .eq. 
	1                 excludes(i)(1:len_username) ) 
	1               delete=.false.
	           end do
	           if ( delete ) then
	              report_type=4
	           else
	              report_type=5
	           endif
	        endif
	     endif

	     if ( report_type .ne. 0 ) then
	        if ( report_type .eq. 1 ) then
	           call sys$fao('!31AS Has forwarding set to !AS',
	1                       msglen,msgbuf,
	1                       username(1:len_username),
	1                       forward(1:len_forward))
	        elseif ( report_type .eq. 2 ) then
	           call sys$fao('!31AS Has forwarding set to !AS'//
	1                       ' {none existent}',
	1                       msglen,msgbuf,
	1                       username(1:len_username),
	1                       forward(1:len_forward))
	        elseif ( report_type .eq. 3 ) then
	           call sys$fao('!31AS Removed <no such forward: !AS>',
	1                       msglen,msgbuf,
	1                       username(1:len_username),
	1                       forward(1:len_forward))
	        elseif ( report_type .eq. 4 ) then
	           call sys$fao('!31AS Removed <no such user>',
	1                       msglen,msgbuf,
	1                       username(1:len_username))
	        elseif ( report_type .eq. 5 ) then
	           call sys$fao('!31AS Has forwarding set to !AS'//
	1                       ' {excluded}',
	1                       msglen,msgbuf,
	1                       username(1:len_username),
	1                       forward(1:len_forward))
	        else
	           stop 'E?'
	        endif
	        if ( delete ) then
	           del_list(1).buflen=len_username
	           del_status=mail$user_delete_info(context,
	1                                           del_list,
	1                                           null_list)
	        endif
	        call lib$put_output(msgbuf(1:msglen))
	     endif
	  endif
	end do
	status=mail$user_end(context,null_list,null_list)

	end

	integer*4 function check_uaf(username,len_username)

	implicit integer*4 (a-z)

	include '($uaidef)'

	structure /itmlst/
	 union
	  map
	   integer*2 buflen,
	1            code
	   integer*4 bufadr,
	1            retlenadr
	  end map
	  map
	   integer*4 end_list
	  end map
	 end union
	end structure

	character*31 username
	character*32 account

	record / itmlst / uai_list(2)

	uai_list(1).buflen=32
	uai_list(1).code=uai$_account
	uai_list(1).bufadr=%loc(account)
	uai_list(1).retlenadr=%loc(len_account)
	uai_list(2).end_list=0

	status=sys$getuai(,,username(1:len_username),
	1                 uai_list,,,)

	check_uaf=status

	return

	end

