.Title MAILSHR - Foreign mail protocol interface for VMS 5.x ; ; Written by Kevin Carosso @ Hughes Aircraft Co., SCG/CTC, January 11, 1985 ; Modified by Ned Freed, 16-Nov-1986, to use proper global symbols. ; Modified by Kevin Carosso, 10-MAR-1988, to allow easy DEBUG invocation. ; Modified by Ned Freed, 23-Mar-1989, for CC line and attribute support. ; ; The problem is that even though we can now debug shareable images, ; this shareable image is dynamically activated by MAIL. There is ; no way for the debugger to get control. So, we do the following: ; If the logical name MAILSHR_DEBUG is defined we will signal an ; SS$_DEBUG the first time into this module. This will transfer control ; to DEBUG after this image is mapped in. Unfortunately, this will ; not work unless MAIL.EXE or MAIL_SERVER.EXE have the image transfer ; address array modified to include the traceback entry point and ; the image flags modified to enable the IHD$V_LNKDEBUG bit (it ; is bit 0). ; ; Use PATCH/ABSOLUTE on a private copy of the appropriate image ; (in VMS V4 use MAIL.EXE, in VMS V5 use MAIL.EXE for outbound ; messages, MAIL_SERVER.EXE for inbound). The transfer address ; array is three longwords at offset 30 (all numbers in hex). ; The image flags are a longword at offset 20. Initially, they ; will look something like: ; ; +--------------+ ; 20: | 01000028 | ! Image flags ; +--------------+ ; ; +--------------+ ; 30: | 00000F18 | ! Transfer address array ; +--------------+ ; 34: | 00000000 | ; +--------------+ ; 38: | 00000000 | ; +--------------+ ; ; To enable DEBUG, set bit 0 in the flags to be 1. ; To allow traceback, and hence the SS$_DEBUG signal to work, ; the first transfer address must be changed to 7FFEDF68 (for ; VMS V4 or V5) while the existing address must be moved down to ; the second longword. So, our example would become: ; ; +--------------+ ; 20: | 01000029 | ; +--------------+ ; ; +--------------+ ; 30: | 7FFEDF68 | ; +--------------+ ; 34: | 00000F18 | ; +--------------+ ; 38: | 00000000 | ; +--------------+ ; ; To ensure your private copy is invoked by the MAIL command, ; define MAIL or MAIL_SERVER to point at your patched copy. ; Note that MAIL is normally installed with privileges, so you ; will have to enable those privileges (at least) so that your ; private copy functions properly. When MAIL or MAIL_SERVER ; starts execution, note that DEBUG will start first. Since we ; don't care about anything in these images yet, simply tell DEBUG ; to "GO". ; ; Defining MAILSHR_DEBUG (the equivalence value does not matter) ; will cause DEBUG to regain control the first time into the ; MAILSHR image. If you compiled and linked with /DEBUG, you ; should have access to all symbols and full source-code debugging. ; ; Note that in VMS V4 you are initially in this module, MAILSHR, ; which is MACRO so you won't see any source lines. SET LANG ; MACRO and carefully single-step until you get to the CALLG, then ; STEP/INTO. Once inside PMDF_MAIL, you should SET LANG PASCAL. ; You may have to SET IMAGE and SET MODU. ; ; In VMS V5, MACRO is fully supported and you will see source ; lines and be able to easily step into PMDF_MAIL. ; ;--------------------------------------------------------------------------- ; This is invoked by MAIL when it encounters the foreign mail protocol. ; This module really has nothing protocol-specific to it and can be used ; to dispatch to any handler. The handler should supply the following ; action routines: ; ; status := MAIL_OUT_CONNECT (context : unsigned; ; LNK_C_OUT_CONNECT : immediate; ; protocol, node : string_descriptor; ; MAIL$_LOGLINK : immediate; ; file_RAT, file_RFM : immediate; ; MAIL$GL_SYSFLAGS : immediate; ; attached_file : descriptor := immediate 0) ; ; status := MAIL_OUT_LINE (context : unsigned; ; [LNK_C_OUT_SENDER | LNK_C_OUT_TO | ; LNK_C_OUT_SUBJ | ; LNK_C_OUT_CC] : immediate; ; node, sender_name : string_descriptor) ; ; status := MAIL_OUT_CHECK (context : unsigned; ; [LNK_C_OUT_CKUSER | ; LNK_C_OUT_CKSEND] : immediate; ; node, addressee : string_descriptor; ; procedure MAIL$READ_ERROR_TEXT); ; ; status := MAIL_OUT_FILE (context : unsigned; ; LNK_C_OUT_FILE : immediate; ; node : string_descriptor; ; rab : $RAB_TYPE; ; procedure UTIL$REPORT_IO_ERROR); ; ; status := MAIL_OUT_DEACCESS (context : unsigned; ; LNK_C_OUT_DEACCESS : immediate); ; ; status := MAIL_OUT_ATTRIBS (context : unsigned; ; LNK_C_OUT_ATTRIBS : immediate; ; system_flags : immediate; ; idtld : $QUAD); ; ; status := MAIL_IN_CONNECT (context : unsigned; ; LNK_C_IN_CONNECT : immediate; ; input_tran : string_descriptor; ; file_RAT, file_RFM : immediate; ; MAIL$GL_SFLAGS : immediate; ; MAIL$Q_PROTOCOL : string_descriptor; ; pflags : immediate); ; ; status := MAIL_IN_LINE (context : unsigned; ; [LNK_C_IN_SENDER | LNK_C_IN_CKUSER | ; LNK_C_IN_TO | LNK_C_IN_SUBJ | ; LNK_C_IN_CC] : immediate; ; returned_line : string_descriptor); ; ; status := MAIL_IN_FILE (context : unsigned; ; LNK_C_OUT_FILE : immediate; ; 0 : immediate; ; rab : $RAB_TYPE; ; procedure UTIL$REPORT_IO_ERROR); ; ; status := MAIL_IN_ATTRIBS (context : unsigned; ; LNK_C_IN_ATTRIBS : immediate; ; idtld : $QUAD); ; ; status := MAIL_IO_READ (context : unsigned; ; LNK_C_IO_READ : immediate; ; returned_text_line : string_descriptor); ; ; status := MAIL_IO_WRITE (context : unsigned; ; LNK_C_IO_WRITE : immediate; ; text_line : string_descriptor); ; ;--------------------------------------------------------------------------- ; ; Define major and minor protocol identifiers. MAIL requires that these ; be 1. The shareable image MUST be linked with the options file MAILSHR.OPT ; that promotes these symbols to UNIVERSAL symbols so they will end up ; in the shareable image's symbol table. ; MAIL$C_PROT_MAJOR == 2 MAIL$C_PROT_MINOR == 1 ; ; Constants for dispatcher, taken from MAIL.SDL listing ; LNK_C_FIRST = 0 LNK_C_OUT_CONNECT == 0 LNK_C_OUT_SENDER == 1 LNK_C_OUT_CKUSER == 2 LNK_C_OUT_TO == 3 LNK_C_OUT_SUBJ == 4 LNK_C_OUT_FILE == 5 LNK_C_OUT_CKSEND == 6 LNK_C_OUT_DEACCESS == 7 ; LNK_C_IN_CONNECT == 8 LNK_C_IN_SENDER == 9 LNK_C_IN_CKUSER == 10 LNK_C_IN_TO == 11 LNK_C_IN_SUBJ == 12 LNK_C_IN_FILE == 13 ; LNK_C_IO_READ == 14 LNK_C_IO_WRITE == 15 ; LNK_C_IN_CC == 16 LNK_C_OUT_CC == 17 ; LNK_C_IN_ATTRIBS == 18 LNK_C_OUT_ATTRIBS == 19 ; LNK_C_LAST = 19 ; ; Here's the main routine that is called by MAIL. Note that we don't really ; do any work here, just dispatch the call to the appropriate handler. The ; reason I do it this way is that I am not interested in writing the handlers ; in MACRO, and I cannot easily deal with different numbers of arguments in ; the same procedure in other languages. ; ; ; General argument offset to the function code: ; LNK_FUNCTION = 8 ; ; Shareable image transfer vectors ; .Transfer MAIL$PROTOCOL .Mask MAIL$PROTOCOL jmp L^MAIL$PROTOCOL + 2 ; ; Own storage for DEBUG context. If MAILSHR_DEBUG translates to ; anything, then we signal SS$_DEBUG the first time in here. This ; is because we are a dynamically activated image and there is no ; way to set a break-point here. Once we've signalled the first time, ; we can ignore it since DEBUG will know all about us. ; table: .ascid /LNM$FILE_DEV/ name: .ascid /MAILSHR_DEBUG/ debug: .long -1 ; negative means we haven't checked .Entry MAIL$PROTOCOL, ^M tstl debug ; Check debug state beql 5$ ; 0 means ignore clrl debug ; don't check anymore $TRNLNM_S TABNAM = table, - LOGNAM = name cmpl #SS$_NORMAL, r0 ; if not found go on bneq 5$ pushl #SS$_DEBUG ; else invoke DEBUG calls #1, G^LIB$SIGNAL 5$: caseb LNK_FUNCTION(ap), #LNK_C_FIRST, - ; Dispatch to handler # 10$: .word Dispatch_out_connect - 10$ ; LNK_C_OUT_CONNECT .word Dispatch_out_line - 10$ ; LNK_C_OUT_SENDER .word Dispatch_out_check - 10$ ; LNK_C_OUT_CKUSER .word Dispatch_out_line - 10$ ; LNK_C_OUT_TO .word Dispatch_out_line - 10$ ; LNK_C_OUT_SUBJ .word Dispatch_out_file - 10$ ; LNK_C_OUT_FILE .word Dispatch_out_check - 10$ ; LNK_C_OUT_CKSEND .word Dispatch_out_deaccess - 10$ ; LNK_C_OUT_DEACCESS .word Dispatch_in_connect - 10$ ; LNK_C_IN_CONNECT .word Dispatch_in_line - 10$ ; LNK_C_IN_SENDER .word Dispatch_in_line - 10$ ; LNK_C_IN_CKUSER .word Dispatch_in_line - 10$ ; LNK_C_IN_TO .word Dispatch_in_line - 10$ ; LNK_C_IN_SUBJ .word Dispatch_in_file - 10$ ; LNK_C_IN_FILE .word Dispatch_IO_read - 10$ ; LNK_C_IO_READ .word Dispatch_IO_write - 10$ ; LNK_C_IO_WRITE .word Dispatch_in_line - 10$ ; LNK_C_IN_CC .word Dispatch_out_line - 10$ ; LNK_C_OUT_CC .word Dispatch_in_attribs - 10$ ; LNK_C_IN_ATTRIBS .word Dispatch_out_attribs - 10$ ; LNK_C_OUT_ATTRIBS unknown: pushl LNK_FUNCTION(ap) ; FAO parameter in the function code pushl #1 pushl #DELIVER__UNKFUNC ; Signal unknown function code calls #3, G^LIB$SIGNAL ; if we fall through dispatcher. movl #DELIVER__UNKFUNC, r0 ret ; ; The dispatchers ; Dispatch_out_connect: callg (ap), MAIL_OUT_CONNECT ret Dispatch_out_line: callg (ap), MAIL_OUT_LINE ret Dispatch_out_check: callg (ap), MAIL_OUT_CHECK ret Dispatch_out_file: callg (ap), MAIL_OUT_FILE ret Dispatch_out_deaccess: callg (ap), MAIL_OUT_DEACCESS ret Dispatch_in_connect: callg (ap), MAIL_IN_CONNECT ret Dispatch_in_line: callg (ap), MAIL_IN_LINE ret Dispatch_in_file: callg (ap), MAIL_IN_FILE ret Dispatch_IO_read: callg (ap), MAIL_IO_READ ret Dispatch_IO_write: callg (ap), MAIL_IO_WRITE ret Dispatch_in_attribs: callg (ap), MAIL_IN_ATTRIBS ret Dispatch_out_attribs: callg (ap), MAIL_OUT_ATTRIBS ret .end