$!/* acf4:comp.os.vms / ISIS08@ECOSTAT.AAU.DK / 2:21 pm Dec 12, 1990 */ $!> All this talk about callable mail documented in VMS 5.4 $!> Does this mean it would now be easy to extend eve to... $!> $!> SELECT Mail_Folder $!> READ Mail_message $!> $!> ...when we get a NEW MAIL ON NODE message while we're editing? $!> (No need to ATTACH and invoke MAIL, just do it in TPU) $!> $!> I hope someone who knows about callable mail and about TPU$CALLUSER $!> will figure this out. Now THAT would be useful! $! $!The following VMS_SHARE file contains a small example illustrating the $!technique. If you unshare, @CALL_USER and EVE/COMM=MAIL then the EVE command $!MAIL will read the first mail in folder NEWMAIL. It should not be so $!difficult to extend the program to read arbitrary mails (any number, $!any folder) and write them in the format you want. Just modify the $!program to suit your needs. If you make some genious discoveries, then $!please mail me. Note: the code is made and tested at VMS 5.3-1 ! $! $! Arne $! $!Arne Vajhxj Internet: ISIS08@ECOSTAT.AAU.DK $!Institute of Economics and Statistics PSI: DATAPAX.23830211371400::ISIS08 $!Aarhus University $!Denmark $! $!------------------------------------------------------------------------------- $! $! ------------------ CUT HERE ----------------------- $ v='f$verify(f$trnlnm("SHARE_VERIFY"))' $! $! This archive created by VMS_SHARE Version 7.2-007 22-FEB-1990 $! On 12-DEC-1990 20:05:57.67 By user ISIS08 $! $! 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. CALL_USER.FOR;1 $! 2. MAIL.MAR;1 $! 3. MAIL.TPU;1 $! 4. CALL_USER.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 INTEGER*4 FUNCTION TPU$CALLUSER(ININT,INSTR,OUTSTR) X INTEGER*4 ININT X CHARACTER*(*) INSTR X EXTERNAL OUTSTR XC XC Local variables X INTEGER*4 TMPLEN,LF,LS,D X LOGICAL*4 OK X CHARACTER*80 F,S X CHARACTER*256 TMPNAM XC XC Dispatch to function X GOTO (100,200,300) ININT XC XC MAIL_READ_INIT X100 CALL MAIL_READ_INIT('NEWMAIL',1,F,LF,S,LS,D,D,OK) X TMPLEN=LF+1+LS X TMPNAM(1:TMPLEN)=F(1:LF)//'\'//S(1:LS) X GOTO 1000 XC XC MAIL_READ_REC X200 CALL MAIL_READ_REC(TMPNAM,TMPLEN,OK) X IF(.NOT.OK) THEN X TMPLEN=9 X TMPNAM(1:TMPLEN)='ENDOFMAIL' X ENDIF X GOTO 1000 XC XC MAIL_READ_END X300 CALL MAIL_READ_END() X GOTO 1000 XC XC Return X1000 CALL STR$COPY_DX(OUTSTR,TMPNAM(1:TMPLEN)) X TPU$CALLUSER=1 XC X RETURN X END $ CALL UNPACK CALL_USER.FOR;1 1199112721 $ create 'f' X .title mail X; X; content : mail-routines X; X; author : Arne Vajh`F8j (februrary 1990) X; X $MAILDEF X $MAILMSGDEF X .macro time8to4,t8,t4,garb X subl2 #`5Ex4BEB4000,t8 X sbwc #`5Ex007C9567,t8+4 X ediv #10000000,t8,t4,garb X .endm X .macro time4to8,t4,t8 X emul #10000000,t4,#0,t8 X addl2 #`5Ex4BEB4000,t8 X adwc #`5Ex007C9567,t8+4 X .endm X .macro dtime4to8,t4,t8 X emul #-10000000,t4,#0,t8 X .endm X; X; readonly data section X; X .psect $PDATA long,pic,con,lcl,shr,noexe,nowrt X; X; writeread data section X; X .psect $LOCAL long,pic,con,lcl,noshr,noexe,wrt Xargl_mail: ; argumentlist MAIL$XXXXXXXX X .long 3 X .blkl 1 ; contxt X .blkl 1 ; input X .blkl 1 ; output Xsend: .blkl 1 Xfile: .blkl 1 Xread: .blkl 1 Xnul: .long 0 Xitmlst: .blkw 1 X .blkw 1 X .blkl 1 X .blkl 1 X .word 0 X .word MAIL$_NOSIGNAL X .long 0 X .long 0 X .long 0 Xitml2: .blkw 1 X .blkw 1 X .blkl 1 X .blkl 1 X .word 0 X .word MAIL$_NOSIGNAL X .long 0 X .long 0 X .long 0 Xitml3: .blkw 1 X .blkw 1 X .blkl 1 X .blkl 1 X .blkw 1 X .blkw 1 X .blkl 1 X .blkl 1 X .long 0 Xbuf: .blkb 80 Xtime: .blkq 1 X; X; code section X; X .psect $CODE long,pic,con,lcl,shr,exe,nowrt X;*************************************** X; X; MAIL_READ_END ( ) X; X; read end X; X;*************************************** X .entry mail_read_end,`5Em X moval read,argl_mail+4 X moval nul,argl_mail+8 X moval nul,argl_mail+12 X callg argl_mail,G`5EMAIL$MESSAGE_END X moval file,argl_mail+4 X moval nul,argl_mail+8 X moval nul,argl_mail+12 X callg argl_mail,G`5EMAIL$MAILFILE_CLOSE X moval file,argl_mail+4 X moval nul,argl_mail+8 X moval nul,argl_mail+12 X callg argl_mail,G`5EMAIL$MAILFILE_END X ret X;*************************************** X; X; MAIL_READ_INIT ( FOLDER , NR , FROM , LFROM , SUBJ , LSUBJ , TIME, SIZE , V OK ) X; X; read initialize X; X;*************************************** X .entry mail_read_init,`5Em X moval file,argl_mail+4 X moval nul,argl_mail+8 X moval nul,argl_mail+12 X callg argl_mail,G`5EMAIL$MAILFILE_BEGIN X moval file,argl_mail+4 X moval nul,argl_mail+8 X moval nul,argl_mail+12 X callg argl_mail,G`5EMAIL$MAILFILE_OPEN X movw #4,itmlst X movw #MAIL$_MESSAGE_FILE_CTX,itmlst+2 X moval file,itmlst+4 X movl #0,itmlst+8 X moval read,argl_mail+4 X moval itmlst,argl_mail+8 X moval nul,argl_mail+12 X callg argl_mail,G`5EMAIL$MESSAGE_BEGIN X movl B`5E4(ap),r0 X movw (r0),itmlst X movw #MAIL$_MESSAGE_FOLDER,itmlst+2 X movl 4(r0),itmlst+4 X movl #0,itmlst+8 X moval read,argl_mail+4 X moval itmlst,argl_mail+8 X moval nul,argl_mail+12 X callg argl_mail,G`5EMAIL$MESSAGE_SELECT X movl #0,r6 X100$: cmpl r6,@8(ap) ; test if correct message-number X bgeq 200$ X movw #0,itmlst X movw #MAIL$_MESSAGE_NEXT,itmlst+2 X movl #0,itmlst+4 X movl #0,itmlst+8 X moval read,argl_mail+4 X moval itmlst,argl_mail+8 X moval nul,argl_mail+12 X callg argl_mail,G`5EMAIL$MESSAGE_GET X incl r6 X cmpl r0,#MAIL$_MSGINFO X beql 100$ X brw 800$ X200$: movw #4,itml3 X movw #MAIL$_MESSAGE_SIZE,itml3+2 X movl B`5E32(ap),itml3+4 X movl #0,itml3+8 X movw #8,itml3+12 X movw #MAIL$_MESSAGE_BINARY_DATE,itml3+14 X moval time,itml3+16 X movl #0,itml3+20 X moval read,argl_mail+4 X moval nul,argl_mail+8 X moval itml3,argl_mail+12 X callg argl_mail,G`5EMAIL$MESSAGE_INFO; get information X time8to4 time,@B`5E28(ap),r1 X movl B`5E16(ap),r8 X movl B`5E12(ap),r0 X cvtwl (r0),r9 X movl B`5E4(r0),r10 X jsb mail_read_skip ; get FROM-field X jsb mail_skip ; skip TO-field X jsb mail_skip ; skip CC-field X movl B`5E24(ap),r8 X movl B`5E20(ap),r0 X cvtwl (r0),r9 X movl B`5E4(r0),r10 X jsb mail_read_skip ; get SUBJ-field X jsb mail_skip ; skip ? X movl #-1,@B`5E36(ap) X ret X800$: movl #0,@B`5E36(ap) X ret X;*************************************** X; X; MAIL_READ_REC ( LINE , LENGTH , OK ) X; X; read record X; X;*************************************** X .entry mail_read_rec,`5Em X movl B`5E8(ap),r8 X movl B`5E4(ap),r0 X cvtwl (r0),r9 X movl 4(r0),r10 X jsb mail_read ; read line X tstl r7 X bneq 200$ X movl #-1,@12(ap) X ret X200$: movl #0,@12(ap) X ret X;*************************************** X; X; mail_read , r10 = stradr , r9 = maxlen , r8 = lenadr , r7 = stat X; X; read item X; X;*************************************** Xmail_read: X movw #0,itmlst X movw #MAIL$_MESSAGE_CONTINUE,itmlst+2 X movl #0,itmlst+4 X movl #0,itmlst+8 X movw r9,itml2 X movw #MAIL$_MESSAGE_RECORD,itml2+2 X movl r10,itml2+4 X movl r8,itml2+8 X moval read,argl_mail+4 X moval itmlst,argl_mail+8 X moval itml2,argl_mail+12 X callg argl_mail,G`5EMAIL$MESSAGE_GET X cmpl r0,#MAIL$_MSGTEXT X bneq 100$ X movl #0,r7 X rsb X100$: movl #1,r7 X rsb X;*************************************** X; X; mail_read_skip , r10 = stradr , r9 = maxlen , r8 = lenadr , r7 = stat X; X; read item but skip first 6 characters X; X;*************************************** Xmail_read_skip: X pushl r9 X pushl r10 X movl #80,r9 X moval buf,r10 X jsb mail_read X popl r10 X popl r9 X subl2 #6,(r8) X movc3 (r8),buf+6,(r10) X rsb X;*************************************** X; X; mail_skip , r11=retadr`20 X; X; skip item X; X;*************************************** Xmail_skip: X moval buf+76,r8 X movl #76,r9 X moval buf,r10 X jsb mail_read X rsb X .end $ CALL UNPACK MAIL.MAR;1 257851011 $ create 'f' Xprocedure eve_mail X local X ix_integer, X tmp_string; X eve_buffer("MAIL"); X tmp_string:=call_user(1,""); X ix_integer:=index(tmp_string,"\"); X copy_text("From: "+substr(tmp_string,1,ix_integer-1)); X split_line; X copy_text("Subj: "+ X substr(tmp_string,ix_integer+1,length(tmp_string)-ix_integer)) V; X loop X tmp_string:=call_user(2,""); X exitif tmp_string="ENDOFMAIL"; X split_line; X copy_text(tmp_string); X endloop; X split_line; X tmp_string:=call_user(3,""); Xendprocedure; $ CALL UNPACK MAIL.TPU;1 638931059 $ create 'f' X$fortran/warn=decl call_user X$macro mail X$link/share=call_user call_user+mail+sys$input/option Xuniversal=tpu$calluser X$ X$define/nolog tpu$calluser sys$disk:`5B`5Dcall_user.exe X$exit $ CALL UNPACK CALL_USER.COM;1 1717199746 $ v=f$verify(v) $ EXIT $!/* ---------- */