203 lines
7.7 KiB
Mathematica
203 lines
7.7 KiB
Mathematica
XMS3 ;ISC-SF/GMB-SMTP Send (RFC 822) ;04/15/2003 12:44
|
|
;;8.0;MailMan;**18**;Jun 28, 2002
|
|
; Entry points (DBIA 10073):
|
|
; REC Get the next line of message text
|
|
Q
|
|
HEADER(XMZ,XMZREC,XMFROM,XMNETNAM) ; RFC 822 - Header Records
|
|
; These records are what you see when you do a "QN" at the prompt:
|
|
; "Message Action: Ignore//"
|
|
S XMSG="Subject: "_$S($P(XMZREC,U)=$$EZBLD^DIALOG(34012):"",1:$P(XMZREC,U)) X XMSEN Q:ER
|
|
S XMSG="Date: "_$$INDT^XMXUTIL1($P(XMZREC,U,3)) X XMSEN Q:ER
|
|
S XMSG="Message-ID: <"_$$NETID(XMZ)_">" X XMSEN Q:ER
|
|
I $D(^XMB(3.9,XMZ,"IN")) D Q:ER
|
|
. N XMINRE
|
|
. S XMINRE=^XMB(3.9,XMZ,"IN")
|
|
. I $P(XMINRE,"@",1)?.E1".VA.GOV"!($P(XMINRE,"@",2)?.N) S XMINRE=$P(XMINRE,"@",2)_"@"_$P(XMINRE,"@")
|
|
. S XMSG="In-reply-to: <"_XMINRE_">" X XMSEN
|
|
I "^Y^y^"[(U_$P(XMZREC,U,5)_U) D Q:ER
|
|
. S XMSG="Return-Receipt-To: "_XMFROM X XMSEN
|
|
I $D(^XMB(3.9,XMZ,"K")) D Q:ER
|
|
. S XMSG="Encrypted: "_$P(XMZREC,U,10)_U_^("K") X XMSEN
|
|
I $P(XMZREC,U,4)'="" D Q:ER
|
|
. S XMSG="Sender: "_$$FROM^XMS1($P(XMZREC,U,4),XMNETNAM) X XMSEN
|
|
S XMSG="From: "_XMFROM X XMSEN Q:ER
|
|
I $P(XMZREC,U,6)'="" D Q:ER
|
|
. S XMSG="Expiry-Date: "_$$INDT^XMXUTIL1($P(XMZREC,U,6)) X XMSEN
|
|
I $P(XMZREC,U,7)["P" D Q:ER
|
|
. S XMSG="Importance: high" X XMSEN Q:ER
|
|
. S XMSG="X-Priority: 1" X XMSEN
|
|
I "^Y^y^"[(U_$P(XMZREC,U,11)_U) D Q:ER
|
|
. S XMSG="Sensitivity: Private" X XMSEN
|
|
I $D(^XMB(3.9,XMZ,.5)) D Q:ER
|
|
. N XMZBSKT
|
|
. S XMZBSKT=$P($G(^XMB(3.9,XMZ,.5)),U,1)
|
|
. Q:XMZBSKT=""
|
|
. S XMSG="X-MM-Basket: "_XMZBSKT X XMSEN
|
|
I $P(XMZREC,U,7)'="",$P(XMZREC,U,7)'="P" D Q:ER
|
|
. S XMSG="X-MM-Type: "_$P(XMZREC,U,7) X XMSEN
|
|
I "^Y^y^"[(U_$P(XMZREC,U,9)_U) D Q:ER
|
|
. S XMSG="X-MM-Closed: YES" X XMSEN
|
|
I "^Y^y^"[(U_$P(XMZREC,U,12)_U) D Q:ER
|
|
. S XMSG="X-MM-Info-Only: YES" X XMSEN
|
|
D TOLIST(XMZ,XMNETNAM) Q:ER
|
|
Q
|
|
NETID(XMZ) ;
|
|
N XMCRE8
|
|
S XMCRE8=$P($G(^XMB(3.9,XMZ,.6)),U,1)
|
|
I 'XMCRE8 D
|
|
. S XMCRE8=$P($G(^XMB(3.9,XMZ,0)),U,3)
|
|
. I $P(XMCRE8,".")?7N S XMCRE8=$P(XMCRE8,".")
|
|
. E D
|
|
. . S XMCRE8=$$CONVERT^XMXUTIL1(XMCRE8)
|
|
. . I XMCRE8=-1 S XMCRE8=DT
|
|
. S $P(^XMB(3.9,XMZ,.6),U,1)=XMCRE8
|
|
. S ^XMB(3.9,"C",XMCRE8,XMZ)=""
|
|
N XMREMID
|
|
I $D(^XMB(3.9,XMZ,5)) D Q:XMREMID'="" XMREMID
|
|
. S XMREMID=^XMB(3.9,XMZ,5)
|
|
. I $P(XMREMID,"@",1)?.E1".VA.GOV"!($P(XMREMID,"@",2)?.N) S XMREMID=$P(XMREMID,"@",2)_"@"_$P(XMREMID,"@")
|
|
. Q:XMREMID'=""
|
|
. D PARSE^XMR3(XMZ,.XMREMID)
|
|
;Q XMZ_"@"_^XMB("NETNAME")
|
|
Q XMZ_"."_XMCRE8_"@"_^XMB("NETNAME")
|
|
TOLIST(XMZ,XMNETNAM) ;
|
|
N XMTO,XMIEN
|
|
S XMIEN=$O(^XMB(3.9,XMZ,6,0)),XMSG="To: "_$$TOFORMAT($P(^XMB(3.9,XMZ,6,XMIEN,0),U,1),$S($G(XMC("MAILMAN")):$P(^(0),U,2),1:""))
|
|
F S XMIEN=$O(^XMB(3.9,XMZ,6,XMIEN)) Q:'XMIEN!(XMIEN>50) D Q:ER
|
|
. S XMTO=$$TOFORMAT($P(^XMB(3.9,XMZ,6,XMIEN,0),U,1),$S($G(XMC("MAILMAN")):$P(^(0),U,2),1:""))
|
|
. S XMSG=XMSG_","
|
|
. I $L(XMSG)+$L(XMTO)>80 D TOSEND(.XMSG) Q:ER
|
|
. S XMSG=XMSG_" "_XMTO
|
|
Q:ER
|
|
D TOSEND(.XMSG) Q:ER
|
|
I XMIEN>50 S XMSG="(Too many recipients to list...)" D TOSEND(.XMSG) Q:ER
|
|
Q
|
|
TOFORMAT(XMTO,XMPREFIX) ;
|
|
N XMDOM
|
|
S XMDOM=$S(XMTO["@":$P(XMTO,"@",2,99),1:XMNETNAM)
|
|
S XMTO=$$TO($P(XMTO,"@"))
|
|
Q $S(XMPREFIX="":"",$E(XMTO,1)=$C(34):"",1:XMPREFIX_":")_XMTO_"@"_XMDOM
|
|
TO(XMTO) ;
|
|
I $E(XMTO)'=$C(34),(XMTO[",")!(XMTO[" ") D
|
|
. I XMTO["," S XMTO=$TR(XMTO,", .","._+")
|
|
. I XMTO[" " S XMTO=$C(34)_XMTO_$C(34)
|
|
Q XMTO
|
|
TOSEND(XMSG) ;
|
|
I $L(XMSG)>80 D Q
|
|
. N XMSGHOLD,XMPIECES
|
|
. S XMPIECES=$L(XMSG,"@")
|
|
. S XMSGHOLD=$P(XMSG,"@",XMPIECES)
|
|
. S XMSG=$P(XMSG,"@",1,XMPIECES-1)
|
|
. X XMSEN
|
|
. S XMSG=" @"_XMSGHOLD
|
|
X XMSEN
|
|
S XMSG=" "
|
|
Q
|
|
TEXT(XMZ) ; Send body of text
|
|
N XMS0AJ
|
|
;S XMBLOCK=1 ; *** What's this? See ^XML4CRC* & ^XMLSWP*
|
|
S XMS0AJ=0
|
|
F S XMS0AJ=$O(^XMB(3.9,XMZ,2,XMS0AJ)) Q:XMS0AJ'>0 D Q:ER
|
|
. S XMSG=^XMB(3.9,XMZ,2,XMS0AJ,0)
|
|
. I $E(XMSG)="." S XMSG="."_XMSG
|
|
. E I $E(XMSG,1,4)="~*~^" S XMSG=" "_XMSG ; *** What's this?
|
|
. X XMSEN
|
|
I ER S ER("MSG")="Error sending msg "_XMZ_", text line "_XMS0AJ Q
|
|
;D:$D(XMBLOCK) KILL^XML4CRC
|
|
Q
|
|
RCPTERR(XMERRMSG,XMZ,XMZREC,XMNVFROM,XMRCPTO,XMRCPT,XMIEN) ; Non-delivery to recipient
|
|
N XMFDA,XMIENS,XMTO,XMPARM,XMINSTR
|
|
S XMIENS=XMIEN_","_XMZ_","
|
|
S XMFDA(3.91,XMIENS,3)="@" ; remote msg id
|
|
S XMFDA(3.91,XMIENS,4)=XMCM("START","FM") ; xmit date/time
|
|
S XMFDA(3.91,XMIENS,5)=$E($P(XMERRMSG," ",2,999),1,30) ; status
|
|
S XMFDA(3.91,XMIENS,6)="@" ; path
|
|
D FILE^DIE("","XMFDA")
|
|
S XMTO=$$SENDER(XMZ,XMZREC,XMNVFROM,XMIEN,1,XMERRMSG) Q:"<>"[XMTO
|
|
S XMINSTR("FROM")="POSTMASTER"
|
|
S XMPARM(1)=$P(XMZREC,U,1) ; subject
|
|
S XMPARM(2)=XMRCPTO
|
|
S XMPARM(3)=XMERRMSG
|
|
S XMPARM(4)=XMRCPT
|
|
S XMPARM(5)=$S(XMTO["@":$G(^XMB(3.9,XMZ,5)),1:XMZ)
|
|
D TASKBULL^XMXBULL(.5,"XM SEND ERR RECIPIENT",.XMPARM,"",XMTO,.XMINSTR)
|
|
Q
|
|
MSGERR(XMSITE,XMINST,XMERRMSG,XMZ,XMZREC,XMNVFROM,XMRCPT) ;
|
|
; If a message is rejected at a site for any reason (the whole message,
|
|
; not just one recipient), then this message may be sent.
|
|
N XMTO,XMPARM,XMIEN,XMNAME,XMCNT,XMINSTR
|
|
D DOTRAN^XMC1(XMERRMSG)
|
|
S XMPARM(3)=XMERRMSG
|
|
S XMERRMSG=$E($P(XMERRMSG," ",2,999),1,30)
|
|
K ^TMP("XM",$J,"REJECT")
|
|
S XMIEN=""
|
|
F S XMIEN=$S($D(XMRCPT):$O(XMRCPT(XMIEN)),1:$O(^XMB(3.9,XMZ,1,"AQUEUE",XMINST,XMIEN))) Q:XMIEN="" D
|
|
. N XMFDA,XMIENS
|
|
. S XMIENS=XMIEN_","_XMZ_","
|
|
. S XMFDA(3.91,XMIENS,3)="@" ; remote msg id
|
|
. S XMFDA(3.91,XMIENS,4)=XMCM("START","FM") ; xmit date/time
|
|
. S XMFDA(3.91,XMIENS,5)=XMERRMSG ; status
|
|
. S XMFDA(3.91,XMIENS,6)="@" ; path
|
|
. S XMFDA(3.91,XMIENS,9)="@" ; xmit time
|
|
. D FILE^DIE("","XMFDA")
|
|
. S XMNAME=$P($G(^XMB(3.9,XMZ,1,XMIEN,0)),U,1) Q:XMNAME=""
|
|
. S XMTO=$$SENDER(XMZ,XMZREC,XMNVFROM,XMIEN) Q:"<>"[XMTO
|
|
. S (XMCNT,^(XMTO))=$G(^TMP("XM",$J,"REJECT",XMTO))+1
|
|
. S ^TMP("XM",$J,"REJECT",XMTO,XMCNT)=XMNAME
|
|
S XMINSTR("FROM")="POSTMASTER"
|
|
S XMPARM(1)=$P(XMZREC,U,1) ; subject
|
|
S XMPARM(2)=XMSITE
|
|
S XMTO=""
|
|
F S XMTO=$O(^TMP("XM",$J,"REJECT",XMTO)) Q:XMTO="" D TASKBULL^XMXBULL(.5,"XM SEND ERR MSG",.XMPARM,"^TMP(""XM"",$J,""REJECT"",XMTO)",XMTO,.XMINSTR)
|
|
K ^TMP("XM",$J,"REJECT")
|
|
Q
|
|
SENDER(XMZ,XMZREC,XMNVFROM,XMIEN,XMDELFWD,XMERRMSG) ; Function returns 'to whom to send error message'
|
|
N XMFWDREC,XMFWDR
|
|
S XMFWDREC=$G(^XMB(3.9,XMZ,1,XMIEN,"F")) ; Try to find forwarder
|
|
S XMFWDR=$P(XMFWDREC,U,2)
|
|
I XMFWDR'="" D Q XMFWDR ; Forwarder is local
|
|
. I $G(XMDELFWD) D DELFWD(XMZ,XMIEN,XMFWDR,XMERRMSG)
|
|
I $E(XMFWDREC)="<" Q $E($P($P(XMFWDREC,U,1),">",1),2,999) ; Forwarder is remote
|
|
Q:$D(^XMB(3.9,XMZ,.7)) XMNVFROM ; Sender is remote
|
|
N XMFROM
|
|
S XMFROM=$P(XMZREC,U,2)
|
|
I +XMFROM=XMFROM Q XMFROM ; Sender is local
|
|
I XMFROM'["@" Q .5 ; Sender is fictitious, so notify postmaster
|
|
Q XMNVFROM ; Sender is remote
|
|
DELFWD(XMZ,XMIEN,XMFWDR,XMERRMSG) ; Delete user's forwarding address
|
|
Q:+XMFWDR'=XMFWDR
|
|
N XMFWD
|
|
S XMFWD=$P(^XMB(3.7,XMFWDR,0),U,2) Q:XMFWD=""
|
|
N XMINSTR,XMADDR,XMFULL,XMERROR,XMFDA,XMTXT,XMFWDADD
|
|
S XMINSTR("ADDR FLAGS")="X" ; do not create ^TMP(, just check.
|
|
S XMADDR=$P(^XMB(3.9,XMZ,1,XMIEN,0),U,1)
|
|
D ADDRESS^XMXADDR(DUZ,XMFWD,.XMFULL,.XMERROR)
|
|
I '$D(XMERROR),XMADDR'=$G(XMFULL) Q
|
|
D DELFWD^XMVVITA(XMFWDR,XMFWD,XMERRMSG)
|
|
Q
|
|
; The following has nothing to do with the above.
|
|
; These are used by the SERVER Communications Protocol in file 3.4.
|
|
REC ; Read the next line of text from the message. When called for the
|
|
; first time, returns the first line.
|
|
; In:
|
|
; XMZ - IEN of the message in file 3.9
|
|
; XMPOS - (optional) line number of the previous line read
|
|
; Default is .999999
|
|
; Out:
|
|
; XMPOS - line number of XMRG
|
|
; XMRG - =the next line of text, if OK; ="" if end of text reached
|
|
; XMER - =0 if OK; =-1 if end of text reached
|
|
S XMPOS=$S('$D(XMPOS):.999999,XMPOS<.999999:.999999,1:XMPOS)
|
|
S XMPOS=$O(^XMB(3.9,XMZ,2,XMPOS))
|
|
I +XMPOS'=XMPOS S XMER=-1,XMRG="" Q
|
|
S XMRG=^XMB(3.9,XMZ,2,XMPOS,0),XMER=0
|
|
Q
|
|
SEN ; Send a line to the return message
|
|
S XMSLINE=XMSLINE+1,^XMB(3.9,XMZ,2,XMSLINE,0)=XMSG
|
|
Q
|
|
OPEN ; Open the reverse message path
|
|
Q
|
|
CLOSE ; Close the reverse message
|
|
S ^XMB(3.9,XMZ,2,0)="^3.92A^"_XMSLINE_U_XMSLINE_U_DT
|
|
Q
|