Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP Path: utzoo!mnetor!uunet!husc6!bloom-beacon!oberon!cit-vax!ucla-cs!zen!ucbvax!ISUMVS.BITNET!GA.JPH From: GA.JPH@ISUMVS.BITNET ("John Hascall") Newsgroups: comp.os.vms Subject: VMS MAIL Foreign protocol code (^100K) Message-ID: <8709050930.AA24736@ucbvax.Berkeley.EDU> Date: Thu, 3-Sep-87 12:44:47 EDT Article-I.D.: ucbvax.8709050930.AA24736 Posted: Thu Sep 3 12:44:47 1987 Date-Received: Sun, 6-Sep-87 03:46:50 EDT Sender: daemon@ucbvax.BERKELEY.EDU Organization: The ARPA Internet Lines: 2678 $! $!Fellow netters: $! $! Since I received multiple requests for my VMS foreign protocol mail $!interface program, here it is... But first the caveats: $! $! 0) This file is ^ 100K. $! $! 1) This program is provided "AS IS". You are free to do whatever $! NON-COMMERCIAL things to it that you desire. The program $! appears to work correctly here, but of course that is no $! guarantee. $! $! 2) This program needs another process to actually transmit and $! receive the mail, all it does is interface with VMS MAIL and $! produce an envelope around the message and place the message $! in a spool directory and awaken the delivery process. $! $! 3) You will need to change some logical names and file names in $! the .com files. $! $! 4) This program needs to be installed with privileges, so follow $! appropriate coding practices.! $! $! 5) This program was derived from one given to me by Gerard K. Newman, $! so there are, no doubt, some things which are done in a less than $! optimal way due to interactions between his code and mine (in fact, $! I believe there is even some code which is never used somewhere). $! Feel free to make improvements. $! $!Enough of that, here are the files: $! $! BIT.OPT Linker options file $! BITNET.MSG Message file $! BITNET_MAILSHR.MAR The program $! DEL.COM A command file to de-install the image $! NEW.COM A command file to install the image $! TEST.MAR A program I used to understand the protocol $! $! John Hascall $! ISU Computation Center $! GAJPH@ISUMVS.BITNET $! $create/log bit.opt $deck/dollars="$END-OF-FILE" UNIVERSAL=MAIL$PROTOCOL UNIVERSAL=MAIL$C_PROT_MAJOR UNIVERSAL=MAIL$C_PROT_MINOR $END-OF-FILE $! $create/log bitnet.msg $deck/dollars="$END-OF-FILE" .Title Bitnet_MailShr_Msg Bitnet_MailShr error messages .Ident "Bitnet_MailShr V01.00" !+ ! ! ----- Bitnet_MailShr_Msg: Bitnet_MailShr error messages ! ! ! Facility: ! ! VAX/VMS personal mail utility ! ! Abstract: ! ! This module contains the messages for the Bitnet_MailShr module ! which uses the undocumented Mail$protocol interface to deliver ! mail on the DoD internet. ! ! Environment: ! ! VAX/VMS native mode, VMS V4.0 or later ! ! ! Version: V01.000 ! Date: 07-Sep-1985 ! ! Gerard K. Newman 07-Sep-1985 ! Science Applications International ! 800 Oak Ridge Turnpike ! Oak Ridge, TN 37830 ! (615) 482-9031 ! ! ! Modifications: ! ! Date: 22-Jun-1987 ! ! John Hascall ! Iowa State University ! Ames, IA 50010 ! (515) 294-9889 ! ! Modified for the ISU environment !- .Facility Bitnet,100/Prefix=Bit$_ .Severity Fatal UNKFUNC /FAO_Count=1 INTCODERR NOMCB OPENIN /FAO_Count=1 INPERR NOINFILE INVMSGFIL INVMSGTYP INVSOURCE .Severity Error INVADDR .Severity Informational BADHDRITM /FAO_Count=1 .End $END-OF-FILE $! $create/log bitnet_mailshr.mar $deck/dollars="$END-OF-FILE" .Title Bitnet_MailShr BITNET mail protocol interface .Ident /V01.000/ .Subtitle Introduction .Enable SUP ;+ ; ; ----- Bitnet_MailShr: BITNET mail protocol interface ; ; ; Facility: ; ; VAX/VMS personal mail utility. ; ; Abstract: ; ; This module provides a mechanism for the VAX/VMS personal ; Mail utility to send and receive mail on BITNET through ; the NAS AS/9160 using the undocumented Mail$Protocol ; interface. ; ; Thanks to Gerard K. Newman of the San Diego Supercomputer ; Center for providing his version of this program (for an ; ArpaNet site). ; ; (Thanks to Kevin Carosso at Hughes Aircraft for providing ; much of the inspiration for this software and for helping ; to document the inner workings of the Mail utility.) ; ; Environment: ; ; VAX/VMS native mode, VMS V4.0 or later, Installed (on all ; machines in a VAXcluster) in the SYS$SHARE: directory (the ; common directory on a VAXcluster) with SYSPRV, NETMBX, WORLD, ; and OPER privileges, merged via LIB$FIND_IMAGE_SYMBOL. ; ; ; Version: V01.000 ; Date: 22-Jun-1987 ; ; Modifications: ; ;- .Page .Subtitle Shareable image transfer vectors .Psect CODE EXE,RD,NOWRT,PIC,SHR,PAGE .Transfer MAIL$PROTOCOL ;Generate a transfer vector .Mask MAIL$PROTOCOL ; and entry mask JMP LMAIL$PROTOCOL+2 ;Jump to the real code .Page .Subtitle Local definitions .NoCross ;Save a tree $CHFDEF ;Define condition handler facility stuff $DSCDEF ;Descriptor definitions $FABDEF ;FAB definitions $JPIDEF ;JPI item codes $PRVDEF ;Privilege bit masks $PSLDEF ;Processor status longword format $RABDEF ;RAB definitions $RMSDEF ;RMS junk $SSDEF ;System service codes $STSDEF ;Define error severity codes $TPADEF ;TPARSE definitions .Cross ;Turn CREF back on ; Local macros ; ITEM: Make an item list entry for $GETxxI Macro ITEM TYPE=JPI,ITEM=,LENGTH=4,RETADR=,RETLEN= .Word LENGTH,TYPE'$_'ITEM ;Length,,what .Address RETADR ;Put it here .If NB,RETLEN ;Have an explicit return length? .Address RETLEN ; then use it .Iff ; else .Long 0 ; we don't care .Endc ; ... Endm ITEM ; ... ; .ascip: Create a pointer to an .ascic string Macro .ascip STRING,?A ;Point to string descr in another PSECT .Enable LSB ;Turn on the local symbol block .Save ;Save the current PSECT .Psect STRINGS NOEXE,RD,NOWRT,PIC,SHR,PAGE A: .ascic \'STRING\ ;String .Restore ;Restore the current PSECT .Address A ;Store pointer to the string .Disable LSB ;Turn off the local symbol block Endm .ascip ; ... ; ADDRESS_MCB Get the address of the MCB (and check for error) macro ADDRESS_MCB TO,OK MOVL @MCB(AP),TO ;Address our MCB BNEQ OK ;If NEQ OK PUSHL #BIT$_NOMCB ;Error detail = No MCB CLRL -(SP) ;No FAO parameters PUSHL #BIT$_INTCODERR ;Error is Internal Coding Error CALLS #3,GLIB$STOP ;Signal the error endm ADDRESS_MCB ; Local definitions ; Mail major and minor protocol identifiers. These must be made univseral ; symbols via the linker to make MAIL happy. MAIL$C_PROT_MAJOR == 1 ;Major version MAIL$C_PROT_MINOR == 1 ;Minor version ; Mail function codes, taken from the SDL file for mail LNK_C_FIRST = 0 ;First function code LNK_C_OUT_CONNECT = 0 ;Outbound connect LNK_C_OUT_SENDER = 1 ;Output the sender (From:) line LNK_C_OUT_CKUSER = 2 ;Check for a valid user ID outbound LNK_C_OUT_TO = 3 ;Output the recipient (To:) line LNK_C_OUT_SUBJ = 4 ;Output the subject (Subject:) line LNK_C_OUT_FILE = 5 ;Output a file LNK_C_OUT_CKSEND = 6 ;Check to see if we can send a message LNK_C_OUT_DEACCESS = 7 ;Clean up after ourselves LNK_C_IN_CONNECT = 8 ;Inbound connect LNK_C_IN_SENDER = 9 ;Return the sender (From:) line LNK_C_IN_CKUSER = 10 ;Check for a valid user ID inbound LNK_C_IN_TO = 11 ;Return the recipient (To:) line LNK_C_IN_SUBJ = 12 ;Return the subject (Subject:) line LNK_C_IN_FILE = 13 ;Input a file LNK_C_IO_READ = 14 ;Read a line LNK_C_IO_WRITE = 15 ;Write a line LNK_C_LAST = 15 ;Last function code ; Argument list offsets MCB = 4 ;MCB address FUNC = 8 ;Function code ;func=0 F0_PROTOCOL = 12 ;-> descriptor of our protocol name F0_NODE = 16 ;-> descriptor of our node name F0_LOGLINK = 20 ;logical link (immediate) F0_RAT = 24 ;RAT of mail file (immediate) F0_RFM = 28 ;RFM of mail file (immediate) F0_FLAG = 32 ;global flags (immediate) F0_ATTFILE = 36 ;->descriptor of attached file ;func=1 F1_NODE = 12 ;->descriptor of senders node F1_USER = 16 ;->descriptor of senders username ;func=2 F2_NODE = 12 ;->descriptor of recipients node F2_USER = 16 ;->descriptor of recepients username F2_ERROR = 20 ;address of routine if bad recipient ;func=3 F3_NODE = 12 ;->descriptor of local node F3_LINE = 16 ;->descriptor of To: line ;func=4 F4_NODE = 12 ;->descriptor of local node F4_LINE = 16 ;->descriptor of Subj: line ;func=5 F5_NODE = 12 ;->descriptor of local node F5_RAB = 16 ;->RAB of file to be mailed F5_ERROR = 20 ;->routine to call in case of I/O error ;func=6 ;func=7 ;func=8 F8_XLATE = 12 ;->descriptor of input translate table F8_RAT = 16 ;FAB$B_RAT F8_RFM = 20 ;FAB$B_RFM F8_FLAGS = 24 ;MAIL$GL_SYSFLAGS F8_PROTOCOL = 28 ;->descriptor of protocol F8_SFLAGS = 32 ;server flags ;func=9 F9_LINE = 12 ;->descriptor to return From: line to ;func=10 F10_USER = 12 ;->descriptor to return recip username ;func=11 F11_LINE = 12 ;->descriptor to return To: line to ;func=12 F12_LINE = 12 ;->descriptor to return Subj: line to ;func=13 F13_UNUSED = 12 ;??? F13_RAB = 16 ;->output RAB F13_ERROR = 20 ;->routine to report an I/O error ;func=14 F14_LINE = 12 ;->descriptor to return something ;func=15 F15_LINE = 12 ;->descriptor of something MAIL sent us ; Message Context Block (MCB) ; ; A message context block is allocated for each incoming or outgoing message. ; This structure contains the validated address fields, the FAB and RAB for ; the mail file and a few other assorted pieces of information. ; ; Mail provides us a context variable when it calls us, which we use to store ; the address of this structure. ; ; MCBs are linked together (via the VAX-11 queue instructions) so that we may ; include the entire list of recipents of a message in the To: header line. ; ; This block is rather large... $DEFINI MCB ;Start of the MCB definitions $DEF MCB$L_MCBQFL .Blkl ;MCB queue forward link $DEF MCB$L_MCBQBL .Blkl ;MCB queue backward link $DEF MCB$L_RBQFL .Blkl ;RB queue forward link $DEF MCB$L_RBQBL .Blkl ;RB queue backward link $DEF MCB$L_CUR_RB .Blkl ;Current RB address $DEF MCB$B_FLAGS .Blkb ;Flags .Blkb 3 ;Reserved $DEF MCB$L_TPABLK .Blkb TPA$K_LENGTH0 ;Space for our TPARSE block $DEF MCB$Q_USER .blkq ;These two are used by TPARSE $DEF MCB$Q_NODE .blkq ; and thus must follow TPABLK $DEF MCB$Q_DESC .Blkq ;Scratch descriptor for ; formatting things $DEF MCB$Q_MSGID .Blkq ;Message ID (system time in ; hex plus some other stuff) $DEF MCB$L_FAB .Blkb FAB$C_BLN ;Space for our FAB $DEF MCB$L_RAB .Blkb RAB$C_BLN ;Space for our RAB $DEF MCB$T_USERNAME .Blkb 16 ;Our username (filled in by ; OUT_SENDER and LOOKUP_USER) $DEF MCB$L_FAOARGS .Blkl 20 ;An argument list for $FAOL $DEF MCB$T_SUBJECT .Blkb 256 ;Subject string (counted, built ; by OUT_LINE and IN_FILE) $DEF MCB$T_FROM .Blkb 256 ;From string (counted, built by ; OUT_SENDER and IN_SENDER) $DEF MCB$T_TO .Blkb 256 ;To: string as Mail sees it ; (counted, filled in by ; IN_TO and OUT_LINE) $DEF MCB$T_SCRATCH .blkb 512 ;Some working space $DEF MCB$K_LENGTH ;Length of an MCB ; Flags in MCB$B_FLAGS (not currently used) $VIELD MCB,0,<- ;Flags in MCB$B_FLAGS ,- ; This message was returned ,- ; Return receipt requested ,- ; We have a DECnet address ,- ; We have an attached file > ; ... $DEFEND MCB ;End of the MCB ; Recipient Block (RB) ; ; An RB is allocated for each recipeint of a message. Mail attempts to ; cut overhead by calling us only once per node with the function code ; to write a file, and expects us to deliver multiple copies of that ; file (a reasonable thing to do). $DEFINI RB ;Start of a Recipient Block $DEF RB$L_RBQFL .Blkl ;RB queue forward link $DEF RB$L_RBQBL .Blkl ;RB queue backward link $DEF RB$L_RECORDS .Blkl ;# of records written to file $DEF RB$L_MCB .Blkl ;Back pointer to the MCB $DEF RB$L_FAB .Blkb FAB$C_BLN ;Output FAB $DEF RB$L_RAB .Blkb RAB$C_BLN ;Output RAB $DEF RB$T_DESTUSER .Blkb 256 ;The destination username $DEF RB$T_NODENAME .Blkb 256 ;The destination node name $DEF RB$K_LENGTH ;Length of the RB $DEFEND RB ;End of the RB definitions .Page .Subtitle TPARSE state tables $INIT_STATE INTERNET_STATES,INTERNET_KEYS $STATE $TRAN !NETWORK_STYLE,TPA$_EXIT,STORE_ADDRESS $TRAN !DECNET_STYLE,TPA$_EXIT,STORE_ADDRESS $STATE NETWORK_STYLE ;look for USER@NODE $TRAN !NET_USER,,SET_USER ;Parse out the user-id $STATE $TRAN '@' $TRAN TPA$_LAMBDA $STATE ;Node next $TRAN !TO_EOS,TPA$_EXIT,SET_NODE ;Store the node name $STATE DECNET_STYLE ;look for NODE::USER $TRAN !NET_NODE,,SET_NODE ;Parse out the node $STATE $TRAN !COLON2 $STATE ;then the user-id $TRAN !TO_EOS,TPA$_EXIT,SET_USER ;Store the user-id ; Subexpression to parse a network user-id $STATE NET_USER ;Here to parse the user id $TRAN TPA$_LAMBDA,TPA$_EXIT,NET_SEP ;Quit when we find a node name. $TRAN !COLON2,TPA$_FAIL ;Oh ... a DECnet address! $TRAN TPA$_ANY,NET_USER ;ELSE accept anything else $TRAN TPA$_EOS,TPA$_EXIT ;no nodename, assume next node $STATE $TRAN TPA$_EOS,TPA$_FAIL ;error if nothing after the @ $TRAN TPA$_LAMBDA,TPA$_EXIT ; Subexpression to parse a decnet node name $STATE NET_NODE ;Here to parse a DECnet node $TRAN TPA$_LAMBDA,TPA$_EXIT,DEC_SEP ;Quit when we find the '::' $TRAN TPA$_ANY,NET_NODE ;any other character is ok $STATE $TRAN TPA$_EOS,TPA$_FAIL ;error if nothing after the :: $TRAN TPA$_LAMBDA,TPA$_EXIT $STATE COLON2 ;Here to search for '::' $TRAN ':' ;Is there a first colon $STATE $TRAN ':',TPA$_EXIT ;and a second one? $STATE TO_EOS ;get the rest of the address $TRAN TPA$_ANY,TO_EOS ;accept any character $TRAN TPA$_EOS,TPA$_EXIT ;Quit only at eos $END_STATE ;End of the state table .Page .Subtitle Impure storage .Psect IMPURE_DATA NOEXE,RD,WRT,PIC,NOSHR,PAGE MCB_Q: .Address MCB_Q ;Our MCB .Address MCB_Q ; queue FLAGS: .Blkl ;Flags (only 1 so far) NODE_DESC: .Long 64 ;Our local node name .Address NODE_NAME ; descriptor NODE_NAME: .Blkb 64 ;Our local nodename (from logical name) TIME_ZONE: .Long 4 ;Our time zone .Address TIME_ZONE_BUFF ; ... TIME_ZONE_BUFF: .Blkl ;Our timezone NEAR_DESC: .long 64 ;Our nearest neighbor node .address NEAR_NODE_BUFF NEAR_NODE_BUFF: .blkb 64 CUR_PRIVS: .Blkq ;My current privilege mask SYSPRV: .Long 1@PRV$V_SYSPRV,0 ;SYSPRV bit mask WORLD: .Long 1@PRV$V_WORLD,0 ;WORLD bit mask MAILSERVER_PID: .Blkl ;Mail server PID MAILSERVER_BUF: .Blkb 8 ;Mail server logical name ; Logical names which we need SPOOL_DIR: .ascid \BITNET_SPOOL\ ;Also used in INCOMING/OUTGOING BIT_NODE: .ascid \BITNET_NODENAME\ ;Should translate to something ; like ISUVAX.BITNET NEAR_NODE: .ascid \BITNET_NEXTNODE\ ;Nearest bitnet neighbor TIMEZONE: .ascid \BITNET_TIMEZONE\ ;Should translate to CST, CDT, ; EST, etc. MAILSERV: .ascid \BITNET_SERVER_PID\ ;Should translate to the mail ; server pid POSTMASTER: .ascid \BITNET_POSTMASTER\ ;Should translate to a username ; which will receive lost mail ; Stuff we need from $GETJPI JPI_INFO: ITEM ITEM=PROCPRIV,- ;Get my current privilege mask LENGTH=8,- ;8 bytes RETADR=CUR_PRIVS ;Put them here .Long 0 ;End of the table ; Days of the week WEEKDAYS: .ascip <> ;Unknown .ascip ;Monday .ascip ;Tuesday .ascip ;Wednesday .ascip ;Thursday .ascip ;Friday .ascip ;Saturday .ascip ;Sunday ; FAO control strings and other stuff ; first the BSMTP header FAO_HELO: .ascid \HELO !AD\ VERB: .ascic \VERB ON\ TICK: .ascic \TICK 0001\ FAO_MAIL_FROM: .ascid \MAIL FROM:\ FAO_RCPT_TO: .ascid \RCPT TO:\ DATA: .ascic \DATA\ ; then the ARPANET header FAO_DATE: .ascid \Date: !AC, !17%D !AS\ FAO_TO: .ascid \To: !AC@!AC!AC\ FAO_TO_CONT: .ascid \ !AC@!AC!AC\ COMMA: .ascic \,\ FAO_FROM: .ascid \From: (!AD)\ FAO_REPLY_TO: .ascid \Reply-To: !AC\ FAO_SUBJECT: .ascid \Subject: !AC\ FAO_X_VMS_TO: .ascid \X-VMS-To: !AC\ ; the message goes here (by the way), then the BSMTP trailer NULL: .ascic \\ PERIOD: .ascic \.\ QUIT: .ascic \QUIT\ FAO_IN_FROM: .ascid \BITNET%"!AD"\ ; Items searched for in the ARPA header HDR_SUBJECT: .ascid \Subject\ HDR_FROM: .ascid \From\ HDR_TO: .ascid \To\ GATEWAY: .ascic \WISCVM.WISC.EDU\ INCOMING: .ascic \BITNET_SPOOL:INCOMING.MSG\ OUTGOING: .ascic \BITNET_SPOOL:OUTGOING.MSG\ RETURN_RCPT: .ascic \[Return Receipt Requested]\ CLI_TOLIST: .ascid \TOLIST\ CLI_FILE: .ascid \FILE\ RETURNED: .ascid \[Bitnet_MailShr: Returned Network Mail]\ .Page .Subtitle MAIL$PROTOCOL - Bitnet mail dispatcher .Psect CODE EXE,RD,NOWRT,PIC,SHR,PAGE ;+ ; ; ----- MAIL$PROTOCOL: Foreign mail protocol handler ; ; ; This module is called by the VAX/VMS personal mail utility when it ; detects the presence of a string in the form: ; ; bitnet%"user@node" ; ; in the "to" line or the /Protocol=bitnet_mailshr (and we have DETACH and ; SYSPRV) to deliver incomming mail. ; ; Outbound mail is handled like this: The "to" string is parsed down into ; an internet address and stored in a structure representing an outgoing ; message (the MCB, or Message Context Block). The address of this block ; is stored in the context variable that mail passes to us. A file called ; ; SYS$SCRATCH:OUTGOING.MSG ; ; is opened and is submited to ISUMVS through a NJE interface. ; ; Inbound mail is somewhat more complicated: The NJE interface creates ; a detached process which runs a command file. We can replace that ; command file with one which contains a line like: ; ; MAIL/PROTOCOL=BITNET_MAILSHR filename ; ; which will be used to deliver inbound mail. Mail arrives in a file with ; a network header in the file BITNET_SPOOL:INCOMING.MSG. We pick apart ; the contents of this file, verify that the target user lives here, fix up ; a correct From: line (so that Reply will work) and deliver the mail. ; ; This routine merely dispatches to the correct routine based upon the ; function code that Mail passes us in the second argument (the first ; argument is our context pointer, which we are free to do whatever we ; wish with). ; ; Debugging this is 42 kinds of fun. Assemble and link this (assuming it ; isn't already), remembering to make this a shareable image and to promote ; MAIL$C_PROT_MAJOR and MAIL$C_PROT_MINOR to universal symbols (this is done ; for you if you use the command file that goes along with this). Then you ; have to patch this image and a private copy of MAIL.EXE thusly: ; ; $ Patch/Absolute BITNET_MAILSHR.EXE !Patch this image ; PATCH> Examine/Instr 80A !This should be the address of ; 0000080A: NOP !the NOP instructon below ; PATCH> Deposit/Instr 80A = "BPT" !Make it a BPT instruction ; PATCH> Update !Write the changed file ; PATCH> Exit !And now the MAIL.EXE ; ; $ Patch/Absolute SYS$LOGIN:MAIL.EXE !Patch a COPY!! ; PATCH> Deposit 20 = 1000029 !Set the debug bit (bit 0) ; PATCH> Examine 30 !1st Xfer address ; 00000030: 00001E10 !This is from V4.1 Mail ; PATCH> Deposit 30 = 7FFEDF68 !Make it the traceback handler ; PATCH> Deposit 34 = 00001E10 !Or whatever was in loc 30. ; PATCH> Update !Write it out ; PATCH> Exit !Ta dum ; ; Now define a logical name of MAIL to point to this patched version of ; Mail, copy BITNET_MAILSHR.EXE to SYS$SHARE: (the common directory if you ; are on a VAXcluster) and install the image as follows: ; ; $ Install :== $sys$system:install/command ; $ Install ; INSTALL> Add sys$share:bitnet_mailshr/open/head/share - ; /priv=(NETMBX,WORLD,SYSPRV,OPER) ; $ Exit ; ; There are several things which are important to remember: ; ; 1. Mail merges your shared image via LIB$FIND_IMAGE_SYMBOL at ; run time, so your code won't be loaded when the debugger ; announces itself (this is the reason for the BPT instruction). ; ; 2. Remember to do a SET EXECPTION BREAK command first thing in debug. ; ; 3. Remember to replace the BPT with a NOP when the exception ; hits, set a breakpoint there, and to a GO .+1 the first time ; to get past the exception ! ; ; 4. You may want to remove the requirement for executive mode ; logical names while you're debugging (makes things that much ; easier). ; ;------------------------------------------------------------------------- ; ; Inputs: ; ; 0(AP) - Number of arguments (varies with the function code) ; 4(AP) - Context block pointer ; 8(AP) - Function code ; ; Outputs: ; ; Control is passed to the appropriate routine to handle things. ; Error messages are signalled (Mail catches them). ; ;- .Entry MAIL$PROTOCOL,M ;Entry here NOP ;Replace this with BPT to debug!! NOP ;One more for good measure ; Get a condition handler so that we can accurately report errors (can't trust ; Mail). MOVAB COND_HANDLER,(FP) ;Establish our condition handler ; Dispatch to the correct spot based on function code: CASEB FUNC(AP),#LNK_C_FIRST,# ; Outbound mail 10$: .Word OUT_CONNECT-10$ ;Establish an outbound link ; (allocate a MCB) .Word OUT_SENDER-10$ ;Output the sender ; (parse username and personal name) .Word OUT_DEST-10$ ;Validate a the destination username .Word OUT_LINE-10$ ;Output the To: line .Word OUT_LINE-10$ ;Output the Subject: line .Word OUT_FILE-10$ ;Output a file (do all of the hard work) .Word WAKE_VAXNJI-10$ ;Check on the status of a recently sent ; file (wake up mailer process) .Word OUT_DEACCESS-10$ ;Clean up (deallocate an MCB) ; Inbound mail .Word IN_CONNECT-10$ ;Inbound connect request ; (allocate an MCB) .Word IN_SENDER-10$ ;Copy the From: line .Word IN_RECIP-10$ ;Return the next recipient .Word IN_TO-10$ ;Copy the To: line .Word IN_SUBJ-10$ ;Copy the Subject: line .Word IN_FILE-10$ ;Copy the file inbound (most of the ; work is done here) .Word IO_READ-10$ ;Read a record .Word IO_WRITE-10$ ;Write a record ; Unknown function code. Complain back at mail. PUSHL FUNC(AP) ;Stack the offending function code PUSHL #1 ;1 FAO parameter PUSHL #BIT$_UNKFUNC ;Unknown function code CALLS #3,GLIB$STOP ;Signal it back to mail .Page .Subtitle OUT_CONNECT - Outbound connect request ;+ ; ; ----- OUT_CONNECT: Outbound connect request ; ; ; This routine is called by the main line dispatcher when mail has requested ; that we make an outbound connect request. Since all we do is to write a ; file in a specific spot, we don't really have to "connect" to anything. ; Instead, we allocate and initialize an MCB and stash it to use later. ; ; Inputs: ; ; 0(AP) - 9 (arguments) ; 4(AP) - MCB address ; 8(AP) - Function code ; 12(AP) - Address of our protocol name descriptor ; 16(AP) - Address of our node name descriptor ; 20(AP) - MAIL$_LOGLINK (immediate) ; 24(AP) - RAT for the mail file (immediate) ; 28(AP) - RFM for the mail file (immediate) ; 32(AP) - MAIL$GL_FLAGS (immediate) ; 36(AP) - Address of the attached file descriptor ; ; Implicit inputs: ; ; Registers saved by the MAIL$PROTOCOL entry point; Our call frame ; must still be current. We will return via a RET instruction. ; ; Outputs: ; ; @4(AP) - Gets the MCB address ; R0 - Status ; ;- CONNECT_COMMON: .Word M<> ;Internal entry point. OUT_CONNECT: ;Ref. label MOVAQ -(SP),R7 ;Address some working storage ; Do some preliminaries like get our node name and privilege mask BBSS #0,FLAGS,10$ ;Have we already done this? BSBW RANDOM_INIT ;Else do random initializations ; Allocate an MCB 10$: MOVZWL #MCB$K_LENGTH,4(R7) ;Need this much memory PUSHAL (R7)+ ;Return the address here PUSHL R7 ;We want this much memory CALLS #2,GLIB$GET_VM ;Go allocate some memory BLBC R0,20$ ;Sigh. ; Initialize the MCB; do the FAB and RAB first MOVL -(R7),R7 ;Address the MCB MOVL R7,@MCB(AP) ;Store its address in the ; context variable MOVC5 #0,#0,#0,#MCB$K_LENGTH,(R7) ;Zero the MCB MOVAL MCB$L_FAB(R7),R0 ;Address the FAB MOVB #FAB$C_BID,FAB$B_BID(R0) ;Fill in the RMS block ID MOVB #FAB$C_BLN,FAB$B_BLN(R0) ;Fill in the RMS block length MOVAL MCB$L_RAB(R7),R0 ;Address the RAB MOVB #RAB$C_BID,RAB$B_BID(R0) ;Fill in the RMS block ID MOVB #RAB$C_BLN,RAB$B_BLN(R0) ;Fill in the RMS block length MOVAL MCB$L_FAB(R7),RAB$L_FAB(R0) ;Fill in the FAB address ; Initialize the TPARSE block MOVAL MCB$L_TPABLK(R7),R0 ;Address our TPARSE block MOVL #TPA$K_COUNT0+4,TPA$L_COUNT(R0) ;Fill in the argument count MOVL #<1@TPA$V_BLANKS>,TPA$L_OPTIONS(R0) ;Process blanks explicitly ; Initialize the rest of the block MOVAL MCB$L_RBQFL(R7),MCB$L_RBQFL(R7) ;Initialize the MOVAL MCB$L_RBQFL(R7),MCB$L_RBQBL(R7) ; RB queue header INSQUE (R7),@MCB_Q ;Tack onto the MCB queue ; We're done MOVL #SS$_NORMAL,R0 ;Success ! 20$: RET ;Back to MAIL .Page .Subtitle OUT_SENDER - Output the From: line ;+ ; ; ----- OUT_SENDER: Output the From: line ; ; ; This routine is called by the main line dispatcher to provide the text ; for the From: line back to Mail. It is here that we must create a ; valid internet From: string in the form: ; ; (personal-name) ;i.e., <[EVAX::]GAJPH%ISUVAX.BITNET@WISCVM.WISC.EDU> (John Hascall) ; ; Inputs: ; ; 0(AP) - 4 (arguments) ; 4(AP) - MCB address ; 8(AP) - Function code ; 12(AP) - Node descriptor address (for those who use CCVAX::Bitnet%...) ; 16(AP) - Sender descriptor addres (username plus personal name in "") ; ; Implicit inputs: ; ; Registers saved by the MAIL$PROTOCOL entry point; Our call frame ; must still be current. We will return via a RET instruction. ; ; Outputs: ; ; MCB$T_FROM filled in. ; ;- OUT_SENDER: ;Ref. label ADDRESS_MCB R11,10$ ; Parse down the username to locate the first trailing space and copy that ; into the line so far. Store this as the first FAO argument. 10$: MOVAB MCB$T_USERNAME(R11),R3 ;R3 -> username counted string MOVQ @F1_USER(AP),R8 ;Retrieve the username descriptor LOCC #A/ /,R8,(R9) ;Locate any trailing spaces SUBW3 R0,R8,R6 ;Length of the username in R6 MOVB R6,(R3)+ ;Store count for username MOVC3 R6,(R9),(R3) ;Copy in username ; Now construct the first part of the argument list, which is input to the ; first !AD in FAO_FROM... MOVAL MCB$L_FAOARGS(R11),R10 ;Address the FAO argument list MOVZWL R6,(R10)+ ;Length of the username MOVAB MCB$T_USERNAME+1(R11),(R10)+ ;Address of the username ; Next argument in the FAO list is the local node name and domain, which was ; gotten earlier when OUT_CONNECT was called for the first time (it's the ; translation of the logical name BITNET_NODENAME). MOVQ NODE_DESC,(R10)+ ;Store a descr of the node and domain ; The last argument is the personal name descriptor. If there is one, it will ; be at the end of the string mail fed us as the username wrapped up in a pair ; of ""s. We have two options of how we could construct an internet From: ; string. The first is the way we're doing it, which is to place the machine ; usable address first enclosed in <> and followed with the personal name in ; (). The () indicate that what's enclosed is a comment and for the incoming ; mailer to ignore it. ; ; The second option would be to put the personal name first (sans ()) followed ; by the machine usable address in <>. This scheme would require that we ; scan the personal name string for characters which require quoting and ; include the double quotes if any were found. All in all, I don't really ; think it matters all that much... LOCC #A/"/,R8,(R9) ;Do we have a personal name? BEQL 20$ ;If EQL no INCL R1 ;Point past this character SUBL #2,R0 ;Adjust the length to exclude both "s 20$: MOVQ R0,(R10)+ ;Store what LOCC left as ; the last FAO argument MOVZBL #255,MCB$Q_DESC(R11) ;Set length of the buffer MOVAB MCB$T_FROM+1(R11),MCB$Q_DESC+4(R11) ;Set address of the buffer $FAOL_S CTRSTR=FAO_FROM,- ;Format the OUTBUF=MCB$Q_DESC(R11),- ; From: line OUTLEN=MCB$Q_DESC(R11),- ; ... PRMLST=MCB$L_FAOARGS(R11) ; ... MOVB MCB$Q_DESC(R11),MCB$T_FROM(R11) ;Make a counted string for ; the From: line RET ;We're done (R0 has status) .Page .Subtitle OUT_DEST - Output the destination (To:) field ;+ ; ; ----- OUT_DEST: Output the destination (To:) field ; ; ; This routine is called by the main line dispatcher when it is called by ; Mail with a function code of LNK_C_OUT_CKUSER. This function is really ; supposed to be used to check for a valid username on a remote node, but ; we use it to construct an appropriate To: line instead (and check the ; syntax of what the user fed us as a side-effect). ; ; This routine will be called more than once per connection, with the ; last call having a null byte as the username string. The idea behind ; this is that Mail will only have to ship the message across the link ; once for multiple recipients on a remote node. However, if Mail does ; detect that we're sending messages to multiple nodes under a foreign ; protocol it calls us once per node (this only seems to happen if the ; address is specified DECnet style, i.e., BITNET%ISUMVS::GAJPH). ; ; Because we allocate a seperate RB for each recipient we have no problem ; sending multiple messages to multiple recipients on the same node. ; ; Inputs: ; ; 0(AP) - 5 arguments ; 4(AP) - MCB address ; 8(AP) - Function code ; 12(AP) - Address of a string descriptor containing the node name ; 16(AP) - Address of a string descriptor containing the addressee ; 20(AP) - Address of UTIL$REPORT_ERROR ; ; Implicit inputs: ; ; Registers saved by the MAIL$PROTOCOL entry point; Our call frame ; must still be current. We will return via a RET instruction. ; ; Outputs: ; ; The To: line is copied into an RB, and the RB is added to the ; RB chain in the MCB. ; ;- OUT_DEST: ;Ref. label MOVL #SS$_NORMAL,R0 ; Assume all is OK ADDRESS_MCB R11,20$ 10$: RET ; status in R0 ; Check for the null username string, and return if we find it 20$: MOVQ @16(AP),R1 ;Obtain the username descriptor TSTB (R2) ;Does it start with a null byte ? BEQL 10$ ;If EQL yes, we're done ; Ok. Allocate another RB for this guy. MOVAQ -(SP),R2 ;Address some scratch space MOVL #RB$K_LENGTH,4(R2) ;We need this much memory PUSHAL (R2)+ ;Return the address here PUSHL R2 ;We need this much memory CALLS #2,GLIB$GET_VM ;Go allocate some memory BLBC R0,10$ ;No! MOVL -(R2),R10 ;Address the RB MOVC5 #0,#0,#0,#RB$K_LENGTH,(R10) ;Zero the RB MOVAL RB$L_FAB(R10),R0 ;Address the FAB in the RB MOVB #FAB$C_BID,FAB$B_BID(R0) ;Make a FAB MOVB #FAB$C_BLN,FAB$B_BLN(R0) ; ... MOVAL RB$L_RAB(R10),R0 ;Address the RAB in the RB MOVB #RAB$C_BID,RAB$B_BID(R0) ;Make a RAB MOVB #RAB$C_BLN,RAB$B_BLN(R0) ; ... MOVAL RB$L_FAB(R10),RAB$L_FAB(R0) ;Point back to the FAB MOVL R11,RB$L_MCB(R10) ;Point back to the MCB INSQUE (R10),@MCB$L_RBQBL(R11) ;Insert this RB onto the RB queue ; Ok. We have something that looks like it might be a real username. What ; we have to do next is to see if we have a node descriptor (eg - someone ; used the ; ; Bitnet%WISCVM.WISC.EDU::USERID ; ; form of the address. This makes our life that much easier since we don't ; have to feed the string we got to TPARSE. Regardless of what username ; we got fed we subject it to logical name translation just because we're ; such Nice Guys (and No, we don't always finish last). MOVZWL #512,MCB$Q_DESC(R11) ;Create a descr of our scratch buffer MOVAB MCB$T_SCRATCH(R11),MCB$Q_DESC+4(R11) ; ... $TRNLOG_S LOGNAM=@16(AP),- ;Subject it to RSLBUF=MCB$Q_DESC(R11),- ; logical name RSLLEN=MCB$Q_DESC(R11) ; translation ; Store the UNtranslated form of our username argument for the To: string ; for the time being. MOVQ @16(AP),R0 ;Obtain the username descriptor MOVZBL R0,R0 ;Only 256 bytes, please MOVB R0,MCB$T_TO(R11) ;Make a counted string MOVC3 R0,(R1),MCB$T_TO+1(R11) ;Store the username string ; Now play around with the translation of the username to see what we can do... MOVQ MCB$Q_DESC(R11),R6 ;Get a descriptor of the result MOVZBL R6,R6 ;Only want up to 256 bytes... MOVB R6,RB$T_DESTUSER(R10) ;Store what we have as the MOVC3 R6,(R7),RB$T_DESTUSER+1(R10) ; destination username Just In Case ADDL R6,MCB$Q_DESC+4(R11) ;Update the descriptor to use a SUBL R6,MCB$Q_DESC(R11) ; different part of scratch buffer MOVQ @12(AP),R8 ;Retrieve the node descriptor TSTW R8 ;Do we have one ? BEQL 40$ ;Have to look in the username ; Ok. We have a seperate node name. Copy it into the destination node name ; spot. MOVZBL R8,R8 ;Only 255 characters please MOVB R8,RB$T_NODENAME(R10) ;Make it an .ascic string MOVC3 R8,(R9),RB$T_NODENAME+1(R10) ;Store the node name ; At some point we should do intellegent domain routing here !!! 30$: MOVL #SS$_NORMAL,R0 ;Success ! RET ;We're done ; Oh well. Feed the translation of the username string to TPARSE and ; see if it can isolate the node name... 40$: MOVL R10,MCB$L_CUR_RB(R11) ;Stash the current RB address MOVAL MCB$L_TPABLK(R11),R2 ;Address our TPARSE block CLRL TPA$L_OPTIONS(R2) ;Clear the options word MOVQ R6,TPA$L_STRINGCNT(R2) ;Store a descr of the string to parse PUSHAL INTERNET_KEYS ;Stack the keyword table address PUSHAL INTERNET_STATES ;Stack the state table address PUSHL R2 ;Stack the TPARSE block address CALLS #3,GLIB$TPARSE ;Parse out the node name BLBS R0,50$ ;Branch if we won PUSHL #BIT$_INVADDR ;Else signal an CALLS #1,GLIB$SIGNAL ; error message MOVL #BIT$_INVADDR,R0 ;And return it ; We're done (at last) 50$: RET ;Back to Mail, status in R0 .Page .Subtitle OUT_LINE - Output a known line ;+ ; ; ----- OUT_LINE: Output a known line ; ; ; This routine is called by the main line dispatcher to output one of the ; Subject: or To: lines. In the case of the To: line, OUT_DEST has already ; been called to properly format the destination address and this information ; has been stored in the MCB. We don't have to do anything special for the ; subject line. ; ; Inputs: ; ; 0(AP) - 4 (arguments) ; 4(AP) - MCB address ; 8(AP) - Function code ; 12(AP) - Address of our node descriptor ; 16(AP) - Address of the descriptor of the line to copy ; ; Implicit inputs: ; ; Registers saved by the MAIL$PROTOCOL entry point; Our call frame ; must still be current. We will return via a RET instruction. ; ; Outputs: ; ; The appropriate field in the MCB is filled in with the line ; mail feeds us. ; ; R0 - Contains the return status ; ;- OUT_LINE: ;Ref. label ADDRESS_MCB R11,10$ ;Find our trusty MCB 10$: MOVQ @16(AP),R0 ;Retrieve a descr of the line to move MOVZBL R0,R0 ;Clean out cruft. ; Check for either LNK_C_OUT_TO or LNK_C_OUT_SUBJECT... MOVAB MCB$T_TO(R11),R10 ;Presume we need to fill in the To: line CMPB #LNK_C_OUT_TO,FUNC(AP) ;Output the To: line? BEQL 20$ ;If EQL yes, march onward MOVAB MCB$T_SUBJECT(R11),R10 ;Else we fill in the Subject: line 20$: MOVB R0,(R10)+ ;Copy the string length MOVC3 R0,(R1),(R10) ;Copy the string MOVL #SS$_NORMAL,R0 ;Success ! RET ;Back to MAIL .Page .Subtitle OUT_FILE - Send a file ;+ ; ; ----- OUT_FILE: Send a file ; ; ; This is where all of the real work for outbound mail goes on. ; ; Inputs: ; ; 0(AP) - 5 (arguments) ; 4(AP) - MCB address ; 8(AP) - Function code ; 12(AP) - Address of our node name descriptor ; 16(AP) - Address of the RAB for the message file ; 20(AP) - Address of a routine to call to report an I/O error ; ; Implicit inputs: ; ; Registers saved by the MAIL$PROTOCOL entry point; Our call frame ; must still be current. We will return via a RET instruction. ; ; Outputs: ; ; A internet-style file is created, the stuff from the MCB is copied ; into said file, and the mail delivery agent is awakened. ; ; R0 - Status. ; ;- OUT_FILE: ;Ref. label ; First things first: Create the outgoing file. ADDRESS_MCB R11,10$ ; Ok. Walk through the RB chain and open each outgoing mail file. 10$: $GETTIM_S MCB$Q_MSGID(R11) ;Get the current time for the message ID BSBW ENABLE_SYSPRV ;Turn on SYSPRV PUSHAB WALK_RB_Q ;Set up a co-routine linkage 20$: JSB @(SP)+ ;Get the address of the next RB BLBC R0,30$ ;Branch if there isn't one MOVAB RB$L_FAB(R10),R9 ;Address the FAB MOVAB OUTGOING,R0 ;Address the mail file name MOVZBL (R0)+,R1 ;Obtain the length of said file name $FAB_STORE FAB=(R9),- ;Store the FNS=R1,- ; length of the file name and the FNA=(R0),- ; address of the file name FAC=,- ;Read, write and update access FOP=,- ;Sequential only RAT=,- ;Implied carriage control ORG=,- ;A sequential file RFM=,- ;Variable length records LNM_MODE=#PSL$C_EXEC ;Executive mode logicals only (SYSPRV!) $CREATE FAB=(R9),ERR=@20(AP) ;Create the outgoing mail file BLBC R0,50$ ;Sigh. $CONNECT RAB=RB$L_RAB(R10),ERR=@20(AP) ;Connect up a record stream BLBC R0,50$ ;Oh well. BRB 20$ ;Continue the loop ; Write out the header records 30$: BSBW DISABLE_SYSPRV ;Turn off SYSPRV PUSHAB WALK_RB_Q ;Co-routine to walk through the RB queue 40$: JSB @(SP)+ ;Get the next RB address BLBS R0,60$ ;Branch if we won MOVL #SS$_NORMAL,R0 ;Success! 50$: RET ;Back to Mail ; Start writing the file header. 60$: ; Now write the ersatz BSMTP envelope, which looks like: ; ; HELO nodename ; MAIL FROM: ; RCPT TO: ; DATA ; HELO nodename MOVQ NODE_DESC,MCB$L_FAOARGS(R11) ;Copy the node name descriptor MOVAQ FAO_HELO,R5 ;Here's the format string BSBW FAO_RCD ;FAO and write a record ; VERB ON MOVAB VERB,R5 BSBW WRITE_RCD ; TICK 0001 MOVAB TICK,R5 BSBW WRITE_RCD ; MAIL FROM: MOVAB MCB$T_USERNAME(R11),MCB$L_FAOARGS(R11) ;1st parm is username MOVQ NODE_DESC,MCB$L_FAOARGS+4(R11) ;2nd parm is the node MOVAQ FAO_MAIL_FROM,R5 ;The control string BSBW FAO_RCD ;Format & write it out ; RCPT TO: MOVAB RB$T_DESTUSER(R10),MCB$L_FAOARGS(R11) ;1st parm is destination ; username MOVAB RB$T_NODENAME(R10),MCB$L_FAOARGS+4(R11) ;2nd parm is the node MOVAQ FAO_RCPT_TO,R5 ;The control string BSBW FAO_RCD ;Format & write a record ; DATA MOVAB DATA,R5 ;Address the DATA line BSBW WRITE_RCD ;Write it out ; At this point we have completed writing out the mail header and the ; ersatz BSMTP header. The next thing we do is to write out our RFC-822 ; header fields, which are: ; ; Date: ; From: ; To: ; Subject: ; ; Then we write out any user headers, and follow it with a header item ; of our own which reflects the string VMS Mail fed us for To:. ; Date: Needs formatting PUSHAL MCB$L_FAOARGS(R11) ;Return the day number here PUSHAQ MCB$Q_MSGID(R11) ;Use the current system time CALLS #2,GLIB$DAY_OF_WEEK ;Get the day of the week MOVL MCB$L_FAOARGS(R11),R0 ;Retrieve the day of the week MOVL WEEKDAYS[R0],MCB$L_FAOARGS(R11) ;Store the address of the .ascic ; day of the week string CLRL MCB$L_FAOARGS+4(R11) ;Use the current system time MOVAQ TIME_ZONE,MCB$L_FAOARGS+8(R11) ;Here's our time zone MOVAQ FAO_DATE,R5 ;Address the control string BSBW FAO_RCD ;FAO and write a record ; From: (already formatted by OUT_SENDER) MOVAB MCB$T_FROM(R11),R5 ;Address the From: line BSBW WRITE_RCD ;Write it out ; To: This is a can of worms, because we have to walk through all of the ; MCBs associated with this message in order to accurately reflect ; all of the recipients in each message header. Let's call another ; routine to do all of this work... BSBW RECIPIENTS ;Do all of the recipients ; Subject: Needs formatting MOVAB MCB$T_SUBJECT(R11),MCB$L_FAOARGS(R11) ;Create the FAO arg list MOVAQ FAO_SUBJECT,R5 ;Address the control string BSBW FAO_RCD ;FAO and write a record ; One last header item: the X-VMS-Mail-To: string MOVAB MCB$T_TO(R11),MCB$L_FAOARGS(R11) ;Only one argument - whatever ; VMS mail gave us for To: MOVAQ FAO_X_VMS_TO,R5 ;The FAO control string BSBW FAO_RCD ;FAO and write a record ; Now copy all of the data from the file Mail is feeding us into the current ; outbound mail file. Note that Mail may have wanted us to use block I/O ; on this message. While this is a nice gesture, I'm not really set up to ; cope with it correctly. Hence, we disconnect the RAB, twiddle the block ; I/O bit and reconnect it (Thank You Kevin Carosso). CLRL R0 ;Write an MOVL SP,R1 ; empty record BSBW WRITE_RCD_1 ; ... MOVL 16(AP),R9 ;Address Mail's RAB $DISCONNECT RAB=(R9) ;Disconnect it for a second BICL #RAB$M_BIO,RAB$L_ROP(R9) ;Clear the block I/O bit $CONNECT RAB=(R9) ;Connect it back up $REWIND RAB=(R9) ;Rewind it back to the beginning $RAB_STORE RAB=(R9),- ;Store the UBF=MCB$T_SCRATCH(R11),- ;record buffer address and the USZ=#512 ; buffer size 70$: $GET RAB=(R9) ;Read a record BLBC R0,90$ ;Hope for EOF 80$: MOVAB MCB$T_SCRATCH(R11),R1 ;Address the record text MOVZWL RAB$W_RSZ(R9),R0 ;Get the length of the record BSBW WRITE_RCD_1 ;Write it out BRB 70$ ;Around and around we go ; Here when we got an RMS error. If it's EOF, it's not an error. If ; it's RMS$_RTB, ignore it. Anything else we feed to UTIL$REPORT_ERROR. 90$: CMPL #RMS$_RTB,R0 ;Record too big to fit ? BEQL 80$ ;If EQL yes, ignore the error CMPL #RMS$_EOF,R0 ;End of file ? BNEQ 110$ ;If NEQ no, die a miserable death ; Write out the BSMTP trailer: ; MOVAB NULL,R5 BSBW WRITE_RCD ; . MOVAB PERIOD,R5 BSBW WRITE_RCD ; QUIT MOVAB QUIT,R5 BSBW WRITE_RCD ; all finished, close the file BSBW ENABLE_SYSPRV ;VMS V4.2+ requires SYSPRV to close ; a file opened with SYSPRV ! $CLOSE FAB=RB$L_FAB(R10) ;Close the file ! BSBW DISABLE_SYSPRV ;Restore the previous state of SYSPRV BRW 40$ ;Do the next RB ; Here on some hopeless I/O error. Let Mail cope with it. 110$: PUSHL R9 ;Stack the RAB address CALLS #1,@20(AP) ;Call Mail back MOVL RAB$L_STS(R9),R0 ;Copy the status back out of the RAB RET ;Sigh .Page .Subtitle FAO_RCD - $FAOL and write a record ;+ ; ; ----- FAO_RCD: $FAOL and write a record ; ; ; This routine is called to pass a string to $FAOL and then write the ; result to the outgoing mail file. ; ; Inputs: ; ; R11 - MCB address ; R10 - RB address ; R5 - FAO control string address ; ; Outputs: ; ; Record written to the outgoing mail file. ; ;- FAO_RCD: ;Ref. label MOVZWL #512,MCB$Q_DESC(R11) ;Build a descr of scratch buffer MOVAB MCB$T_SCRATCH(R11),MCB$Q_DESC+4(R11) ; ... $FAOL_S CTRSTR=(R5),- ;Format the OUTBUF=MCB$Q_DESC(R11),- ; string OUTLEN=MCB$Q_DESC(R11),- ; ... PRMLST=MCB$L_FAOARGS(R11) ; ... MOVQ MCB$Q_DESC(R11),R0 ;Retrieve a descriptor of the result BRB WRITE_RCD_1 ;Write the record out .Page .Subtitle WRITE_RCD - Write a .ascic string ;+ ; ; ----- WRITE_RCD: Write a .ascic string ; ; ; This routine will write a .ascic string to the file pointed to by ; the RAB in the current RB. ; ; Inputs: ; ; R10 - RB address ; R5 - .ascic string address ; ; Outputs: ; ; R0 - Status ; R1,R2 - Destroyed ; ;- WRITE_RCD: ;Ref. label MOVL R5,R1 ;Copy the string address MOVZBL (R1)+,R0 ;Obtain the length of the string WRITE_RCD_1: ;Ref. label MOVAL RB$L_RAB(R10),R2 ;Address the RAB $RAB_STORE RAB=(R2),- ;Store the RBF=(R1),- ; record buffer address and the RSZ=R0 ; record size $PUT RAB=(R2),ERR=@20(AP) ;Write the record out BLBC R0,10$ ;No! INCL RB$L_RECORDS(R10) ;Count up another record written RSB ;Done 10$: RET ;Sigh. Back to Mail .Page .Subtitle WALK_RB_Q - Coroutine to walk around an RB queue ;+ ; ; ----- WALK_RB_Q: Coroutine to walk around an RB queue ; ; ; This routine will establish a co-routine linkage with it's caller, ; returning once for each RB attached to an MCB. ; ; Inputs: ; ; (SP) - Callback address ; ; Outputs: ; ; R0 - 0, no more RBs ; R0 - 1, R10 has another RB address ; ;- WALK_RB_Q: ;Ref. label MOVAL MCB$L_RBQFL(R11),R10 ;Address the RB queue header MOVL R10,MCB$L_CUR_RB(R11) ;Save it somewhere safe 10$: CLRL R0 ;Default to no RB found MOVL (R10),R10 ;Chain to the next RB CMPL R10,MCB$L_CUR_RB(R11) ;Have we walked all the way around yet? BEQL 20$ ;If EQL yes, give up. INCL R0 ;Else indicate that we have another RB JSB @(SP)+ ;Call the caller back BRB 10$ ;And look for another RB 20$: RSB ;We're done .Page .Subtitle RECIPIENTS - Add in all of the recipients ;+ ; ; ----- RECIPIENTS: Add in all of the recipients ; ; ; This routine is called by OUT_FILE when we are actually writing a file ; to be delivered outbound. What we have to do is to walk around our MCB ; queue and copy all of the recipients out of the RBs attached to those ; MCBs into the message. This could potentially be quite a few, but since ; we're trying to do this right we may as well go whole hog. ; ; According to RFC-822, if we have multiple recipients we're supposed to ; have just one To: line and seperate all of the recipients with commas. ; To make my life easier, all of the recipients get seperated with commas ; AND get put on seperate lines. ; ; Inputs: ; ; R11 - Current MCB address ; R10 - Current RB address ; ; Implicit Inputs: ; ; The outbound mail file is opened with the FAB being in the RB. ; ; Outputs: ; ; The MCB queue and all of the RB queues are walked through ; and all of the recipients are added to the To: string. ; ;- RECIPIENTS: ;Here to add all of the recipients in ; First count the number of recipients MOVAB MCB_Q,R8 ;Address the MCB queue header MOVL R8,R7 ;Twice CLRL R9 ;Clear the MCB count ; Outer loop: Walk the MCB queue 10$: MOVL (R8),R8 ;Chain to the next MCB CMPL R8,R7 ;Have we wrapped around yet ? BEQL 30$ ;If EQL yes. MOVAL MCB$L_RBQFL(R8),R5 ;Address the RB queue header MOVL R5,R4 ;Twice ; Inner loop: Walk the RB queue 20$: MOVL (R5),R5 ;Chain to the next RB CMPL R5,R4 ;Have we walked all the way around yet ? BEQL 10$ ;If EQL yes INCL R9 ;Count up another RB BRB 20$ ;And look for another ; Ok. At this point, we know how many recipients there are. Start at ; the first MCB and format the To: line... 30$: MOVAB FAO_TO,R5 ;Address the format string MOVAL MCB_Q,R8 ;Address the MCB queue header MOVL R8,R7 ;Twice ; Outer loop: Walk the MCB queue 40$: MOVL (R8),R8 ;Address the next MCB CMPL R8,R7 ;Have we walked all the way around yet ? BEQL 70$ ;If EQL yes, we're done MOVAL MCB$L_RBQFL(R8),R6 ;Address the RB queue forward link MOVL R6,MCB$L_CUR_RB(R8) ;Save it somewhere safe ; Inner loop: Walk the RB queue 50$: MOVL (R6),R6 ;Chain to the next RB CMPL R6,MCB$L_CUR_RB(R8) ;Have we walked all the way around yet ? BEQL 40$ ;If EQL yes, onward MOVAB RB$T_DESTUSER(R6),MCB$L_FAOARGS(R11) ;First arg is To: string MOVAB RB$T_NODENAME(R6),MCB$L_FAOARGS+4(R11) ;Second arg is the node MOVAB NULL,MCB$L_FAOARGS+8(R11) ;Presume we're the last recipient DECL R9 ;Are we the last recipient ? BLEQ 60$ ;If LEQ yes MOVAB COMMA,MCB$L_FAOARGS+8(R11) ;Else append a comma 60$: BSBW FAO_RCD ;Write out the next part of the To: line MOVAB FAO_TO_CONT,R5 ;Use continuation next time (if any) BRB 50$ ;To the next RB ; We're done. 70$: RSB ;Back to OUT_FILE. .Page .Subtitle WAKE_VAXNJI - Wake up VAXNJI ;+ ; ; ----- WAKE_VAXNJI: Wake up VAXNJI ; ; ; This routine will awaken our mail delivery agent (VAXNJI). ; ; Inputs: ; ; Implicit inputs: ; ; Registers saved by the MAIL$PROTOCOL entry point; Our call frame ; must still be current. We will return via a RET instruction. ; WORLD privilege. ; ; Outputs: ; ; VAXNJI awakened to transport our mail. ; ;- WAKE_VAXNJI: ;Ref. label BBS #PRV$V_WORLD,CUR_PRIVS,10$ ;Branch if we already have WORLD $SETPRV_S ENBFLG=S#1,- ;Else enable PRVADR=WORLD,- ; WORLD for PRMFLG=S#0 ; a bit 10$: ; $WAKE_S PIDADR=MAILSERVER_PID ;Wake up VAXNJI BBS #PRV$V_WORLD,CUR_PRIVS,20$ ;Have to turn off WORLD? $SETPRV_S ENBFLG=S#0,- ;Else disable PRVADR=WORLD,- ; WORLD privs PRMFLG=S#0 ; ... 20$: MOVL #SS$_NORMAL,R0 ;Ignore errors RET ;Back to MAIL .Page .Subtitle OUT_DEACCESS - Clean up after mail delivery ;+ ; ; ----- OUT_DEACCESS: Clean up after mail delivery ; ; ; This routine is called to perform any cleanup after the delivery of ; a mail message. We simply deallocate all of the RBs associated with ; the MCB, and then deallocate the MCB itself. ; ; Inputs: ; ; 0(AP) - 2 (arguments) ; 4(AP) - MCB address ; 8(AP) - Function code ; ; Implicit inputs: ; ; Registers saved by the MAIL$PROTOCOL entry point; Our call frame ; must still be current. We will return via a RET instruction. ; ; Outputs: ; ; Virtual memory returned. ; ;- OUT_DEACCESS: ;Here to clean up BSBW DISABLE_SYSPRV ;Just In Case MOVAQ -(SP),R7 ;Address some scratch storage ADDRESS_MCB R11,10$ ; Walk around the MCB chain, deallocating them as we go... 10$: REMQUE @MCB$L_RBQFL(R11),R0 ;Remove the next RB BVS 20$ ;If VS, deallocate the MCB next MOVL #RB$K_LENGTH,(R7)+ ;The block is this big MOVL R0,(R7) ;And the address is here PUSHL R7 ;Stack the address of the block address PUSHAL -(R7) ;Stack the address of the block size CALLS #2,GLIB$FREE_VM ;Free up the RB BRB 10$ ;Loop ; Free up the MCB 20$: REMQUE (R11),R11 ;Remove the MCB from the MCB queue MOVL #MCB$K_LENGTH,(R7)+ ;An MCB is this big MOVL R11,(R7) ;And ours is here PUSHL R7 ;The MCB is here PUSHAL -(R7) ;It's this big CALLS #2,GLIB$FREE_VM ;Release the MCB RET ;Back to Mail .Page .Subtitle TPARSE ACTION ROUTINES .Subtitle CLEAR_BOTH .Subtitle SET_USER .Subtitle SET_NODE .Subtitle STORE_ADDRESS ;+ ; ; ----- CLEAR_BOTH: Zero both the username/nodename descriptors ; ----- SET_USER: Save a pointer and length to the destination user ; ----- SET_NODE: Save a pointer and length to the destination node ; ----- STORE_ADDRESS: Save the user/node in the RB ; ; ; ; The first three routines are called as action routines by LIB$TPARSE to: ; 1) clear the username/nodename pointers in the TPARSE block extension ; 2) store the address and length of the username portion of the destination ; address in the extension of the TPARSE parameter block. ; 3) store the address and length of the nodename portion of the destination ; address in the extension of the TPARSE parameter block ; The fourth routine is called to store the above information in the RB. ; ; Inputs: ; ; 0(AP) - 8 (arguments) ; 4(AP) - TPA$L_OPTIONS: Flags ; 8(AP) - TPA$L_STRINGCNT: Length of the input string remaining ; 12(AP) - TPA$L_STRINGPTR: Address of the input string remaining ; 16(AP) - TPA$L_TOKENCNT: Length of the current token ; 20(AP) - TPA$L_TOKENPTR: Address of the current token ; 24(AP) - TPA$B_CHAR: Character that matched last ; 28(AP) - TPA$L_NUMBER: Binary value of last numeric token ; 32(AP) - TPA$L_PARAM: Parameter supplied in the state table ; ; Outputs: ; ; 36(AP) A word to store the length of the username ; 40(AP) A longword to store the address of the username ; 44(AP) A word to store the length of the nodename ; 48(AP) A longword to store the address of the nodename ; ; The modified RB ;- CLEAR_BOTH: .word M<> ; Clean up any left over descr CLRQ 36(AP) CLRQ 44(AP) MOVL #SS$_NORMAL,R0 RET SET_USER: .word M<> ; Store decsr for username MOVZBL TPA$L_TOKENCNT(AP),36(AP) MOVL TPA$L_TOKENPTR(AP),40(AP) MOVL #SS$_NORMAL,R0 RET SET_NODE: .word M<> ; Store descr for nodename MOVZBL TPA$L_TOKENCNT(AP),44(AP) MOVL TPA$L_TOKENPTR(AP),48(AP) MOVL #SS$_NORMAL,R0 RET NET_SEP: .word M<> ; Are we at a '@'? CLRL R0 TSTL TPA$L_STRINGCNT(AP) BEQL 99$ CMPB @TPA$L_STRINGPTR(AP),#A'@' BNEQ 99$ INCL R0 99$: RET DEC_SEP: .word M ; Are we at a '::' CLRL R0 CMPL TPA$L_STRINGCNT(AP),#2 BLSS 99$ MOVL TPA$L_STRINGPTR(AP),R2 CMPB (R2),#A':' BNEQ 99$ CMPB 1(R2),#A':' BNEQ 99$ INCL R0 99$: RET STORE_ADDRESS: .word M ; Store all that stuff MOVAB MCB$L_MCBQFL-MCB$L_TPABLK(AP),R6 ;R6 -> beginning of MCB MOVL MCB$L_CUR_RB(R6),R7 ;R7 -> current RB MOVB 36(AP),RB$T_DESTUSER(R7) ;store the length MOVC3 36(AP),@40(AP),RB$T_DESTUSER+1(R7) ;and the text TSTB 44(AP) ;is nodename null? BNEQ 10$ MOVB NEAR_DESC,RB$T_NODENAME(R7) ;then use neighbor's MOVC3 NEAR_DESC,@NEAR_DESC+4,RB$T_NODENAME+1(R7) ; nodename BRB 20$ 10$: MOVB 44(AP),RB$T_NODENAME(R7) ;store the length MOVC3 44(AP),@48(AP),RB$T_NODENAME+1(R7) ;and the text 20$: MOVL #SS$_NORMAL,R0 RET .Page .Subtitle IN_CONNECT - Inbound connect request ;+ ; ; ----- IN_CONNECT: Inbound connect request ; ; ; This routine is called by Mail for us to establish context to deliver ; inbound foreign mail. We allocate an MCB for this to keep track of ; things. ; ; $ Mail/Protocol=Bitnet_mailshr BITNET_SPOOL:INCOMING.MSG;ver ; ; It is our responsibility at that point to read the header records from ; the inbound mail file and fill in the appropriate fields in ; the MCB. Mail only calls IN_CONNECT once no matter how many recipients ; there are, since until we tell it how many, how does it know? ; ; Inputs: ; ; 0(AP) - 8 (arguments) ; 4(AP) - MCB address ; 8(AP) - Function code ; 12(AP) - Input translation table descriptor address ; 16(AP) - Record attributes (FAB$B_RAT) ; 20(AP) - Record format (FAB$B_RFM) ; 24(AP) - MAIL$GL_SYSFLAGS ; 28(AP) - Address of the protocol descriptor ; 32(AP) - Server flags ; ; Inplicit inputs: ; ; Registers saved by the MAIL$PROTOCOL entry point; Our call frame ; must still be current. We will return via a RET instruction. ; ; Outputs: ; ; An MCB is allocated and it's address is stored for later use. ; A RB is allocated for each recipient found in the mail header. ; The header from the input mail file is digested and the relevant ; information is stored in the MCB and RB(s) for later use. ; ;- IN_CONNECT: ;Here to process an inbound connect CALLG (AP),CONNECT_COMMON ;Let OUT_CONNECT do some of the work BLBS R0,10$ RET ;Propagate any errors back to Mail 10$: MOVL @MCB(AP),R11 ;Address MCB(initialized by OUT_CONNECT) ; Retrieve the name of the file to deliver from DCL. This comment was in the ; original code: <<>>, I have not ; noticed this problem here (at ISU). MOVAB MCB$T_SCRATCH(R11),MCB$Q_DESC+4(R11) ;Fill in the MOVZWL #512,MCB$Q_DESC(R11) ; scratch descriptor PUSHAQ MCB$Q_DESC(R11) ;Return the length here PUSHL (SP) ;It's also the output descriptor address PUSHAQ CLI_FILE ;We want this parameter CALLS #3,GCLI$GET_VALUE ;Go retrieve the file name BLBS R0,20$ RET ;Give up if $GET_VALUE fails 20$: MOVZWL MCB$Q_DESC(R11),R2 ;Obtain the length of the file name BGTR 30$ ; PUSHL #BIT$_NOINFILE ;Stack the error code CALLS #1,GLIB$STOP ;Signal it ; Open the specified file 30$: MOVAL MCB$L_RAB(R11),R9 ;Address our RAB $FAB_STORE - FAB=MCB$L_FAB(R11),- ;Fill in the FAB: FAC=,- ;Read only access FNA=MCB$T_SCRATCH(R11),- ;File name address FNS=R2,- ;File name size LNM_MODE=#PSL$C_EXEC ;Exec mode logicals (SYSPRV!) $OPEN FAB=MCB$L_FAB(R11) ;Open up the file BLBC R0,40$ $CONNECT RAB=(R9) ;Connect up a record stream BLBS R0,50$ ;Branch if success 40$: BRW 920$ ;Report RMS error ; Ok. Now we have to read the first several records from the input file, ; which comprise the mail header. 50$: $RAB_STORE - RAB=(R9),- ;Store the UBF=MCB$T_SCRATCH(R11),- ; address of and the USZ=#512 ; size of our record buffer CLRL MCB$T_SCRATCH(R11) $GET RAB=(R9) ;Read the first record BLBC R0,40$ ;Error? CMPL MCB$T_SCRATCH(R11),#A'HELO' ;BSMTP? BEQL 60$ BRW 91$ ;no BSMTP header, do our best ; Scan for BSMTP keywords here 60$: CLRL MCB$T_SCRATCH(R11) $GET RAB=(R9) BLBC R0,40$ ;I/O error CMPL MCB$T_SCRATCH(R11),#A'RCPT' BEQL 81$ CMPL MCB$T_SCRATCH(R11),#A'MAIL' BEQL 82$ CMPL MCB$T_SCRATCH(R11),#A'TICK' ;Ignored BEQL 60$ CMPL MCB$T_SCRATCH(R11),#A'VERB' ;Ignored BEQL 60$ CMPL MCB$T_SCRATCH(R11),#A'DATA' BNEQ 60$ ;If we don't know what it is, ignore it BRW 90$ 70$: BRW 910$ ;Don't know what to do with header item 80$: BRW 900$ ;Header Item has invalid format ; Here we have found a 'RCPT TO:' record 81$: MOVAQ -(SP),R2 ;some scratch space MOVL #RB$K_LENGTH,4(R2) ;#bytes to get PUSHAL (R2)+ ;the address goes here PUSHL R2 ;#bytes CALLS #2,GLIB$GET_VM ;Get some memory BLBC R0,70$ MOVL -(R2),R10 ;R10->newly allocated RB MOVC5 #0,#0,#0,#RB$K_LENGTH,(R10) ;Zero the RB MOVL R11,RB$L_MCB(R10) ;Point back to the MCB INSQUE (R10),@MCB$L_RBQBL(R11) ;Insert RB onto the RB queue LOCC #A'<',RAB$W_RSZ(R9),MCB$T_SCRATCH(R11) ;Find the leading '<' BEQL 80$ ;Didn't find the '<' DECL R0 ;don't include the '<' ADDL3 #1,R1,R3 ;R3->user@node LOCC #A'@',R0,(R3) BEQL 80$ ;didn't find the '@' SUBL3 R3,R1,R2 ;R2=length(user) MOVB R2,RB$T_DESTUSER(R10) ;Build a .ascic string MOVC3 R2,(R3),RB$T_DESTUSER+1(R10) ;Copy user into RB BRW 60$ ; Here we have found a 'MAIL FROM:' record 82$: LOCC #A'<',RAB$W_RSZ(R9),MCB$T_SCRATCH(R11) ;Find the leading '<' BEQL 80$ ;Didn't find the '<' DECL R0 ;don't include the '<' ADDL3 #1,R1,R3 ;R3->user@node LOCC #A'>',R0,(R3) BEQL 80$ ;didn't find the closing '>' SUBL3 R3,R1,R2 ;R2=length(user@node) MOVAB MCB$T_FROM+1(R11),MCB$Q_DESC+4(R11) ;Build the output descr MOVZBL #255,MCB$Q_DESC(R11) ;Length of string is 255 bytes. $FAO_S - CTRSTR=FAO_IN_FROM,- ;Format the From: string OUTBUF=MCB$Q_DESC(R11),- ;Output buffer is here OUTLEN=MCB$Q_DESC(R11),- ;Return the length there, too P1=R2,P2=R3 ;Use these 2 parameters MOVB MCB$Q_DESC(R11),MCB$T_FROM(R11) ;Build a .ascic string BRW 60$ ; Here we have found the 'DATA' record and are finished with the BSMTP header ; Ok. Now save the RFA of this record and begin to scan forward to locate ; the Subject: line. If we don't find one before the end of the file, NBD. 90$: $GET RAB=(R9) ;Get past the 'DATA' record BLBC R0,100$ ;error? 91$: PUSHAB MCB$T_SUBJECT(R11) ;where to put it, if we find it PUSHAQ HDR_SUBJECT ;what to look for PUSHAL (R9) ;Address of the RAB CALLS #3,gSCANHDR ; maybe look at some of the other ARPA header items here? 100$: RET ;Back to Mail (finally!) ; Here is where we handle problems from IN_CONNECT ; Here when we have an illegally formatted user-ID or node name. 900$: PUSHL #BIT$_INVSOURCE ;Error detail CLRL -(SP) ;No FAO parameters PUSHL #BIT$_INVMSGFIL ;Error type CALLS #3,GLIB$STOP ;Signal the error ; Here when we got an input error on the mail file. Punt. 910$: PUSHL R0 ;Stack the RMS error code PUSHL #BIT$_INPERR ;Stack our own prefix CALLS #2,GLIB$STOP ;Signal the error ; RMS errors reported here 920$: PUSHAQ MCB$Q_DESC(R11) ;Stack the file name descriptor address PUSHL #1 ;1 FAO argument PUSHL R0 ;The RMS error code PUSHL #BIT$_OPENIN ;Stack our error code CALLS #4,GLIB$STOP ;Signal the error ; Local subroutine to scan the file whose RAB is 4(AP) for the ARPA header ; item whose descriptor is at 8(AP) and store it (.ascic) at @12(AP) SCANHDR: .word M MOVL 8(AP),R8 ;R8 -> item descriptor MOVL 4(AP),R9 ;Put the RAB in R9 MOVL RAB$W_RFA(R9),R6 ;Stash the RFA MOVZWL RAB$W_RFA+4(R9),R7 ; of this record somewhere safe $RAB_STORE - RAB=(R9),- ;Ensure that UBF=MCB$T_SCRATCH(R11),- ; we have a valid USZ=#512 ; input buffer MOVAB MCB$T_SCRATCH(R11),MCB$Q_DESC+4(R11) ;Prepare to build a ; descriptor of the record 100$: $GET RAB=(R9) ;Read the next record BLBC R0,130$ ;Maybe EOF? CMPW (R8),RAB$W_RSZ(R9) ;Length look good ? BGEQ 100$ ;If GEQ no, save some effort MOVZWL (R8),MCB$Q_DESC(R11) ;Dummy up a descriptor PUSHAQ MCB$Q_DESC(R11) ;Stack string 2 PUSHAQ (R8) ;Stack string 1 CALLS #2,GSTR$CASE_BLIND_COMPARE ;Compare the string, case blind BLBS R0,100$ ;If LBS, not the item string. MOVZWL RAB$W_RSZ(R9),MCB$Q_DESC(R11) ;Create a descriptor of the record ; Ok. Now scan past the XXXXXXX: string, and to the first non-blank after ; that. From there to the end of the string comprises what we will feed ; Mail for the item. MOVZWL (R8),R0 ;Get the length of that string ADDL R0,MCB$Q_DESC+4(R11) ;And point past it SUBL R0,MCB$Q_DESC(R11) ;Remove it from the length MOVQ MCB$Q_DESC(R11),R0 ;Retrieve a descr of the item: LOCC #A/:/,R0,(R1) ;Is there a trailing : around? BNEQ 110$ ;If NEQ yes. MOVQ MCB$Q_DESC(R11),R0 ;Else pretend we saw one 110$: SKPC #A/:/,R0,(R1) ;Skip over the colon if there SKPC #A/ /,R0,(R1) ;Skip over leading blanks SKPC #A/ /,R0,(R1) ; and tabs 120$: MOVQ R0,MCB$Q_DESC(R11) ;Store a new string descriptor MOVL 12(AP),R1 ;R1 -> where to store string MOVB R0,(R1) ;Make counted string for item MOVC3 R0,(R1),1(R1) ;Move the string ; Now restore the position within the file so that we return the ; right info to the user... 130$: $RAB_STORE - RAB=(R9),- ;Convert to RAC= ; access by RFA for a few usec MOVL R6,RAB$W_RFA(R9) ;Restore the MOVW R7,RAB$W_RFA+4(R9) ; RFA of the end of the header $FIND RAB=(R9) ;Position the file there $RAB_STORE - RAB=(R9),- ;And go back to RAC= ; sequential access RET .Page .Subtitle IN_SENDER - Input the From: line .Subtitle IN_TO - Input the To: line .Subtitle IN_SUBJ - Input the Subject: line ;+ ; ; ----- IN_SENDER: Input the From: line ; ----- IN_TO: Input the To: line ; ----- IN_SUBJ: Input the Subject: line ; ; ; These routines are called to return the From: and To: lines to Mail. ; IN_CONNECT and IN_RECIP have already formatted the complete strings ; for us, so all we have to do is to copy it to Mail's address space. ; ; Inputs: ; ; 0(AP) - 3 (arguments) ; 4(AP) - MCB address ; 8(AP) - Function code ; 12(AP) - Place to return the string. ; ; Implicit inputs: ; ; Registers saved by the MAIL$PROTOCOL entry point; Our call frame ; must still be current. We will return via a RET instruction. ; ; Outputs: ; ; String returned to Mail. ; ;- IN_TO: MOVL #MCB$T_TO,R0 ;Address the proper string BRB IN_LINE ;Return this line IN_SENDER: ;Here to return the From: line MOVL #MCB$T_FROM,R0 ;Address the From: string BRB IN_LINE ;Join common code IN_SUBJ: ;Here to return the Subject: string MOVL #MCB$T_SUBJECT,R0 ;Address the Subject: string IN_LINE: ;Ref. label ADDRESS_MCB R11,10$ 10$: ADDL R11,R0 ;Point to the correct string to copy MOVAQ -(SP),R7 ;Address some scratch storage MOVZBL (R0)+,(R7) ;Create a MOVL R0,4(R7) ; string descriptor of the string PUSHL 12(AP) ;Stack the destination string address PUSHL R7 ;Stack the source string address CALLS #2,GLIB$SCOPY_DXDX ;Copy the string RET ;We're done .Page .Subtitle IN_RECIP - Input the next recipient ;+ ; ; ----- IN_RECIP: Input the next recipient ; ; ; This routine is called by Mail to return the next recipient of a message. ; We simply remove the head of the RB queue and return RB$T_DESTUSER, which ; was filled in by IN_CONNECT when it digested the BSMTP header. If the ; queue is empty we return the NULL byte to mail to indicate no more ; recipients. ; ; Inputs: ; ; 0(AP) - 3 (arguments) ; 4(AP) - MCB address ; 8(AP) - Function code ; 12(AP) - Place to return the next recipient string ; ; Implicit inputs: ; ; Registers saved by the MAIL$PROTOCOL entry point; Our call frame ; must still be current. We will return via a RET instruction. ; ; Outputs: ; ; The next recipient string is returned to Mail. ; The first RB in the queue attached to the MCB is freed. ; ;- IN_RECIP: ;Ref. label ADDRESS_MCB R11,10$ 10$: REMQUE @MCB$L_RBQFL(R11),R10 BVS 20$ MOVZBL RB$T_DESTUSER(R10),MCB$Q_DESC(R11) MOVAB RB$T_DESTUSER+1(R10),MCB$Q_DESC+4(R11) BRB 30$ ; We've run out of recipients. Return the null string to mail. 20$: TSTB MCB$T_TO(R11) ;Were there any recipients? BNEQ 21$ CLRL R10 ;No RB here MOVQ POSTMASTER,MCB$Q_DESC(R11) ;No, let someone know BRB 30$ 21$: MOVQ @12(AP),R0 ;Obtain the descriptor CLRB (R1) ;Return the null byte MOVL #1,@12(AP) ; to Mail MOVL #SS$_NORMAL,R0 ;Sort of success RET ;Done ; Return the string to Mail. 30$: PUSHAQ MCB$Q_DESC(R11) ;Stack the source descriptor address PUSHL 12(AP) ;Stack the destination descr address CALLS #2,GSTR$UPCASE ;Copy the uppercase of the string ; Append this string onto the accumulating To: string MOVZBL MCB$T_TO(R11),R6 ;Get the length of the To: string so far SUBL3 R6,#255,R0 ;Get the room left in the buffer CMPW R0,MCB$Q_DESC(R11) ;Is there enough room ? BLEQ 50$ ;If LEQ no, just forget it MOVAB MCB$T_TO+1(R11)[R6],R3 ;Get the address of the next free byte TSTL R6 ;Is this the first one ? BEQL 40$ ;If EQL yes, no comma the first time MOVB #A',',(R3)+ ;Move in a comma INCL R6 ;Increase the length to account for it 40$: MOVC3 MCB$Q_DESC(R11),@MCB$Q_DESC+4(R11),(R3) ;Move in this name ADDL MCB$Q_DESC(R11),R6 ;Add in the length we moved MOVB R6,MCB$T_TO(R11) ;Store it. ; free the RB (if any) TSTL R10 ; No RB if going to POSTMASTER BEQL 50$ MOVAQ -(SP),R2 MOVL #RB$K_LENGTH,(R2)+ MOVL R10,(R2) PUSHL R2 PUSHAL -(R2) CALLS #2,gLIB$FREE_VM 50$: MOVL #SS$_NORMAL,R0 ;Normal completion RET ;Back to Mail .Page .Subtitle IN_FILE - Input the mail file ;+ ; ; ----- IN_FILE: Input the mail file ; ; ; This routine is called by Mail to copy the text from the input file to ; the destination mail file. We basically just copy stuff from the input ; file to the output file and quit when we reach the end of the input file. ; ; ; Inputs: ; ; 0(AP) - 5 (arguments) ; 4(AP) - MCB address ; 8(AP) - Function code ; 12(AP) - Scratch (unused) ; 16(AP) - Pointer to the output RAB ; 20(AP) - Address of UTIL$REPORT_IO_ERROR ; ; Implicit inputs: ; ; Registers saved by the MAIL$PROTOCOL entry point; Our call frame ; must still be current. We will return via a RET instruction. ; ; Outputs: ; ; The contents of the inbound mail file are returned. ; ;- IN_FILE: ;Ref. label ADDRESS_MCB R11,10$ 10$: MOVL 16(AP),R10 ;Address our output RAB MOVAL MCB$L_RAB(R11),R9 ;Address our input RAB ; Now just loop copying text from our input RAB to the output RAB, and ; quit at EOF. 40$: $RAB_STORE - RAB=(R10),- ;Store the RBF=MCB$T_SCRATCH(R11) ; output buffer address $RAB_STORE - RAB=(R9),- ;Store the UBF=MCB$T_SCRATCH(R11),-; input buffer address and the USZ=#512 ; input buffer size 50$: $GET RAB=(R9) ;Get another record BLBC R0,60$ ;Maybe EOF? BSBB 100$ ;check for BSMTP '.' and/or 'QUIT' BLBC R0,60$ $RAB_STORE - RAB=(R10),- ;Store the size of RSZ=RAB$W_RSZ(R9) ; this record $PUT RAB=(R10),ERR=@20(AP) ;Write it out BLBS R0,50$ ;Loop if success ; Here to check for EOF and gripe if not. 60$: CMPL #RMS$_EOF,R0 ;End of file ? BNEQ 70$ ;If NEQ no, not an error $CLOSE FAB=MCB$L_FAB(R11) ;Else close the input file RET ;And return back to Mail ; Here when we have an error; Fake a call to UTIL$REPORT_IO_ERROR 70$: PUSHL R0 ;Save the error code PUSHL R9 ;Stack the RAB address CALLS #1,@20(AP) ;Call UTIL$REPORT_IO_ERROR POPL R0 ;Restore the error code 80$: RET ;And return it to Mail ; check for BSMTP '.' and 'QUIT' records 100$: MOVZWL RAB$W_RSZ(R9),R0 BEQL 120$ ;record length is 0, can't be a '.' CMPB MCB$T_SCRATCH(R11),#A'.' ;1st character a '.'? BNEQ 120$ DECL R0 ;length after the '.' SKPC #A' ',R0,MCB$T_SCRATCH+1(R11) ;is it the last non-blank char? BNEQ 120$ $GET RAB=(R9) ; We found a lone '.' BLBC R0,130$ MOVZWL RAB$W_RSZ(R9),R0 CMPW R0,#4 ; check length BLSS 140$ CMPL MCB$T_SCRATCH(R11),#A'QUIT' BNEQ 140$ SUBL2 #4,R0 SKPC #A' ',R0,MCB$T_SCRATCH+4(R11) ;any non-blanks after 'QUIT'? BNEQ 140$ MOVL #RMS$_EOF,R0 ;No, this is the end RSB 120$: MOVL #1,R0 ;Ordinary exit 130$: RSB 140$: MOVL RAB$L_RBF(R10),R4 ;Save RBF MOVZBL #A'.',-(SP) ;A place for the period $RAB_STORE - RAB=(R10),- ;Store the RBF=(SP),- ; address and RSZ=#1 ; length of the record $PUT RAB=(R10),ERR=@20(AP) ;Write it out TSTL (SP)+ MOVL R4,RAB$L_RBF(R10) ;Restore the saved RBF BRB 130$ .Page .Subtitle IO_READ - Perform a read request for Mail ;+ ; ; ----- IO_READ: Perform a read request for Mail ; ; ; This routine is never called by Mail as far as I can tell. ; ; Inputs: ; ; 0(AP) - 3 (arguments) ; 4(AP) - MCB address ; 8(AP) - Function code ; 12(AP) - String descriptor address to return something to Mail in ; ; Implicit inputs: ; ; Registers saved by the MAIL$PROTOCOL entry point; Our call frame ; must still be current. We will return via a RET instruction. ; ; Outputs: ; ; SS$_NORMAL. ; ;- IO_READ: ;Ref. label MOVL #SS$_NORMAL,R0 ;Success! RET ;Back to Mail .Page .Subtitle IO_WRITE - Perform a write request for Mail ;+ ; ; ----- IO_WRITE: Perform a write request for Mail ; ; ; This routine is called by Mail to return status information to us. ; Two kinds of arguments come to this routine: status codes (i.e., ; things you might find in R0) and message text strings. Status codes ; are returned to Mail in R0. Error message strings are ignored since ; Mail has already output them once, and we have nobody to send them ; to. ; ; Inputs: ; ; 0(AP) - 3 (arguments) ; 4(AP) - MCB address ; 8(AP) - Function code ; 12(AP) - A descriptor of the information Mail wants to pass to us ; ; Implicit inputs: ; ; Registers saved by the MAIL$PROTOCOL entry point; Our call frame ; must still be current. We will return via a RET instruction. ; ; Outputs: ; ; As described above. ; ;- IO_WRITE: ;Ref. label MOVL #SS$_NORMAL,R0 ;Presume it's a text string MOVQ @12(AP),R2 ;Obtain the descriptor CMPW #4,R2 ;Is this a status code? BNEQ 10$ ;If NEQ no, ignore it. MOVL (R3),R0 ;Else return the status code to Mail 10$: RET ;Back to Mail .Page .Subtitle RANDOM_INIT - Perform random initializations ;+ ; ; ----- RANDOM_INIT: Perform random initializations ; ; ; This routine is called by the outbound and inbound dispatcher to initialize ; things for us. We retrieve our privilege mask and translate a few logical ; names which are important to us. ; ; Inputs: ; ; R7 - Address of a quadword of scratch storage ; ; Implicit inputs: ; ; Registers saved by the MAIL$PROTOCOL entry point; Our call frame ; must still be current. We will return via a RET instruction. ; ; Outputs: ; ; Several logical names are translated and we retrieve our ; privilege mask. ; ;- RANDOM_INIT: ;Random initializations $GETJPI_S - ITMLST=JPI_INFO ;Get my privilege mask $TRNLOG_S - LOGNAM=BIT_NODE,- ;Translate our RSLBUF=NODE_DESC,- ; host node name RSLLEN=NODE_DESC ; ... $TRNLOG_S - LOGNAM=TIMEZONE,- ;Translate our RSLBUF=TIME_ZONE,- ; time zone RSLLEN=TIME_ZONE ; ... $TRNLOG_S - LOGNAM=NEAR_NODE,- ; Translate our RSLBUF=NEAR_DESC,- ; nearest neighbor's node name RSLLEN=NEAR_DESC MOVL #8,(R7) ;Stash the length of the buffer MOVAB MAILSERVER_BUF,4(R7) ;Stash the address of the buffer $TRNLOG_S - LOGNAM=MAILSERV,- ;Translate our RSLBUF=(R7) ; mail server's PID PUSHAL MAILSERVER_PID ;Return the result here PUSHAB MAILSERVER_BUF ;Here's the buffer PUSHL #8 ;Here's the length CALLS #3,GLIB$CVT_HTB ;Convert it to binary RSB ;Done .Page .Subtitle ENABLE_SYSPRV - Turn on SYSPRV if we don't have it ;+ ; ; ----- ENABLE_SYSPRV: Turn on SYSPRV if we don't already have it ; ; ; This routine will turn on SYSPRV if we don't already have it. ; ; Inputs: ; ; CUR_PRIVS - My current privilege mask ; ; Outputs: ; ; SYSPRV turned on if we don't already have it ; ;- ENABLE_SYSPRV: ;Here to enable SYSPRV BBS #PRV$V_SYSPRV,CUR_PRIVS,10$ ;Branch if we already have it $SETPRV_S ENBFLG=S#1,- ;Enable SYSPRV PRVADR=SYSPRV,- ; ... PRMFLG=S#0 ; ... 10$: RSB ;Done; status in R0 .Page .Subtitle DISABLE_SYSPRV - Disable SYSPRV if we didn't have it ;+ ; ; ----- DISABLE_SYSPRV: Disable SYSPRV if we didn't have it to begin with ; ; ; This routine will turn off SYSPRV if we didn't have it to begin with. ; ; Inputs: ; ; CUR_PRIVS - Our current privilege mask ; ; Outputs: ; ; SYSPRV disabled if we didn't have it to begin with ; ;- DISABLE_SYSPRV: ;Here to disable SYSPRV BBS #PRV$V_SYSPRV,CUR_PRIVS,10$ ;Branch if we had it to begin with $SETPRV_S ENBFLG=S#0,- ;Else turn off PRVADR=SYSPRV,- ; SYSPRV PRMFLG=S#0 ; ... 10$: RSB ;Done .Page .Subtitle COND_HANDLER - Condition handler ;+ ; ; ----- COND_HANDLER: Condition handler ; ; ; This routine is the condition handler for this module. It seems that Mail ; ignores signals from time to time, causing bogus error messages to crop up ; and generally screwing up mail delivery (especially inbound mail). Hence, ; we establish our own condition handler which does what every red-blooded ; condition handler ought to: output an error message and exit with status ; if the error condition was severe. ; ; Inputs: ; ; CHF$L_SIGARGLST(AP) - Signal argument vector address ; CHF$L_MECARGLST(AP) - Mechanism argument vector address ; ; Outputs: ; ; An error message is output to SYS$OUTPUT and SYS$ERROR using ; $PUTMSG. Image exit will be forced if the error was SEVERE. ; ;- COND_HANDLER: .Word M ;Here on a signalled error MOVL CHF$L_SIGARGLST(AP),R2 ;Address the signal vector SUBL #2,(R2) ;Never mind the PC and PSL $PUTMSG_S MSGVEC=(R2) ;Output the error code(s) CMPZV #STS$V_SEVERITY,#STS$S_SEVERITY,- CHF$L_SIG_NAME(R2),#STS$K_SEVERE ;Severe (fatal) error ? BEQL 10$ ;If EQL yes, force image exit MOVL #SS$_CONTINUE,R0 ;Else contine the RET ; previous thread of execution 10$: BISL3 #STS$M_INHIB_MSG,- CHF$L_SIG_NAME(R2),R0 ;Don't output the message twice $EXIT_S R0 ;Exit with status .End $END-OF-FILE $! $create/log del.com $deck/dollars="$END-OF-FILE" $ set noon $ write sys$output "De-assigning system logical names" $ deass/system/exec bitnet_spool $ deass/system/exec bitnet_nodename $ deass/system/exec bitnet_nextnode $ deass/system/exec bitnet_timezone $ deass/system/exec bitnet_postmaster $ deass/system/exec bitnet_server_pid $ write sys$output "De-installing bitnet protocol image" $ ins*tall :== $sys$system:install/command $ install remove sys$share:bitnet_mailshr.exe $ write sys$output "Removing bitnet protocol executable from sys$share" $ set proc/priv=bypass $ delete/noconfirm sys$share:bitnet_mailshr.exe.* $ set proc/priv=nobypass $ exit $END-OF-FILE $! $create/log new.com $deck/dollars="$END-OF-FILE" $ set noon $ write sys$output "Copying bitnet protocol executable to sys$share" $ copy/read/write/nolog bitnet_mailshr.exe SYS$COMMON:[SYSLIB] $ write sys$output "Setting world access to protocol executable" $ set prot=(w:re) sys$common:[syslib]bitnet_mailshr.exe $ write sys$output "Installing bitnet protocol image" $ ins*tall :== $sys$system:install/command $ install add sys$share:bitnet_mailshr.exe/open/head/shar/priv=(world,netmbx,oper,sysprv) $ write sys$output "Defining system logical names" $ write sys$output " Bitnet_spool - Temporary file storage directory" $ define/nolog/system/exec/trans=concealed bitnet_spool isu000:[jgajph.scratch] $ write sys$output " Bitnet_nodename - Bitnet address of this node" $ define/nolog/system/exec bitnet_nodename ISUVAX.BITNET $ write sys$output " Bitnet_nextnode - Bitnet address of nearest neighbor" $ define/nolog/system/exec/trans=terminal bitnet_nextnode ISUMVS.BITNET $ write sys$output " Bitnet_timezone - Local timezone (i.e., CDT) $ define/nolog/system/exec/trans=terminal bitnet_timezone CDT $ write sys$output " Bitnet_postmaster - Local username to receive lost mail" $ define/nolog/system/exec bitnet_postmaster GAJPH $ write sys$output " Bitnet_server_pid - Process to signal to transmit mail" $ define/nolog/system/exec bitnet_server_pid 0 $ exit $END-OF-FILE $! $create/log test.mar $deck/dollars="$END-OF-FILE" .title BITNET_MAILER .psect READWRITE,RD,WRT,NOEXE null = 0 bell = 7 lf = 10 cr = 13 OUTBUF:: .blkb 256 FAOSTR:: .ascid \BITNET MAILER: Protocol message code !UL (!AS) received\ FAOSTR2:: .ascid \BITNET MAILER: Status message code !XL received\ FAOSTR3:: .ascid \BITNET MAILER: From: <[!AS]!AS>\ FAOSTR4:: .ascid \BITNET MAILER: To: <[!AS]!AS>\ MYUSERID:: .ascid \GAJPH\ NOMORE:: .ascid USERMSG:: .ascid \BITNET MAILER: Recipient is GAJPH\ NULLMSG:: .ascid \BITNET MAILER: No more recipients\ LNK_MSG0:: .ascid \Outbound Connect\ LNK_MSG1:: .ascid \Outbound From:\ LNK_MSG2:: .ascid \Outbound Userid Validate\ LNK_MSG3:: .ascid \Outbound To:\ LNK_MSG4:: .ascid \Outbound Subject:\ LNK_MSG5:: .ascid \Outbound File Send\ LNK_MSG6:: .ascid \Outbound Check Send\ LNK_MSG7:: .ascid \Disconnect\ LNK_MSG8:: .ascid \Inbound Connect\ LNK_MSG9:: .ascid \Inbound From:\ LNK_MSG10:: .ascid \Inbound Userid Validate\ LNK_MSG11:: .ascid \Inbound To:\ LNK_MSG12: .ascid \Inbound Subject:\ LNK_MSG13:: .ascid \Inbound File Receive\ LNK_MSG14:: .ascid \Read a line\ LNK_MSG15:: .ascid \Write a line\ LNK_ADDR:: .address LNK_MSG0 .address LNK_MSG1 .address LNK_MSG2 .address LNK_MSG3 .address LNK_MSG4 .address LNK_MSG5 .address LNK_MSG6 .address LNK_MSG7 .address LNK_MSG8 .address LNK_MSG9 .address LNK_MSG10 .address LNK_MSG11 .address LNK_MSG12 .address LNK_MSG13 .address LNK_MSG14 .address LNK_MSG15 INDSC:: .long 80 .address OUTBUF OUTDSC:: .long 80 .address OUTBUF MAIL$C_PROT_MAJOR == 1 MAIL$C_PROT_MINOR == 1 .psect CODE,RD,NOWRT,EXE .entry MAIL$PROTOCOL,M MOVL 8(AP),R2 ; R2 has func code MOVAL LNK_ADDR,R3 PUSHL (R3)[R2] ; get appropriate message text PUSHL R2 PUSHAQ INDSC PUSHAW OUTDSC PUSHAQ FAOSTR CALLS #5,gSYS$FAO PUSHAQ OUTDSC CALLS #1,gLIB$PUT_OUTPUT MOVAQ FAOSTR3,R2 CMPL 8(AP),#1 ; message type #1 BEQL 11$ MOVAQ FAOSTR4,R2 CMPL 8(AP),#2 ; message type #2 BNEQ 13$ 11$: PUSHL 16(AP) PUSHL 12(AP) PUSHAQ INDSC PUSHAW OUTDSC PUSHL R2 CALLS #5,GSYS$FAO PUSHAQ OUTDSC CALLS #1,GLIB$PUT_OUTPUT 13$: CMPL 8(AP),#15 BNEQ 88$ MOVQ @12(AP),R2 CMPW R2,#4 BNEQ 77$ PUSHL (R3) PUSHAQ INDSC PUSHAW OUTDSC PUSHAQ FAOSTR2 CALLS #4,gSYS$FAO PUSHAQ OUTDSC CALLS #1,gLIB$PUT_OUTPUT CLRQ -(SP) PUSHAQ INDSC PUSHAW OUTDSC PUSHL (R3) CALLS #5,gSYS$GETMSG PUSHAQ OUTDSC CALLS #1,gLIB$PUT_OUTPUT MOVL #1,R0 BRB 99$ 77$: PUSHL 12(AP) CALLS #1,gLIB$PUT_OUTPUT BRB 99$ 88$: CMPB 8(AP),#10 BNEQ 99$ CMPL @4(AP),#5555 BEQL 89$ MOVL #5555,@4(AP) PUSHAQ MYUSERID PUSHL 12(AP) CALLS #2,gSTR$COPY_DX PUSHAQ USERMSG CALLS #1,gLIB$PUT_OUTPUT BRB 99$ 89$: PUSHAQ NOMORE PUSHL 12(AP) CALLS #2,gSTR$COPY_DX PUSHAQ NULLMSG CALLS #1,gLIB$PUT_OUTPUT BRB 99$ 99$: RET .end $END-OF-FILEllonn, th,