source: FOIAVistA/trunk/r/MAILMAN-XM/XMR.m@ 1535

Last change on this file since 1535 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 5.9 KB
Line 
1XMR ;ISC-SF/GMB-SMTP Receiver (RFC 821) ;09/24/2003 12:25
2 ;;8.0;MailMan;**22**;Jun 28, 2002
3ENT ; INITIALIZE
4 S ER=0
5 S XMC("NOREQUEUE")=1
6 D GET^XMCXT(0)
7 I '$D(XMC("BATCH")) S XMC("BATCH")=0
8 D OPEN^XML I ER!$G(POP) D Q
9 . D ^%ZISC:IO'=$G(IO(0)) W !,$C(7),$$EZBLD^DIALOG($S(ER:42227,1:37000)) ;Open failed / up-arrow out.
10 S:'$D(XM) XM=""
11 I XMC("BATCH") U IO
12 E D
13 . X ^%ZOSF("EOFF")
14 . S X=255
15 . X ^%ZOSF("RM"),^%ZOSF("TYPE-AHEAD")
16 S XMC("START")=$$TSTAMP^XMXUTIL1-.001
17 D RECEIVE
18 ;I $G(XMINST) D XMTFINIS^XMTDR(XMINST)
19 Q
20RECEIVE ; BEGINNING OF INTERPRETER
21 ; The following variables are used in here only. They are not
22 ; 'new'd because this routine may be called recursively via the
23 ; TURN command, which alternates sending and receiving.
24 S XMC("DIR")="R"
25 D KILL
26 S XMEC=0,XMCONT="^HELP^NOOP^RSET^QUIT^VRFY^EXPN^STAT^CHRS^ECHO^"
27 D DOTRAN^XMC1(42300,$$FMTE^XLFDT(DT,5)) ;Transcript Date: |1|
28 S XMSTATE="^HELO^QUIT^"
29 I 'XMC("BATCH") D
30 . D BUFLUSH^XML
31 . W:'$D(XMNO220) 220
32 . H 2
33 . S XMSG="220 "_$G(^XMB("NETNAME"))_" MailMan "_$P($T(XMR+1),";",3)_" ready" X XMSEN
34 F D Q:ER!($G(XMCMD)="QUIT")!$G(XMC("QUIT"))
35 . D DOTRAN^XMC1(42301) ;Waiting for input
36 . S XMSTIME=300 X XMREC K XMSTIME Q:ER
37 . S XMP=XMRG
38 . F I=$C(9)," " F Q:XMP'[I S XMP=$P(XMP,I,1)_" "_$P(XMP,I,2,999) ; strip tabs / extra blanks
39 . S XMCMD=$$UP^XLFSTR($P(XMP," ")),XMP=$P(XMP," ",2,999)
40 . Q:XMCMD=""
41 . I XMSTATE_XMCONT'[(U_XMCMD_U) D ERRCMD Q
42 . I $T(@XMCMD)="" S XMSG="502 Command not implemented" X XMSEN Q
43 . D @XMCMD
44 I $G(XMCMD)="QUIT"!ER,$G(XMZ) D ZAPIT^XMXMSGS2(.5,.95,XMZ)
45 S:$G(XMINST) $P(^XMBS(4.2999,XMINST,3),U,1,6)="^^^^^"
46 D KILL
47 Q
48KILL ;
49 K I,X,XMC("HELO RECV"),XMCMD,XMCONT,XMEC,XMINSTR,XMNVFROM,XMP
50 K XMREMID,XMRXMZ,XMRVAL,XMSTATE,XM2LONG,XMZ,XMZFDA,XMZIENS
51 K XMERR,^TMP("XMERR",$J)
52 Q
53CHRS ;;Christen this domain syntax: CHRS <parent>,<child>
54 N XMPARENT,XMCHILD,X,Y,DIC
55 S XMPARENT=$P(XMP,",",1),XMCHILD=$P(XMP,",",2)
56 S X=XMPARENT
57 S DIC=4.2,DIC(0)="MF"
58 D ^DIC
59 I +Y'=$P(^XMB(1,1,0),U,3) S XMSG="550 Parent name does not match locally initialized parent name" X XMSEN Q
60 S X=XMCHILD
61 S DIC=4.2
62 D ^DIC
63 I +Y'=$P(^XMB(1,1,0),U,1) S XMSG="550 Child name does not match locally initialized domain name" X XMSEN Q
64 S ^XMB("NETNAME")=$P(Y,U,2)
65 S $P(^XMB(1,1,0),U,4)=DT
66 S XMSG="250 Local domain "_$P(Y,U,2)_" successfully christened by parent "_XMPARENT X XMSEN
67 Q
68DATA ;;TEXT / ASSUMES VALID RECIPIENT
69 D DATA^XMR3
70 Q
71ECHO ;;ECHO TEST
72 S XMSG="314 Echo mode. Received messages will be echoed until a single period is received" X XMSEN Q:ER
73 F X XMREC Q:ER Q:XMRG="." S XMSG=XMRG X XMSEN Q:ER
74 Q:ER
75 S XMSG="250 End of echo mode" X XMSEN
76 Q
77EXPN ;;EXPAND MAILING LIST
78 N XMIEN,XMPTR,XMCNT,XMNETNAM,Y,X,DIC
79 S X=XMP
80 I X["<" S X=$P($P(X,"<",2),">")
81 I "^G.^g.^"[(U_$E(X,1,2)_U) S X=$E(X,3,999)
82 S DIC="^XMB(3.8,",DIC(0)="MF"
83 D ^DIC I Y<0 S XMSG="550 mail group not found" X XMSEN Q
84 S XMIEN=+Y,XMCNT=0,XMNETNAM=^XMB("NETNAME"),XMPTR=""
85 F S XMPTR=$O(^XMB(3.8,XMIEN,1,"B",XMPTR)) Q:'XMPTR D Q:ER
86 . Q:'$D(^VA(200,XMPTR,0))
87 . S XMCNT=XMCNT+1
88 . S XMSG="250 <"_$TR($$NAME^XMXUTIL(XMPTR),". ,","+_.")_"@"_XMNETNAM_">" X XMSEN
89 I 'XMCNT S XMSG="250 No LOCAL members in group" X XMSEN Q:ER
90 S XMSG="250 List SHOWS local members only, not member groups, remote members or distribution lists." X XMSEN
91 Q
92HELO ;;HELO COMMAND
93 D HELO^XMR1
94 Q
95HELP ;;DISPLAY HELP MESSAGE
96 D HELPME^XMR4
97 Q
98MAIL ;;START
99 D:$D(XMRVAL) VALSET^XMR1(XMINST,.XMRVAL)
100 D MAIL^XMR1
101 Q
102MESS ;;
103 D MESS^XMR2
104 Q
105NOOP ;;NO OPERATION FOR TESTING
106 S XMSG="250 OK" X XMSEN
107 Q
108QUIT ;;
109 D:$D(XMRVAL) VALSET^XMR1(XMINST,.XMRVAL)
110 S XMSG="221 "_$G(^XMB("NETNAME"))_" Service closing transmission channel" X XMSEN
111 S XMC("QUIT")=1
112 Q
113RCPT ;;
114 D RCPT^XMR1
115 Q
116RSET ;;RESET STATE TABLES
117 N X,XMI,Y,DIC
118 I $G(XMZ) D
119 . I $D(^XMB(3.9,XMZ,0)),'$D(^XMB(3.9,XMZ,1,0)) D KILLMSG^XMXUTIL(XMZ)
120 . I $D(^XMB(3.7,.5,2,.95,1,XMZ)) D ZAPIT^XMXMSGS2(.5,.95,XMZ)
121 S XMSTATE="HELO^MAIL^"
122 K XMZ,XMZFDA,XMZIENS,^TMP("XMY",$J),^TMP("XMY0",$J)
123 S XMSG="250" X XMSEN Q
124 Q
125STAT ;;
126 N K,I,J
127 I $G(XMNVFROM)'="" S XMSG="211-Current reverse path is: "_XMNVFROM X XMSEN Q:ER
128 I $G(XMINST)'="" S XMSG="211-Current sender is: "_$P(^DIC(4.2,XMINST,0),U) X XMSEN Q:ER
129 S XMSG="211-Acceptable commands at the moment are: " X XMSEN Q:ER
130 S XMSG="211-"
131 S K=XMSTATE_XMCONT F I=1:1:$L(K,U) S J=$P(K,U,I) I J'="" S XMSG=XMSG_J_" "
132 X XMSEN Q:ER
133 I $D(XMZ),$O(^XMB(3.9,XMZ,2,0))>0 D Q:ER
134 . S J=0
135 . S XMSG="211-Current text buffer is:" X XMSEN Q:ER
136 . F S J=$O(^XMB(3.9,XMZ,2,J)) Q:J'>0 S XMSG="211-"_J_" "_^(J,0) X XMSEN Q:ER
137 Q:ER
138 I $O(^TMP("XMY",$J,""))'="" D Q:ER
139 . S J=""
140 . S XMSG="211-Current recipients are: " X XMSEN Q:ER
141 . F S J=$O(^TMP("XMY",$J,J)) Q:J="" S XMSG="211-"_$S('J:J,1:$$NAME^XMXUTIL(J)) X XMSEN Q:ER
142 Q:ER
143 S XMSG="211 OK" X XMSEN
144 Q
145TURN ;;
146 D:$D(XMRVAL) VALSET^XMR1(XMINST,.XMRVAL)
147 ;TURN AROUND PROTOCOL
148 I $F("Yy",$P(^DIC(4.2,XMINST,0),U,16))>1 S XMSG="502 "_^XMB("NETNAME")_" has TURN disabled." X XMSEN Q
149 I '$O(^XMB(3.7,.5,2,XMINST+1000,1,0)) S XMSG="502 "_^XMB("NETNAME")_" has no messages to export" X XMSEN Q
150 I $P(^DIC(4.2,XMINST,0),U)'=$G(XMC("HELO RECV")) S XMSG="502 TURN command rejected." X XMSEN Q
151 S XMSG="250 "_^XMB("NETNAME")_" has messages to export" X XMSEN Q:ER
152 D KILL
153 G SEND^XMS
154VRFY ;;VERIFY USER EXISTS
155 N XMNAME
156 S XMINSTR("ADDR FLAGS")="X" ; Do not expand
157 S XMNAME=$$LOOKUP^XMR1(XMP,.XMINSTR)
158 K XMINSTR("ADDR FLAGS")
159 Q:XMNAME=0
160 S XMSG="250 "_XMNAME_" <"_$TR(Y,". ,","+_.")_"@"_^XMB("NETNAME")_">" X XMSEN
161 Q
162ERRCMD ;
163 S XMEC=XMEC+1
164 I XMEC>9 S ER=1,XMSG="500 too many errors or fatal error, closing channel"
165 E S XMSG="500 Syntax error, command ("_XMCMD_") out of sequence, or unrecognized command"
166 X XMSEN
167 Q
168TST ;
169 S XM="",XMC("BATCH")=0,XMC("DX")=1,XMCHAN="TEST"
170 D OPEN^XML
171 D RECEIVE
172 D KILL^XMC
173 Q
174DECNET ; Task-Task Communications
175 I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D R^XMCTRAP"
176 E S X="R^XMCTRAP",@^%ZOSF("TRAP")
177 S (IO,I0(0))="SYS$NET",XMCHAN="DECNET" D DT^DICRW O IO U IO
178 G ENT
Note: See TracBrowser for help on using the repository browser.