From:	MERC::"uunet!CRVAX.SRI.COM!RELAY-INFO-VAX" 19-JUN-1992 03:29:47.97
To:	info-vax@kl.sri.com
CC:	
Subj:	Re: Archiving mail files

Sorry this is such a late response to a message but I hardly get to go on our
Unix system. The following file is something I whipped up to cope with my mail
archiving problems. It's not documented at all but I hope it's of some use to
anyone who has similar problems with excessive amounts of mail. It uses the VMS
mailshare routines and so won't work for pre v5.2 versions of the operating
system (Vms an operating system ? ha ha). It's also bound to need editing as
well but again who has time for programming these sort of things ?

  To compile it use FORTRAN/EXTEND_SOURCE and then link it. To use it properly 
you need to set up a symbol to the program,

  $ filer :== $ device:[directory]filer.exe

  The rest should all work quite cleanly, as it takes most of its information 
from the mail configuration files. All files it creates are placed in the
directory where mail.mai resides and subsequent runs are appended to this file
for simplicity.
---------------------Cut Here-------------------------------------------------   
	Option/Extend_Source
	Program Filer
C
C	Program written by K.E.Jones.    CBS%UK.AC.BRIGHTON.VMS
C					 CBS%UK.AC.BRIGHTON.UNIX
C
C	Filer Program - A program designed to automatically extract and delete
C			mail for a users MAIL.MAI file.
C
C	    By default this program will select all new mail messages in the file
C	and file them under what it assumes is the username (chars after first "::" in
C	sender field). It will then, depending on option switches given below, extract the
C	mail to a text file, grouping the messages on the username found (as above).
C
C	Note :	If you wish to keep frequently reused messages in th mail file you can explicitly
C		file them i a folder called KEEP and they will be left alone.
C
C	Usage :	File [-e] [-c]
C		-e to extract mail to file ALL.MAIL in MAIL.MAI's directory
C		-c to automatically compress the MAIL.MAI file after messages are extracted
C
C
	Include '($Maildef)'
	Include '($Ssdef)'
C
	Structure /Mail_Item/
	    Integer*2 Len
	    Integer*2 Item_Code
	    Integer*4 Address
	    Integer*4 Ret_Len_Addr
	End Structure
C
	Parameter	Mail$_Notexist      = '007E80DA'X
C
	Character*255	Command
	Character*255	Mail_Directory
	Character*255	Result_Spec
	Character*255	From
	Character*255	To
C
	Integer*4	Loop
	Integer*4	Com_Len
	Integer*4	Mai_Dir_Len
	Integer*4	Res_Spe_Len
	Integer*4	Fro_Len
	Integer*4	To_Len
	Integer*4	Pos
	Integer*4	All_Sel
	Integer*4	Current_Id
C
	Integer*4	Status
	Integer*4	Mail$Mailfile_Open
	Integer*4	Mail$Message_Select
	Integer*4	Mail$Mailfile_Compress
C
	Integer*4	Mailfile_Ctx
	Integer*4	Message_Ctx
C
	External	Extract
	Integer*4	Extract
	External	Ignore
	Integer*4	Ignore
C
	Logical*1	Extract_Files
	Logical*1	Compress_Files
C
	Volatile	All_Sel,Current_Id,From,Fro_Len
C
	Record /Mail_Item/ Silent(2)
	Record /Mail_Item/ Reclaim_Inp(3)
	Record /Mail_Item/ Info_File_Inp(3)
	Record /Mail_Item/ Begin_Out(2)
	Record /Mail_Item/ Open_Out(2)
	Record /Mail_Item/ Message_Inp(2)
	Record /Mail_Item/ Next_Inp(2)
	Record /Mail_Item/ Info_Out(3)
	Record /Mail_Item/ Select_Inp(3)
	Record /Mail_Item/ Select_Out(2)
	Record /Mail_Item/ Copy_Inp(7)
	Record /Mail_Item/ Null(1)
C
	Call Lib$Get_Foreign (Command,,Com_Len)
	Extract_Files = .False.
	Compress_Files = .False.
	If (Com_Len.Gt.0) Then
	    If (Index(Command(1:Com_Len),'-E')) Extract_Files = .True.
	    If (Index(Command(1:Com_Len),'-C')) Compress_Files = .True.
	Endif
C
	Call Setup (Begin_Out(1)	,Mail$_Mailfile_Mail_Directory	,%Descr(Mail_Directory)	,%Loc(Mai_Dir_Len))
	Call Setup (Open_Out(1)		,Mail$_Mailfile_Resultspec	,%Descr(Result_Spec)	,%Loc(Res_Spe_Len))
	Call Setup (Select_Inp(1)	,Mail$_Message_Folder		,%Descr('MAIL')		,0)
	Call Setup (Select_Inp(2)	,Mail$_Nosignal			,%Descr(0)		,0)
	Call Setup (Select_Out(1)	,Mail$_Message_Selected		,%Descr(All_Sel)	,0)
	Call Setup (Next_Inp(1)		,Mail$_Message_Next		,%Descr(0)		,0)
	Call Setup (Info_Out(1)		,Mail$_Message_Current_Id	,%Descr(Current_Id)	,0)
	Call Setup (Info_Out(2)		,Mail$_Message_Sender		,%Descr(From)		,%Loc(Fro_Len))
	Call Setup (Reclaim_Inp(1)	,Mail$_Mailfile_Reclaim		,%Descr(0)		,0)
	Call Setup (Reclaim_Inp(2)	,Mail$_Nosignal			,%Descr(0)		,0)
	Call Setup (Silent(1)		,Mail$_Nosignal			,%Descr(0)		,0)
