$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 7.2-007  22-FEB-1990
$!   On  6-JUL-1990 16:35:32.10   By user BARBE 
$!
$! This VMS_SHARE Written by:
$!    Andy Harper, Kings College London UK
$!
$! Acknowledgements to:
$!    James Gray       - Original VMS_SHARE
$!    Michael Bednarek - Original Concept and implementation
$!
$!+ THIS PACKAGE DISTRIBUTED IN 2 PARTS, TO KEEP EACH PART
$!  BELOW 30 BLOCKS
$!
$! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
$! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
$!
$! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
$!       1. MAILSHR_PATCH_FOR_AT_02.COM;11
$!
$set="set"
$set symbol/scope=(nolocal,noglobal)
$f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID"))
$e="write sys$error  ""%UNPACK"", "
$w="write sys$output ""%UNPACK"", "
$ if f$trnlnm("SHARE_LOG") then $ w = "!"
$ ve=f$getsyi("version")
$ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto START
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ v=f$verify(v)
$ exit 44
$UNPACK: SUBROUTINE ! P1=filename, P2=checksum
$ if f$search(P1) .eqs. "" then $ goto file_absent
$ e "-W-EXISTS, File ''P1' exists. Skipped."
$ delete 'f'*
$ exit
$file_absent:
$ if f$parse(P1) .nes. "" then $ goto dirok
$ dn=f$parse(P1,,,"DIRECTORY")
$ w "-I-CREDIR, Creating directory ''dn'."
$ create/dir 'dn'
$ if $status then $ goto dirok
$ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped."
$ delete 'f'*
$ exit
$dirok:
$ w "-I-PROCESS, Processing file ''P1'."
$ if .not. f$verify() then $ define/user sys$output nl:
$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1'
PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET(
SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");b:=
CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(b));
LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
BEGINNING_OF(b));g:=0;LOOP EXITIF MARK(NONE)=END_OF(b);x:=ERASE_CHARACTER(1);
IF g=0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x="V" THEN APPEND_LINE;
MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;IF x="+" THEN g:=1;
ERASE_LINE;ENDIF;ELSE IF x="-" THEN IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+")=
1 THEN g:=0;ENDIF;ENDIF;ERASE_LINE;ENDIF;ENDLOOP;t:="0123456789ABCDEF";
POSITION(BEGINNING_OF(b));LOOP r:=SEARCH("`",FORWARD);EXITIF r=0;POSITION(r);
ERASE(r);x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,ERASE_CHARACTER(1))-1;
COPY_TEXT(ASCII(16*x1+x2));ENDLOOP;WRITE_FILE(b,GET_INFO(COMMAND_LINE,
"output_file"));ENDPROCEDURE;Unpacker;QUIT;
$ delete/nolog 'f'*
$ CHECKSUM 'P1'
$ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT
$ e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ ENDSUBROUTINE
$START:
$ create 'f'
X!----------------------  MAILSHR_PATCH_FOR_AT_02.COM -----------------
XMAILSHR.EXE
X!
X! This patch will be of interest to any VAX/VMS system (more especially if i
Vt
X! is running PMDF) since it lets TO: or CC: addresses such as
X! user%machine@site.co.org to be accepted without the IN% prefix and without
X! surrounding double quotes.  Yes, let's admit it, it lets VMS mail accept U
Vn*x
X! type addresses.  In addition to its original goal, the format of this
X! modification is also original by the fact of the straight macro code that
X! can easily be modified/expanded or altered (ie IN% could become M_INTERNET
V::
X! in the case of most Schlumberger VMS nodes)
X! If the address is "similar" (see algorithm below) to user%machine@site.co.
Vorg
X! it is simply rewritten as IN%"user%machine@site.co.org" and passed along.
X! At the same time, user@machine will be accepted and rewritten as machine::
Vuser
X! If the IN% prefix is not the one in use on your VAX/VMS system, but XYZ% i
Vs,
X! then all you have to do is $ DEFINE/SYSTEM/EXECUTIVE -
X!`09MAIL$PROTOCOL_IN -
X!`09XYZ_ROOT:`5BEXE`5DXYZ_MAILSHR`09! or wherever the XYZ overlay for MAIL
X!`09`09`09`09`09! might be located and installed from
X!
X! See additional impact remarks below.
X!
X! This patch applies to SYS$LIBRARY:MAILSHR.EXE (usually SYS$COMMON:`5BSYSLI
VB`5D)
X! from VMS 5.0 to Field Test version of 5.4 as of June 1990
X!
X!`09We recommend:
X!
X!`09$ SET DEFAULT SYS$COMMON:`5BSYSLIB`5D
X!`09$ INSTALL:= $INSTALL/COMMAND
X!`09$ PATCH @ this_file.COM
X!`09$ INSTALL REPLACE SYS$COMMON:`5BSYSLIB`5DMAILSHR.EXE
X!
X! Claude Barbe - Schlumberger-Doll Research - Ridgefield, CT - USA
X! (Internet) barbe@sdr.slb.com (a happy hacker of MAIL and PMDF for over 3yr
V)
X!
X! 3-Jul-1990
X!
X! No warranty implied.  This can be freely copied and altered.  Use it at
X! your own risks.  It is probably pure chance if it ever worked on a
X! particular system.
X!
X! Additional remarks on the impact of this patch
X!
X! 1) With this patch in place we hope to make addressing unique in the VMS w
Vorld
X!    whether a message is sent via DECnet or via a foreign protocol (such as
X!    the successful/affordable PMDF) without forcing any one to use prefixes
X!    and/or quotes.  Quotes are to be avoided by all means since MAIL and DE
VC's
X!    MRGATE interface have no mechanisms to imbed quoted addresses between
X!    quotes (ie MRGATE and PMDF cannot carry the same message!)
X! 2) There are risks of confusion for new users who will learn that the Un*x
X!    addressing format works on a patched VMS system and who will never both
Ver
X!    to know the DEC way to send mail with double colons between node and`20
X!    username until they use a non patched VMS system
X! 3) The patch will certainly break when DECnet node names will contain dots
X!    but this is in DECnet phase V and we still have to see a field test
X!    for this product.  By that time a better patch will be developped or
X!    whatever foreign protocol is used (PMDF by default) will just handle
X!    these deliveries that could have gone also more simply across DECnet
X! 4) The patch is far from being fully RFC822 compliant and there are risks
X!    that some users will be confused by the lack of completeness.  This
X!    in some case will be due to the approach taken in this patch where,
X!    instead of redoing the address parsing that DEC is doing in MAIL, we
X!    simply hacked a string filter on a "DEC approved string" which has alre
Vady
X!    been pruned of commas and exclamation points.  Users familiar with "ban
Vg"
X!    addresses will still have to say IN%"node!node!user@relay.somewhere"
X! 5) After a few extra weeks of testing on a larger scale, this patch will b
Ve
X!    submitted to DEC as an SPR for improvement.  Hopefully, then DEC will
X!    support the de facto standard (or at least the most commonly used part
X!    of it).  In the mean time let's try to let our users access Internet
X!    addresses in the most natural way.  At last!
X!
X! Validity of this patch
X!
X! It has only been tested on VMS 5.3-1 but is expected to work on VMS 5.0 to
V 5.4
X! (well, 5.4 is not out yet, so at least up to T5.4-4).  This part of the co
Vde
X! is the same for all these versions of VMS 5, only the addresses changed af
Vter
X! 5.0.  For VMS 4.6/4.7, unfortunately the code was different and it was not
X! found worth the effort to retrofit this patch for a version of VMS that wa
Vs
X! replaced 23 months ago.
X!
X! For VMS 5.0 only, uncomment the following 6 lines and comment another 6 li
Vnes
X! below.
X!
X! If you patch, VMS 5.0, it is different from the following VMS versions
X!                          MAIL$$ADD_ADDR     is located at 000049C2 and
X!                          ADD_ADDR           is located at 000048EF
X!    then uncomment the following 6 lines and comment out 6 similar lines be
Vlow
X!DEF
X!MAIL$$ADD_ADDR
X!000049C2
X!ADD_ADDR
X!000048EF
X!EXI
X!
X! If you patch any versions from VMS 5.1 to T5.4-4 including 5.1 and 5.2, al
Vl
X! appear to have identical MAIL$$ADD_ADDR always located at 000049D2 and
X! calling                  ADD_ADDR       always located at 000048FF
X! For VMS 5.0 comment out the following 6 lines and uncomment 6 lines above
X!
XDEF
XMAIL$$ADD_ADDR
X000049D2
XADD_ADDR
X000048FF
XEXI
X! Now make sure that we have a patch area
X!
XALI/B PATAREA
X! And now enter instruction mode
X!`20
XSE M
XI
XEXI
X!`09Start implementing the ALTER_TO subroutine
X!`09It was first developped and tested as a MACRO-32 program
X!`09and changed into the body of this patch.com file by
X!`09a MACRO_TO_PATCH.COM procedure developped for that purpose
XDEP /PAT
XPATAREA
X       !;`09ALTER_TO is called with the same 2 arguments used by
X       !;`09MAIL$$SEND_ADD_ADDR in calling MAIL$$ADD_ADDR and will call
X       !;`09ADD_ADDR itself with or without a rewrite. There is no rewrite
X       !;`09if SYS$FAO fails.  The original address is never modified and
X       !;`09will still appear unmodified in the "published" TO: field.
X       !;
X       !;`09At this point when MAIL$$ADD_ADDR calls ALTER_TO, 4(AP) points
X       !;`09to a string descriptor which MAIL has already parsed to be one
X       !;`09of a single recipient (we don't have to look for commas or for
X       !;`09an @ sign preceding a distribution list).  Because of the
X       !;`09location of this patch, floating/unquoted "!"s seem unlikely.
X       !;
X       !;`09The principle of this patch is to allow plain RFC addresses
X       !;`09to be acceptable by mail.  We never anticipated to fully deal
X       !;`09with the full RFC822 format but simply to lrt forms such as
X       !;`09user@site.org or user%machine@site.company.org with all atoms
X       !;`09being alphanumerics and the whole address void of double quotes
X       !;
X       !;`09At the same time STRAIGHTFORWARD phase IV DECnet mail addresses
X       !;`09are also allowed in an RFC822 like format: USERNAME@NODENAME
X       !;`09is being transformed into NODENAME::USERNAME.  Note well that
X       !;`09the code will NOT transform any address with an "@" into
X       !;`09a more complex DECnet mail address such as AAA::BBB::USER.
X       !;
X       !;`09The parsing is an adhoc scanning of the string looking for
X       !;`09no more than one "@", checking the absence of " and for the
X       !;`09A and B parts of A@B distinguish between A-Z,0-9,a-z,$,%,.,-
X       !;`09and other characters (in case MAIL's parser would any slip thru)
X       !;
X       !;`09More exactly the algorithm is:
X       !;
X       !;`09input string might look like A@B with A and B containing no "
X       !;`09if " or not A@B, pass the string to ADD_ADDR unchanged`09! Case
V 1
X       !;`09else if A or B has any character not in A-Z,0-9,a-z,$,%,.,-
X       !;`09`09`09pass IN%"A@B"`09`09`09`09! Case 2
X       !;`09     else
X       !;`09`09 if B has no dots (pure DECnet) pass B::A`09! Case 3
X       !;`09`09 else pass IN%"A@B"`09`09`09`09! Case 2
X       !;
X       'alter_to: .word`097C`09`09`09' ! ; entry mask save R2-R6
X       '`09movq`09@B`5E4(ap),r0'
X       '`09movzwl`09r0,r0'
X       '`09clrl`09r2'
X       'cdblp1:`09cmpb`09#`5Ex22,(r1)'
X       '`09beql`09cdbcs1'
X       '`09cmpb`09#`5Ex40,(r1)+'
X       '`09beql`09cdbl1x'
X       '`09incl`09r2`09`09`09' ! ; length of A in A@B
X       '`09sobgtr`09r0,cdblp1'
X       'cdbcs1: movab`09@B`5E4(ap),r2'
X       '`09jmp`09cdbcom`09`09`09' ! ; no changes - case 1
X       'cdbl1x:`09decl`09r0`09`09`09' ! ; count "@"
X       '`09bleq`09cdbcs1`09`09`09' ! ; branch if at end
X       '`09tstl`09r2'
X       '`09beql`09cdbcs1`09`09`09' ! ; branch if @B with no A
X       '`09clrl`09r3`09`09`09' ! ; now parse after "@"
X       'cdblp2:`09cmpb`09#`5Ex22,(r1)'
X       '`09beql`09cdbcs1'
X       '`09cmpb`09#`5Ex40,(r1)+'
X       '`09beql`09cdbcs1'
X       '`09incl`09r3`09`09`09' ! ; length of B in A@B
X       '`09sobgtr  r0,cdblp2'
X       !; passed test 1 - we have A@B - Now check A
X       '`09movq`09@B`5E4(ap),r0'
X       !; allocate room on stack for 2 descriptors (for A and B)
X       '`09pushl`09r1'
X       '`09pushl`09r2'
X       '`09movl`09sp,r5`09`09' ! ; r5 points to desc(A)
X       '`09movl`09r2,r0'
X       '`09beql`09cdbcs1'
X       '`09jsb`09cdbck1'
X       '`09tstl`09r0'
X       '`09bneq`09cdbcs2'
X       '`09incl`09r1'
X       '`09pushl`09r1'
X       '`09pushl`09r3'
X       '`09movl`09sp,r6`09`09' ! ; r6 points to desc(B)
X       '`09movl`09r3,r0'
X       '`09beql`09cdbcs1'
X       '`09jsb`09cdbck1'
X       '`09tstl`09r0'
X       '`09beql`09cdbps2'
X       !`09`09`09`09`09    ; build IN%"A@B" for case 2
X       !; use the stack this way for all $FAO
X       !;`09`09outlen`09`09initial sp`09<- r3 <-r2
X       !;`09`09ptr to outbuf`09initial sp-264`09<- r2 minus 8
X       !;`09`09......`09`09`09`09<- r2 to beg of ptr
X       !;`09`09outbuf`09`09initial sp-4`09<- r3 minus 4
X       !;`09`09......`09`09initial sp-256  <- sp
X       'cdbcs2:`09pushl`09#22534121`09`09' ! ; ctrstr`09#`5EA/!AS"/
X       '`09pushl`09#22254E49`09`09' ! ; ctrstr`09#`5EA/IN%"/
X       '`09pushl`09sp`09`09`09' ! ; make desc to ctrstr
X       '`09pushl`09#8`09`09`09' ! ; make desc to ctrstr
X       '`09movl`09sp,r4`09`09`09' ! ; address of desc to ctrstr
X       '`09subl`09#4,sp`09`09`09' ! ; adjusted stack
X       '`09movl`09sp,r3`09`09`09' ! ; save stack for outlen
X       '`09movl`09sp,r2`09`09`09' ! ; end of desc to outbuf
X       '`09subl`09#108,sp`09`09' ! ; end of outbuf
X       '`09movl`09sp,-(r2)`09' ! ; make outbuf
X       '`09movzwl`09#100,-(r2)`09' ! ; make outbuf
X       '`09pushl`09B`5E4(AP)`09`09`09' ! ; #4 P1 pass what we got
X       '`09pushl`09r2`09`09`09' ! ; #3 outbuf
X       '`09pushl`09r3`09`09`09' ! ; #2 outlen
X       '`09pushl`09r4`09`09`09' ! ; #1 ctrstr
X       '`09calls`09#4,@#7FFEDF50`09`09' ! ; calls   #04,g`5Esys$fao
X       '`09blbs`09r0,N102$'
X       '`09jmp`09cdberr'
X       'N102$:`09movw`09(r3),(r2)`09`09' ! ; complete ptr to final text
X       '`09jmp`09cdbcom'
X       'cdbps2:`09movq`09@B`5E4(ap),r0'
X       '`09addl`09r2,r1'
X       '`09incl`09r1'
X       '`09movl`09r3,r0'
X       '`09jsb`09cdbck2'
X       '`09tstl`09r0'
X       '`09bneq`09cdbcs2'
X       !`09`09`09`09`09    ; build B::A for case 3
X       'cdbcs3:`09pushl`09#5341213A`09`09' ! ; ctrstr`09#`5EA/:!AS/
X       '`09pushl`09#3A534121`09`09' ! ; ctrstr`09#`5EA/!AS:/
X       '`09pushl`09sp`09`09`09' ! ; make desc to ctrstr
X       '`09pushl`09#8`09`09`09' ! ; make desc to ctrstr
X       '`09movl`09sp,r4`09`09`09' ! ; address of desc to ctrstr
X       '`09subl`09#4,sp`09`09`09' ! ; adjusted stack
X       '`09movl`09sp,r3`09`09`09' ! ; save stack for outlen
X       '`09movl`09sp,r2`09`09`09' ! ; end of desc to outbuf
+-+-+-+-+-+-+-+-  END  OF PART 1 +-+-+-+-+-+-+-+-