🚀 go-pugleaf

!----------------------  MAILSHR_PATCH_FOR_AT_02.COM -----------------
MAILSHR.EXE
!
! Modifed Nov, 1990, RPW to replace IN%"  with  MX%" and to make the form
!    user@system translate into mx%"user@system" instead of system::user
!
! This patch will be of interest to any VAX/VMS system (more especially if it
! is running PMDF) since it lets TO: or CC: addresses such as
! user%machine@site.co.org to be accepted without the IN% prefix and without
! surrounding double quotes.  Yes, let's admit it, it lets VMS mail accept Un*x
! type addresses.  In addition to its original goal, the format of this
! modification is also original by the fact of the straight macro code that
! can easily be modified/expanded or altered (ie IN% could become M_INTERNET::
! in the case of most Schlumberger VMS nodes)
! If the address is "similar" (see algorithm below) to user%machine@site.co.org
! it is simply rewritten as IN%"user%machine@site.co.org" and passed along.
! At the same time, user@machine will be accepted and rewritten as machine::user
! If the IN% prefix is not the one in use on your VAX/VMS system, but XYZ% is,
! then all you have to do is $ DEFINE/SYSTEM/EXECUTIVE -
!       MAIL$PROTOCOL_IN -
!       XYZ_ROOT:[EXE]XYZ_MAILSHR       ! or wherever the XYZ overlay for MAIL
!                                       ! might be located and installed from
!
! See additional impact remarks below.
!
! This patch applies to SYS$LIBRARY:MAILSHR.EXE (usually SYS$COMMON:[SYSLIB])
! from VMS 5.0 to Field Test version of 5.4 as of June 1990
!
!       We recommend:
!
!       $ SET DEFAULT SYS$COMMON:[SYSLIB]
!       $ INSTALL:= $INSTALL/COMMAND
!       $ PATCH @ this_file.COM
!       $ INSTALL REPLACE SYS$COMMON:[SYSLIB]MAILSHR.EXE
!
! Claude Barbe - Schlumberger-Doll Research - Ridgefield, CT - USA
! (Internet) barbe@sdr.slb.com (a happy hacker of MAIL and PMDF for over 3yr)
!
! 3-Jul-1990
!
! No warranty implied.  This can be freely copied and altered.  Use it at
! your own risks.  It is probably pure chance if it ever worked on a
! particular system.
!
! Additional remarks on the impact of this patch
!
! 1) With this patch in place we hope to make addressing unique in the VMS world
!    whether a message is sent via DECnet or via a foreign protocol (such as
!    the successful/affordable PMDF) without forcing any one to use prefixes
!    and/or quotes.  Quotes are to be avoided by all means since MAIL and DEC's
!    MRGATE interface have no mechanisms to imbed quoted addresses between
!    quotes (ie MRGATE and PMDF cannot carry the same message!)
! 2) There are risks of confusion for new users who will learn that the Un*x
!    addressing format works on a patched VMS system and who will never bother
!    to know the DEC way to send mail with double colons between node and
!    username until they use a non patched VMS system
! 3) The patch will certainly break when DECnet node names will contain dots
!    but this is in DECnet phase V and we still have to see a field test
!    for this product.  By that time a better patch will be developped or
!    whatever foreign protocol is used (PMDF by default) will just handle
!    these deliveries that could have gone also more simply across DECnet
! 4) The patch is far from being fully RFC822 compliant and there are risks
!    that some users will be confused by the lack of completeness.  This
!    in some case will be due to the approach taken in this patch where,
!    instead of redoing the address parsing that DEC is doing in MAIL, we
!    simply hacked a string filter on a "DEC approved string" which has already
!    been pruned of commas and exclamation points.  Users familiar with "bang"
!    addresses will still have to say IN%"node!node!user@relay.somewhere"
! 5) After a few extra weeks of testing on a larger scale, this patch will be
!    submitted to DEC as an SPR for improvement.  Hopefully, then DEC will
!    support the de facto standard (or at least the most commonly used part
!    of it).  In the mean time let's try to let our users access Internet
!    addresses in the most natural way.  At last!
!
! Validity of this patch
!
! It has only been tested on VMS 5.3-1 but is expected to work on VMS 5.0 to 5.4
! (well, 5.4 is not out yet, so at least up to T5.4-4).  This part of the code
! is the same for all these versions of VMS 5, only the addresses changed after
! 5.0.  For VMS 4.6/4.7, unfortunately the code was different and it was not
! found worth the effort to retrofit this patch for a version of VMS that was
! replaced 23 months ago.
!
! For VMS 5.0 only, uncomment the following 6 lines and comment another 6 lines
! below.
!
! If you patch, VMS 5.0, it is different from the following VMS versions
!                          MAIL$$ADD_ADDR     is located at 000049C2 and
!                          ADD_ADDR           is located at 000048EF
!    then uncomment the following 6 lines and comment out 6 similar lines below
!DEF
!MAIL$$ADD_ADDR
!000049C2
!ADD_ADDR
!000048EF
!EXI
!
! If you patch any versions from VMS 5.1 to T5.4-4 including 5.1 and 5.2, all
! appear to have identical MAIL$$ADD_ADDR always located at 000049D2 and
! calling                  ADD_ADDR       always located at 000048FF
! For VMS 5.0 comment out the following 6 lines and uncomment 6 lines above
!
DEF
MAIL$$ADD_ADDR
000049D2
ADD_ADDR
000048FF
EXI
! Now make sure that we have a patch area
!
ALI/B PATAREA
! And now enter instruction mode
!
SE M
I
EXI
!       Start implementing the ALTER_TO subroutine
!       It was first developped and tested as a MACRO-32 program
!       and changed into the body of this patch.com file by
!       a MACRO_TO_PATCH.COM procedure developped for that purpose
DEP /PAT
PATAREA
       !;       ALTER_TO is called with the same 2 arguments used by
       !;       MAIL$$SEND_ADD_ADDR in calling MAIL$$ADD_ADDR and will call
       !;       ADD_ADDR itself with or without a rewrite. There is no rewrite
       !;       if SYS$FAO fails.  The original address is never modified and
       !;       will still appear unmodified in the "published" TO: field.
       !;
       !;       At this point when MAIL$$ADD_ADDR calls ALTER_TO, 4(AP) points
       !;       to a string descriptor which MAIL has already parsed to be one
       !;       of a single recipient (we don't have to look for commas or for
       !;       an @ sign preceding a distribution list).  Because of the
       !;       location of this patch, floating/unquoted "!"s seem unlikely.
       !;
       !;       The principle of this patch is to allow plain RFC addresses
       !;       to be acceptable by mail.  We never anticipated to fully deal
       !;       with the full RFC822 format but simply to lrt forms such as
       !;       user@site.org or user%machine@site.company.org with all atoms
       !;       being alphanumerics and the whole address void of double quotes
       !;
       !;       At the same time STRAIGHTFORWARD phase IV DECnet mail addresses
       !;       are also allowed in an RFC822 like format: USERNAME@NODENAME
       !;       is being transformed into NODENAME::USERNAME.  Note well that
       !;       the code will NOT transform any address with an "@" into
       !;       a more complex DECnet mail address such as AAA::BBB::USER.
       !;
       !;       The parsing is an adhoc scanning of the string looking for
       !;       no more than one "@", checking the absence of " and for the
       !;       A and B parts of A@B distinguish between A-Z,0-9,a-z,$,%,.,-
       !;       and other characters (in case MAIL's parser would any slip thru)
       !;
       !;       More exactly the algorithm is:
       !;
       !;       input string might look like A@B with A and B containing no "
       !;       if " or not A@B, pass the string to ADD_ADDR unchanged  ! Case 1
       !;       else if A or B has any character not in A-Z,0-9,a-z,$,%,.,-
       !;                       pass IN%"A@B"                           ! Case 2
       !;            else
       !;                if B has no dots (pure DECnet) pass B::A       ! Case 3
       !;                else pass IN%"A@B"                             ! Case 2
       !;
       'alter_to: .word 7C                      ' ! ; entry mask save R2-R6
       '        movq    @B^4(ap),r0'
       '        movzwl  r0,r0'
       '        clrl    r2'
       'cdblp1: cmpb    #^x22,(r1)'
       '        beql    cdbcs1'
       '        cmpb    #^x40,(r1)+'
       '        beql    cdbl1x'
       '        incl    r2                      ' ! ; length of A in A@B
       '        sobgtr  r0,cdblp1'
       'cdbcs1: movab   @B^4(ap),r2'
       '        jmp     cdbcom                  ' ! ; no changes - case 1
       'cdbl1x: decl    r0                      ' ! ; count "@"
       '        bleq    cdbcs1                  ' ! ; branch if at end
       '        tstl    r2'
       '        beql    cdbcs1                  ' ! ; branch if @B with no A
       '        clrl    r3                      ' ! ; now parse after "@"
       'cdblp2: cmpb    #^x22,(r1)'
       '        beql    cdbcs1'
       '        cmpb    #^x40,(r1)+'
       '        beql    cdbcs1'
       '        incl    r3                      ' ! ; length of B in A@B
       '        sobgtr  r0,cdblp2'
       !; passed test 1 - we have A@B - Now check A
       '        movq    @B^4(ap),r0'
       !; allocate room on stack for 2 descriptors (for A and B)
       '        pushl   r1'
       '        pushl   r2'
       '        movl    sp,r5           ' ! ; r5 points to desc(A)
       '        movl    r2,r0'
       '        beql    cdbcs1'
       '        jsb     cdbck1'
       '        tstl    r0'
       '        bneq    cdbcs2'
       '        incl    r1'
       '        pushl   r1'
       '        pushl   r3'
       '        movl    sp,r6           ' ! ; r6 points to desc(B)
       '        movl    r3,r0'
       '        beql    cdbcs1'
       '        jsb     cdbck1'
       '        tstl    r0'
       '        beql    cdbps2'
       !                                            ; build IN%"A@B" for case 2
       !; use the stack this way for all $FAO
       !;               outlen          initial sp      <- r3 <-r2
       !;               ptr to outbuf   initial sp-264  <- r2 minus 8
       !;               ......                          <- r2 to beg of ptr
       !;               outbuf          initial sp-4    <- r3 minus 4
       !;               ......          initial sp-256  <- sp
       'cdbcs2: pushl   #22534121               ' ! ; ctrstr    #^A/!AS"/
       '        pushl   #2225584D               ' ! ; ctrstr    #^A/MX%"/
       '        pushl   sp                      ' ! ; make desc to ctrstr
       '        pushl   #8                      ' ! ; make desc to ctrstr
       '        movl    sp,r4                   ' ! ; address of desc to ctrstr
       '        subl    #4,sp                   ' ! ; adjusted stack
       '        movl    sp,r3                   ' ! ; save stack for outlen
       '        movl    sp,r2                   ' ! ; end of desc to outbuf
       '        subl    #108,sp         ' ! ; end of outbuf
       '        movl    sp,-(r2)        ' ! ; make outbuf
       '        movzwl  #100,-(r2)      ' ! ; make outbuf
       '        pushl   B^4(AP)                 ' ! ; #4 P1 pass what we got
       '        pushl   r2                      ' ! ; #3 outbuf
       '        pushl   r3                      ' ! ; #2 outlen
       '        pushl   r4                      ' ! ; #1 ctrstr
       '        calls   #4,@#7FFEDF50           ' ! ; calls   #04,g^sys$fao
       '        blbs    r0,N102$'
       '        jmp     cdberr'
       'N102$:  movw    (r3),(r2)               ' ! ; complete ptr to final text
       '        jmp     cdbcom'
       'cdbps2: movq    @B^4(ap),r0'
       '        addl    r2,r1'
       '        incl    r1'
       '        movl    r3,r0'
       '        jsb     cdbck2'
       '        tstl    r0'
       '        beql    cdbcs2                  ' ! ; RPW mod: always jump
       '        bneq    cdbcs2                  ' ! ;   old statement here
       !
       !                                            ; build B::A for case 3
       'cdbcs3: pushl   #5341213A               ' ! ; ctrstr    #^A/:!AS/
       '        pushl   #3A534121               ' ! ; ctrstr    #^A/!AS:/
       '        pushl   sp                      ' ! ; make desc to ctrstr
       '        pushl   #8                      ' ! ; make desc to ctrstr
       '        movl    sp,r4                   ' ! ; address of desc to ctrstr
       '        subl    #4,sp                   ' ! ; adjusted stack
       '        movl    sp,r3                   ' ! ; save stack for outlen
       '        movl    sp,r2                   ' ! ; end of desc to outbuf
       '        subl    #108,sp         ' ! ; end of outbuf
       '        movl    sp,-(r2)        ' ! ; make outbuf
       '        movzwl  #100,-(r2)      ' ! ; make outbuf
       '        pushl   r5                      ' ! ; #5 Second sub string A
       '        pushl   r6                      ' ! ; #4 first  sub string B
       '        pushl   r2                      ' ! ; #3 outbuf
       '        pushl   r3                      ' ! ; #2 outlen
       '        pushl   r4                      ' ! ; #1 ctrstr
       '        calls   #5,@#7FFEDF50           ' ! ; calls   #05,g^sys$fao
       '        blbs    r0,N103$'
       '        jmp     cdberr'
       'N103$:  movw    (r3),(r2)               ' ! ; complete ptr to final text
       '        jmp     cdbcom'
       !; check if all alpha numerical + .-_$% returns non zero
       'cdbck1: cmpb    #^x41,(r1)'
       '        bgtr    cdbck11'
       '        cmpb    #^x5A,(r1)'
       '        bgeq    cdbck19'
       'cdbck11: cmpb   #^x61,(r1)'
       '        bgtr    cdbck12'
       '        cmpb    #^x7A,(r1)'
       '        bgeq    cdbck19'
       'cdbck12: cmpb   #^x30,(r1)'
       '        bgtr    cdbck13'
       '        cmpb    #^x39,(r1)'
       '        bgeq    cdbck19'
       'cdbck13: cmpb   #^x24,(r1)'
       '        beql    cdbck19'
       '        cmpb    #^x25,(r1)'
       '        beql    cdbck19'
       '        cmpb    #^x2D,(r1)'
       '        beql    cdbck19'
       '        cmpb    #^x2E,(r1)'
       '        beql    cdbck19'
       '        cmpb    #^x5F,(r1)'
       '        rsb'
       'cdbck19: incl   r1'
       '        sobgtr  r0,cdbck1'
       '        rsb'
       !; check if we have at least one dot (then r0 > 0)
       'cdbck2: cmpb    #^x2E,(r1)'
       '        bneq    cdbck29'
       '        rsb'
       'cdbck29: incl   r1'
       '        sobgtr  r0,cdbck2'
       '        rsb'
       !;
       'cdberr: movab   @B^4(ap),r2     ' !; If SYS$FAO fails, use original addr
       'cdbcom: MOVQ    #^X00000001,-(SP)'
       '        movl    B^8(ap),-(sp)'
       '        pushl   r2'
       '        CALLS   #04,L^ADD_ADDR'
       '        ret                     ' !; this is the only RET for ALTER_TO
EXI
! Above was the new code
! Below is the patch in the existing code that
! will make use of the ALTER_TO new code
RE
MAIL$$ADD_ADDR
'MOVQ    #^X00000001,-(SP)'
'MOVQ    B^04(AP),-(SP)'
'CALLS   #04,W^ADD_ADDR'
'RET'
EXIT
'MOVQ    B^04(AP),-(SP)'
'CALLS   #02,ALTER_TO'
'RET'
EXIT
! And now update if we reached this point without a single error
U
!---------------------- end of patch ----------------------