C
	Mailfile_Ctx = 0
	Message_Ctx  = 0
C
	Call Mail$Mailfile_Begin	(Mailfile_Ctx,Null,Begin_Out)
	Status = Mail$Mailfile_Open	(Mailfile_Ctx,Null,Open_Out)
C
	If (Status.Eq.Ss$_Normal) Then
	    Call Setup (Message_Inp(1)	,Mail$_Message_File_Ctx		,%Descr(Mailfile_Ctx)	,0)
	    Call Mail$Message_Begin  (Message_Ctx,Message_Inp,Null)
	    Status = Mail$Message_Select (Message_Ctx,Select_Inp,Select_Out)
	    If (Status.Ne.Mail$_Notexist) Then
		Type *,'Filer : Filing mail messages.'
		Do Loop=1,All_Sel
		    Call Mail$Message_Get (Message_Ctx,Next_Inp,Info_Out)
		    Pos = 1
		    Do While (Index(From(Pos:Fro_Len),'::').Ne.0)
			Pos = Index(From(Pos:Fro_Len),'::')+2
		    Enddo
		    To = From(Pos:Fro_Len)
		    Call Str$Trim(To,To,To_Len)
		    Type '(X,A,I3,A,A)','Filer : Filing message Id : ',Current_Id,' in ',To(1:To_Len)
		    Call Setup (Copy_Inp(1),Mail$_Message_Id		,%Descr(Current_Id)	,0)
		    Call Setup (Copy_Inp(2),Mail$_Message_Folder	,%Descr(To(1:To_Len))	,0)
		    Call Setup (Copy_Inp(3),Mail$_Message_Folder_Action	,%Descr(Ignore)		,0)
		    Call Setup (Copy_Inp(4),Mail$_Message_Filename	,%Descr(Result_Spec)	,%Loc(Res_Spe_Len))
		    Call Setup (Copy_Inp(5),Mail$_Message_File_Action	,%Descr(Ignore)		,0)
		    Call Setup (Copy_Inp(6),Mail$_Message_Delete,0,0)
		    Call Mail$Message_Copy (Message_Ctx,Copy_Inp,Null)
		Enddo
	    Else
		Type *,'Filer : No messages to file.'
	    Endif
	    Call Mail$Message_End (Message_Ctx,Null,Null)
C
	    If (Extract_Files) Then
		Type *,'Filer : Extracting mail messages'
		Call Setup (Info_File_Inp(1)	,Mail$_Mailfile_Folder_Routine	,%Descr(Extract)	,0)
		Call Setup (Info_File_Inp(2)	,Mail$_Mailfile_User_Data	,%Descr(Mailfile_Ctx)	,0)
		Call Mail$Mailfile_Info_File (Mailfile_Ctx,Info_File_Inp,Null)
	    Endif
