| 1 | XMS3 ;ISC-SF/GMB-SMTP Send (RFC 822) ;04/15/2003 12:44
|
|---|
| 2 | ;;8.0;MailMan;**18**;Jun 28, 2002
|
|---|
| 3 | ; Entry points (DBIA 10073):
|
|---|
| 4 | ; REC Get the next line of message text
|
|---|
| 5 | Q
|
|---|
| 6 | HEADER(XMZ,XMZREC,XMFROM,XMNETNAM) ; RFC 822 - Header Records
|
|---|
| 7 | ; These records are what you see when you do a "QN" at the prompt:
|
|---|
| 8 | ; "Message Action: Ignore//"
|
|---|
| 9 | S XMSG="Subject: "_$S($P(XMZREC,U)=$$EZBLD^DIALOG(34012):"",1:$P(XMZREC,U)) X XMSEN Q:ER
|
|---|
| 10 | S XMSG="Date: "_$$INDT^XMXUTIL1($P(XMZREC,U,3)) X XMSEN Q:ER
|
|---|
| 11 | S XMSG="Message-ID: <"_$$NETID(XMZ)_">" X XMSEN Q:ER
|
|---|
| 12 | I $D(^XMB(3.9,XMZ,"IN")) D Q:ER
|
|---|
| 13 | . N XMINRE
|
|---|
| 14 | . S XMINRE=^XMB(3.9,XMZ,"IN")
|
|---|
| 15 | . I $P(XMINRE,"@",1)?.E1".VA.GOV"!($P(XMINRE,"@",2)?.N) S XMINRE=$P(XMINRE,"@",2)_"@"_$P(XMINRE,"@")
|
|---|
| 16 | . S XMSG="In-reply-to: <"_XMINRE_">" X XMSEN
|
|---|
| 17 | I "^Y^y^"[(U_$P(XMZREC,U,5)_U) D Q:ER
|
|---|
| 18 | . S XMSG="Return-Receipt-To: "_XMFROM X XMSEN
|
|---|
| 19 | I $D(^XMB(3.9,XMZ,"K")) D Q:ER
|
|---|
| 20 | . S XMSG="Encrypted: "_$P(XMZREC,U,10)_U_^("K") X XMSEN
|
|---|
| 21 | I $P(XMZREC,U,4)'="" D Q:ER
|
|---|
| 22 | . S XMSG="Sender: "_$$FROM^XMS1($P(XMZREC,U,4),XMNETNAM) X XMSEN
|
|---|
| 23 | S XMSG="From: "_XMFROM X XMSEN Q:ER
|
|---|
| 24 | I $P(XMZREC,U,6)'="" D Q:ER
|
|---|
| 25 | . S XMSG="Expiry-Date: "_$$INDT^XMXUTIL1($P(XMZREC,U,6)) X XMSEN
|
|---|
| 26 | I $P(XMZREC,U,7)["P" D Q:ER
|
|---|
| 27 | . S XMSG="Importance: high" X XMSEN Q:ER
|
|---|
| 28 | . S XMSG="X-Priority: 1" X XMSEN
|
|---|
| 29 | I "^Y^y^"[(U_$P(XMZREC,U,11)_U) D Q:ER
|
|---|
| 30 | . S XMSG="Sensitivity: Private" X XMSEN
|
|---|
| 31 | I $D(^XMB(3.9,XMZ,.5)) D Q:ER
|
|---|
| 32 | . N XMZBSKT
|
|---|
| 33 | . S XMZBSKT=$P($G(^XMB(3.9,XMZ,.5)),U,1)
|
|---|
| 34 | . Q:XMZBSKT=""
|
|---|
| 35 | . S XMSG="X-MM-Basket: "_XMZBSKT X XMSEN
|
|---|
| 36 | I $P(XMZREC,U,7)'="",$P(XMZREC,U,7)'="P" D Q:ER
|
|---|
| 37 | . S XMSG="X-MM-Type: "_$P(XMZREC,U,7) X XMSEN
|
|---|
| 38 | I "^Y^y^"[(U_$P(XMZREC,U,9)_U) D Q:ER
|
|---|
| 39 | . S XMSG="X-MM-Closed: YES" X XMSEN
|
|---|
| 40 | I "^Y^y^"[(U_$P(XMZREC,U,12)_U) D Q:ER
|
|---|
| 41 | . S XMSG="X-MM-Info-Only: YES" X XMSEN
|
|---|
| 42 | D TOLIST(XMZ,XMNETNAM) Q:ER
|
|---|
| 43 | Q
|
|---|
| 44 | NETID(XMZ) ;
|
|---|
| 45 | N XMCRE8
|
|---|
| 46 | S XMCRE8=$P($G(^XMB(3.9,XMZ,.6)),U,1)
|
|---|
| 47 | I 'XMCRE8 D
|
|---|
| 48 | . S XMCRE8=$P($G(^XMB(3.9,XMZ,0)),U,3)
|
|---|
| 49 | . I $P(XMCRE8,".")?7N S XMCRE8=$P(XMCRE8,".")
|
|---|
| 50 | . E D
|
|---|
| 51 | . . S XMCRE8=$$CONVERT^XMXUTIL1(XMCRE8)
|
|---|
| 52 | . . I XMCRE8=-1 S XMCRE8=DT
|
|---|
| 53 | . S $P(^XMB(3.9,XMZ,.6),U,1)=XMCRE8
|
|---|
| 54 | . S ^XMB(3.9,"C",XMCRE8,XMZ)=""
|
|---|
| 55 | N XMREMID
|
|---|
| 56 | I $D(^XMB(3.9,XMZ,5)) D Q:XMREMID'="" XMREMID
|
|---|
| 57 | . S XMREMID=^XMB(3.9,XMZ,5)
|
|---|
| 58 | . I $P(XMREMID,"@",1)?.E1".VA.GOV"!($P(XMREMID,"@",2)?.N) S XMREMID=$P(XMREMID,"@",2)_"@"_$P(XMREMID,"@")
|
|---|
| 59 | . Q:XMREMID'=""
|
|---|
| 60 | . D PARSE^XMR3(XMZ,.XMREMID)
|
|---|
| 61 | ;Q XMZ_"@"_^XMB("NETNAME")
|
|---|
| 62 | Q XMZ_"."_XMCRE8_"@"_^XMB("NETNAME")
|
|---|
| 63 | TOLIST(XMZ,XMNETNAM) ;
|
|---|
| 64 | N XMTO,XMIEN
|
|---|
| 65 | 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:""))
|
|---|
| 66 | F S XMIEN=$O(^XMB(3.9,XMZ,6,XMIEN)) Q:'XMIEN!(XMIEN>50) D Q:ER
|
|---|
| 67 | . S XMTO=$$TOFORMAT($P(^XMB(3.9,XMZ,6,XMIEN,0),U,1),$S($G(XMC("MAILMAN")):$P(^(0),U,2),1:""))
|
|---|
| 68 | . S XMSG=XMSG_","
|
|---|
| 69 | . I $L(XMSG)+$L(XMTO)>80 D TOSEND(.XMSG) Q:ER
|
|---|
| 70 | . S XMSG=XMSG_" "_XMTO
|
|---|
| 71 | Q:ER
|
|---|
| 72 | D TOSEND(.XMSG) Q:ER
|
|---|
| 73 | I XMIEN>50 S XMSG="(Too many recipients to list...)" D TOSEND(.XMSG) Q:ER
|
|---|
| 74 | Q
|
|---|
| 75 | TOFORMAT(XMTO,XMPREFIX) ;
|
|---|
| 76 | N XMDOM
|
|---|
| 77 | S XMDOM=$S(XMTO["@":$P(XMTO,"@",2,99),1:XMNETNAM)
|
|---|
| 78 | S XMTO=$$TO($P(XMTO,"@"))
|
|---|
| 79 | Q $S(XMPREFIX="":"",$E(XMTO,1)=$C(34):"",1:XMPREFIX_":")_XMTO_"@"_XMDOM
|
|---|
| 80 | TO(XMTO) ;
|
|---|
| 81 | I $E(XMTO)'=$C(34),(XMTO[",")!(XMTO[" ") D
|
|---|
| 82 | . I XMTO["," S XMTO=$TR(XMTO,", .","._+")
|
|---|
| 83 | . I XMTO[" " S XMTO=$C(34)_XMTO_$C(34)
|
|---|
| 84 | Q XMTO
|
|---|
| 85 | TOSEND(XMSG) ;
|
|---|
| 86 | I $L(XMSG)>80 D Q
|
|---|
| 87 | . N XMSGHOLD,XMPIECES
|
|---|
| 88 | . S XMPIECES=$L(XMSG,"@")
|
|---|
| 89 | . S XMSGHOLD=$P(XMSG,"@",XMPIECES)
|
|---|
| 90 | . S XMSG=$P(XMSG,"@",1,XMPIECES-1)
|
|---|
| 91 | . X XMSEN
|
|---|
| 92 | . S XMSG=" @"_XMSGHOLD
|
|---|
| 93 | X XMSEN
|
|---|
| 94 | S XMSG=" "
|
|---|
| 95 | Q
|
|---|
| 96 | TEXT(XMZ) ; Send body of text
|
|---|
| 97 | N XMS0AJ
|
|---|
| 98 | ;S XMBLOCK=1 ; *** What's this? See ^XML4CRC* & ^XMLSWP*
|
|---|
| 99 | S XMS0AJ=0
|
|---|
| 100 | F S XMS0AJ=$O(^XMB(3.9,XMZ,2,XMS0AJ)) Q:XMS0AJ'>0 D Q:ER
|
|---|
| 101 | . S XMSG=^XMB(3.9,XMZ,2,XMS0AJ,0)
|
|---|
| 102 | . I $E(XMSG)="." S XMSG="."_XMSG
|
|---|
| 103 | . E I $E(XMSG,1,4)="~*~^" S XMSG=" "_XMSG ; *** What's this?
|
|---|
| 104 | . X XMSEN
|
|---|
| 105 | I ER S ER("MSG")="Error sending msg "_XMZ_", text line "_XMS0AJ Q
|
|---|
| 106 | ;D:$D(XMBLOCK) KILL^XML4CRC
|
|---|
| 107 | Q
|
|---|
| 108 | RCPTERR(XMERRMSG,XMZ,XMZREC,XMNVFROM,XMRCPTO,XMRCPT,XMIEN) ; Non-delivery to recipient
|
|---|
| 109 | N XMFDA,XMIENS,XMTO,XMPARM,XMINSTR
|
|---|
| 110 | S XMIENS=XMIEN_","_XMZ_","
|
|---|
| 111 | S XMFDA(3.91,XMIENS,3)="@" ; remote msg id
|
|---|
| 112 | S XMFDA(3.91,XMIENS,4)=XMCM("START","FM") ; xmit date/time
|
|---|
| 113 | S XMFDA(3.91,XMIENS,5)=$E($P(XMERRMSG," ",2,999),1,30) ; status
|
|---|
| 114 | S XMFDA(3.91,XMIENS,6)="@" ; path
|
|---|
| 115 | D FILE^DIE("","XMFDA")
|
|---|
| 116 | S XMTO=$$SENDER(XMZ,XMZREC,XMNVFROM,XMIEN,1,XMERRMSG) Q:"<>"[XMTO
|
|---|
| 117 | S XMINSTR("FROM")="POSTMASTER"
|
|---|
| 118 | S XMPARM(1)=$P(XMZREC,U,1) ; subject
|
|---|
| 119 | S XMPARM(2)=XMRCPTO
|
|---|
| 120 | S XMPARM(3)=XMERRMSG
|
|---|
| 121 | S XMPARM(4)=XMRCPT
|
|---|
| 122 | S XMPARM(5)=$S(XMTO["@":$G(^XMB(3.9,XMZ,5)),1:XMZ)
|
|---|
| 123 | D TASKBULL^XMXBULL(.5,"XM SEND ERR RECIPIENT",.XMPARM,"",XMTO,.XMINSTR)
|
|---|
| 124 | Q
|
|---|
| 125 | MSGERR(XMSITE,XMINST,XMERRMSG,XMZ,XMZREC,XMNVFROM,XMRCPT) ;
|
|---|
| 126 | ; If a message is rejected at a site for any reason (the whole message,
|
|---|
| 127 | ; not just one recipient), then this message may be sent.
|
|---|
| 128 | N XMTO,XMPARM,XMIEN,XMNAME,XMCNT,XMINSTR
|
|---|
| 129 | D DOTRAN^XMC1(XMERRMSG)
|
|---|
| 130 | S XMPARM(3)=XMERRMSG
|
|---|
| 131 | S XMERRMSG=$E($P(XMERRMSG," ",2,999),1,30)
|
|---|
| 132 | K ^TMP("XM",$J,"REJECT")
|
|---|
| 133 | S XMIEN=""
|
|---|
| 134 | F S XMIEN=$S($D(XMRCPT):$O(XMRCPT(XMIEN)),1:$O(^XMB(3.9,XMZ,1,"AQUEUE",XMINST,XMIEN))) Q:XMIEN="" D
|
|---|
| 135 | . N XMFDA,XMIENS
|
|---|
| 136 | . S XMIENS=XMIEN_","_XMZ_","
|
|---|
| 137 | . S XMFDA(3.91,XMIENS,3)="@" ; remote msg id
|
|---|
| 138 | . S XMFDA(3.91,XMIENS,4)=XMCM("START","FM") ; xmit date/time
|
|---|
| 139 | . S XMFDA(3.91,XMIENS,5)=XMERRMSG ; status
|
|---|
| 140 | . S XMFDA(3.91,XMIENS,6)="@" ; path
|
|---|
| 141 | . S XMFDA(3.91,XMIENS,9)="@" ; xmit time
|
|---|
| 142 | . D FILE^DIE("","XMFDA")
|
|---|
| 143 | . S XMNAME=$P($G(^XMB(3.9,XMZ,1,XMIEN,0)),U,1) Q:XMNAME=""
|
|---|
| 144 | . S XMTO=$$SENDER(XMZ,XMZREC,XMNVFROM,XMIEN) Q:"<>"[XMTO
|
|---|
| 145 | . S (XMCNT,^(XMTO))=$G(^TMP("XM",$J,"REJECT",XMTO))+1
|
|---|
| 146 | . S ^TMP("XM",$J,"REJECT",XMTO,XMCNT)=XMNAME
|
|---|
| 147 | S XMINSTR("FROM")="POSTMASTER"
|
|---|
| 148 | S XMPARM(1)=$P(XMZREC,U,1) ; subject
|
|---|
| 149 | S XMPARM(2)=XMSITE
|
|---|
| 150 | S XMTO=""
|
|---|
| 151 | 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)
|
|---|
| 152 | K ^TMP("XM",$J,"REJECT")
|
|---|
| 153 | Q
|
|---|
| 154 | SENDER(XMZ,XMZREC,XMNVFROM,XMIEN,XMDELFWD,XMERRMSG) ; Function returns 'to whom to send error message'
|
|---|
| 155 | N XMFWDREC,XMFWDR
|
|---|
| 156 | S XMFWDREC=$G(^XMB(3.9,XMZ,1,XMIEN,"F")) ; Try to find forwarder
|
|---|
| 157 | S XMFWDR=$P(XMFWDREC,U,2)
|
|---|
| 158 | I XMFWDR'="" D Q XMFWDR ; Forwarder is local
|
|---|
| 159 | . I $G(XMDELFWD) D DELFWD(XMZ,XMIEN,XMFWDR,XMERRMSG)
|
|---|
| 160 | I $E(XMFWDREC)="<" Q $E($P($P(XMFWDREC,U,1),">",1),2,999) ; Forwarder is remote
|
|---|
| 161 | Q:$D(^XMB(3.9,XMZ,.7)) XMNVFROM ; Sender is remote
|
|---|
| 162 | N XMFROM
|
|---|
| 163 | S XMFROM=$P(XMZREC,U,2)
|
|---|
| 164 | I +XMFROM=XMFROM Q XMFROM ; Sender is local
|
|---|
| 165 | I XMFROM'["@" Q .5 ; Sender is fictitious, so notify postmaster
|
|---|
| 166 | Q XMNVFROM ; Sender is remote
|
|---|
| 167 | DELFWD(XMZ,XMIEN,XMFWDR,XMERRMSG) ; Delete user's forwarding address
|
|---|
| 168 | Q:+XMFWDR'=XMFWDR
|
|---|
| 169 | N XMFWD
|
|---|
| 170 | S XMFWD=$P(^XMB(3.7,XMFWDR,0),U,2) Q:XMFWD=""
|
|---|
| 171 | N XMINSTR,XMADDR,XMFULL,XMERROR,XMFDA,XMTXT,XMFWDADD
|
|---|
| 172 | S XMINSTR("ADDR FLAGS")="X" ; do not create ^TMP(, just check.
|
|---|
| 173 | S XMADDR=$P(^XMB(3.9,XMZ,1,XMIEN,0),U,1)
|
|---|
| 174 | D ADDRESS^XMXADDR(DUZ,XMFWD,.XMFULL,.XMERROR)
|
|---|
| 175 | I '$D(XMERROR),XMADDR'=$G(XMFULL) Q
|
|---|
| 176 | D DELFWD^XMVVITA(XMFWDR,XMFWD,XMERRMSG)
|
|---|
| 177 | Q
|
|---|
| 178 | ; The following has nothing to do with the above.
|
|---|
| 179 | ; These are used by the SERVER Communications Protocol in file 3.4.
|
|---|
| 180 | REC ; Read the next line of text from the message. When called for the
|
|---|
| 181 | ; first time, returns the first line.
|
|---|
| 182 | ; In:
|
|---|
| 183 | ; XMZ - IEN of the message in file 3.9
|
|---|
| 184 | ; XMPOS - (optional) line number of the previous line read
|
|---|
| 185 | ; Default is .999999
|
|---|
| 186 | ; Out:
|
|---|
| 187 | ; XMPOS - line number of XMRG
|
|---|
| 188 | ; XMRG - =the next line of text, if OK; ="" if end of text reached
|
|---|
| 189 | ; XMER - =0 if OK; =-1 if end of text reached
|
|---|
| 190 | S XMPOS=$S('$D(XMPOS):.999999,XMPOS<.999999:.999999,1:XMPOS)
|
|---|
| 191 | S XMPOS=$O(^XMB(3.9,XMZ,2,XMPOS))
|
|---|
| 192 | I +XMPOS'=XMPOS S XMER=-1,XMRG="" Q
|
|---|
| 193 | S XMRG=^XMB(3.9,XMZ,2,XMPOS,0),XMER=0
|
|---|
| 194 | Q
|
|---|
| 195 | SEN ; Send a line to the return message
|
|---|
| 196 | S XMSLINE=XMSLINE+1,^XMB(3.9,XMZ,2,XMSLINE,0)=XMSG
|
|---|
| 197 | Q
|
|---|
| 198 | OPEN ; Open the reverse message path
|
|---|
| 199 | Q
|
|---|
| 200 | CLOSE ; Close the reverse message
|
|---|
| 201 | S ^XMB(3.9,XMZ,2,0)="^3.92A^"_XMSLINE_U_XMSLINE_U_DT
|
|---|
| 202 | Q
|
|---|