C
	    Call Mail$Mailfile_Purge_Waste	(Mailfile_Ctx,Reclaim_Inp,Null)
	    If (Compress_Files) Then
		Type *,'Filer : Compressing mail file'
		Status = Mail$Mailfile_Compress	(Mailfile_Ctx,Null,Null)
		If (Status.Ne.Ss$_Normal) Then
		    Call Lib$Delete_File ('SYS$SCRATCH:CONVWORK.TMP;*')
		    Call Lib$Delete_File (Mail_Directory(:Mai_Dir_Len)//'MAIL*.TMP;*')
		Endif
		Call Lib$Delete_File (Mail_Directory(:Mai_Dir_Len)//'MAIL.OLD;*')
	    Endif
	    Call Mail$Mailfile_Close		(Mailfile_Ctx,Null,Null)
	Endif
	Call Mail$Mailfile_End (Mailfile_Ctx,Null,Null)
C
	End
C
	Options/Extend_Source
	Integer*4 Function Extract (User_Data,String)
C
	Include '($Ssdef)'
C
	Integer*4	User_Data
	Character*(*)	String
C
	If (Len(String).Ne.0) Then
	    If ((String.Ne.'WASTEBASKET').And.(String.Ne.'NEWMAIL').And.(String.Ne.'KEEP')) Then
		Call Print_Mail (User_Data,String)
	    Endif
	Endif
	Extract = Ss$_Normal
C
	Return
	End
C
	Options/Extend_Source
	Subroutine Print_Mail (Context,Folder)
C
	Include '($Maildef)'
	Include '($Ssdef)'
C
	Structure /Mail_Item/
	    Integer*2 Len
	    Integer*2 Item_Code
	    Integer*4 Address
	    Integer*4 Ret_Len_Addr
	End Structure
C
	Integer*4	Context
	Character*(*)	Folder
C
	Real*8		Date
	Character*23	Asc_Date
	Integer*4	All_Sel
	Integer*2	Flag
	Integer*4	Current_Id
	Character*255	Buffer
	Integer*4	Buff_Len
	Integer*4	Loop
	Integer*2	Bad_Mask
	Integer*4	Status
	Integer*4	Message_Ctx
	Integer*4	Mail$Message_Get
	Integer*4	Mail$Message_Select
C
	Record /Mail_Item/ Message_Inp(2)
	Record /Mail_Item/ Select_Inp(3)
	Record /Mail_Item/ Select_Out(2)
	Record /Mail_Item/ Flags_Out(4)
	Record /Mail_Item/ Cont_Inp(2)
	Record /Mail_Item/ Next_Inp(2)
	Record /Mail_Item/ Buff_Out(2)
	Record /Mail_Item/ Message(2)
	Record /Mail_Item/ Null
C
	Bad_Mask    = (Mail$M_Dwmail.Or.Mail$M_Extfnf.or.Mail$M_Extnstd)   
	Message_Ctx = 0
C
	Call Setup (Message_Inp(1)	,Mail$_Message_File_Ctx		,%Descr(Context)	,0)
	Call Setup (Select_Inp(1)	,Mail$_Message_Folder		,%Descr(Folder)		,0)
	Call Setup (Select_Inp(2)	,Mail$_Nosignal			,%Descr(0)		,0)
	Call Setup (Select_Out(1)	,Mail$_Message_Selected		,%Descr(All_Sel)	,0)
	Call Setup (Flags_Out(1)	,Mail$_Message_Current_Id	,%Descr(Current_Id)	,0)
	Call Setup (Flags_Out(2)	,Mail$_Message_Return_Flags	,%Descr(Flag)		,0)
	Call Setup (Flags_Out(3)	,Mail$_Message_Binary_Date	,%Descr(Date)		,0)
	Call Setup (Next_Inp(1)		,Mail$_Message_Next		,%Descr(0)		,0)
	Call Setup (Cont_Inp(1)		,Mail$_Message_Continue		,%Descr(0)		,0)
	Call Setup (Buff_Out(1)		,Mail$_Message_Record		,%Descr(Buffer)		,%Loc(Buff_Len))
C
	Call Mail$Message_Begin	    (Message_Ctx,Message_Inp,Null)
	Call Mail$Message_Select    (Message_Ctx,Select_Inp,Select_Out)
C
	Open (Unit=10,File='Mail$Output',Err=10,Recordtype='variable',Recl=255,Carriagecontrol='List',Status='Unknown',
	1	Access = 'Append')
C
	Write (Unit=10,Fmt='(A,A,A)') '--------------------------- Folder : ',Folder,' -------------------------------'
C
	Do Loop=1,All_Sel
	    Call Mail$Message_Get (Message_Ctx,Next_Inp,Flags_Out)
	    If (.Not.Iand(Flag,Bad_Mask)) then
		Status = Mail$Message_Get (Message_Ctx,Cont_Inp,Buff_Out)
		Call Sys$AscTim (,Asc_Date,Date,0)
		Write (Unit=10,Fmt='(A,A,A)') '--- Date : ',Asc_Date,'-------------------------------------------'
		Do While (Status.ne.8314792)
		    If (Buff_Len.Gt.0) Write (Unit=10,Fmt='(A)',Err=10) Buffer(:Buff_Len)
		    Status = Mail$Message_Get (Message_Ctx,Cont_Inp,Buff_Out)
		Enddo
	    Else
		Type *,'Message ',Current_Id,'is not simple message please extract it manually.'
	    Endif
	    Call Setup (Message(1)	    ,Mail$_Message_Id	,%Descr(Current_Id)	,0)
	    Call Mail$Message_Delete    (Message_Ctx,Message,Null)
	Enddo
	Write (Unit=10,Fmt='(A/)') '--------------------------------- End -------------------------------------'
	Close (Unit=10,Err=10)
	Call Mail$Message_End	    (Message_Ctx,Null,Null)
C
	Return
C
10	Close (Unit=10,Err=10)
	Type *,'Error opening/writing to mail output file'
	Return
	End
C
	Options/Extend_Source
	Integer*4 Function Ignore (User_Data,String)
C
	Include '($Ssdef)'
C
	Integer*4	User_Data
	Character*(*)	String
C
	Ignore = Ss$_Normal
C
	Return
	End
C
	Options/Extend_Source
        Subroutine Setup (Item,Code,String,Ret_Len)
C
	Character*(*) String
	Integer Ret_Len
	Integer Code
C
	Structure /Mail_Item/
	   Integer*2 Len
	   Integer*2 Item_Code
	   Integer*4 Address
	   Integer*4 Ret_Len_Addr
	End Structure
C
	Record /Mail_Item/ Item
C
	Item.Len=Len(String)
	Item.Address=%Loc(String)
	Item.Item_Code=Code
	Item.Ret_Len_Addr=Ret_Len
	Return
	End

