source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMRTCP.m@ 701

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

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1XMRTCP ;(WASH ISC)/THM/CAP-SMTP Receiver ;10/09/2002 14:23
2 ;;8.0;MailMan;**7**;Jun 28, 2002
3 ;Modified for TCP/IP under INET_SERVERS of Wollongong
4 ;
5POLL ;Poll all domains with flags set
6 ;Fake TaskMan Env.
7 S U="^",X="ERR^XMRTCP",@^%ZOSF("TRAP"),XMDUZ=.5
8 K XM S IOP="NULL",%IS=0 D ^%ZIS I '$D(IOT) S IOT=""
9HANG S IO(0)=IO,ZTQUEUED=$S($D(ZTQUEUED):ZTQUEUED,1:1),ZTSK=$S($D(ZTSK):ZTSK,1:"N/A"),XM="",XMLTCPT=""
10 I $G(^TMP("XMRTCP",0)) S XMLTCPT=^(0) K ^(0)
11L Q:$P(^XMB(1,1,0),U,18)=1
12 ;
13 ;Any queues flagged (x-ref is set by TCP/IP POLL FLAG in domain file)
14 S XMLTCPT=$O(^DIC(4.2,"ATCP",1,XMLTCPT)) G QQ:XMLTCPT=""
15 S XMINST=XMLTCPT
16 ;
17RQ ;Transmit messages / execute TURN command
18 ;Are there messages to send ?
19 I '$O(^XMB(3.7,.5,2,XMINST+1000,1,0)) G L
20 ;Job out, if all slots full wait and try again.
21 S %=$$CK(1) I '% S XMLTCPT=$O(^DIC(4.2,"ATCP",1,XMLTCPT),-1) H 60 G L
22 D SETUP L +^XMBX("TCPCHAN",XMINST):3 E L -^XMBX("TCPCHAN-COUNT",%) G L
23 ;
24 S XMRTCP("CNT")=%
25 ;
26 ;Change name (prevent dupe error), then JOB myself
27 Q:$E($G(XMRTCP("NAME")),1,6)="MM-FTP"
28 S XMRTCP("NAME")="MM-TCP-"_XMINST D REN^XMRFTP
29 S X=^%ZOSF("ERRTN"),@^%ZOSF("TRAP")
30 ;
31 ;Deliver messages
32 ;
33 ;INIT
34 S XMSITE=$P(^DIC(4.2,XMINST,0),"^")
35 D XMTCHECK^XMKPR(XMINST,.XMB)
36 S XMOKTYPE("TCPCHAN")="" ;Find and use TCP/IP channel script
37 D SCRIPT^XMKPR1(XMINST,XMSITE,.XMB,.XMOKTYPE) Q:'XMB("SCR IEN")
38 ; Check that last try is at least 1 minute ago.
39 ; If we've completed a cycle of scripts, wait until 1 hour has passed
40 ; before we start the next cycle.
41 I XMB("TRIES"),$$FMDIFF^XLFDT($$NOW^XLFDT,XMB("LAST TRY"),2)\60<1 G HALT
42 E I XMB("ITERATIONS"),XMB("SCR IEN")=XMB("FIRST SCRIPT"),$$FMDIFF^XLFDT($$NOW^XLFDT,XMB("LAST TRY"),2)\60\60<1 G HALT
43 S ZTIO=$P(XMB("SCRIPT"),U,5)
44 D XMTAUDT^XMTDR(XMINST,.XMB)
45 D ENT^XMC1
46 H 30
47 D KILL
48 G HALT
49 ;
50 ;Pause between POLLINGS
51QQ D KILL S X=$H*86400+$P($H,",",2) G:$O(^XMBX(4.2995,0)) FTP^XMRFTP
52 S X=22-($H*86400+$P($H,",",2)-X) I X>0 H X
53 G POLL
54 ;
55 ;Entry on dupe name
56DUPNAME S X="ERR^XMRTCP",@^%ZOSF("TRAP") H 15 G L
57 ;
58 ;Clean up before next transmission
59KILL D KL1^XMC K DIC,XMB,XMDT,ZTPAR
60 L Q
61 ;
62SETUP ;Set up environment
63 N IO S IO="",IO(0)="" D DT^DICRW
64 Q
65ERR D @^%ZOSF("ERRTN") H 60
66 I '$F(":MM-TCP:MM-FTP:",":"_$E($G(XMRTCP("NAME")),1,6)_":") D KILL G POLL
67HALT ;
68 ;I ^%ZOSF("OS")["VAX" U IO:DISCONNECT
69 ;G ^XUSCLEAN ; Writes to IO.
70 G H2^XUSCLEAN ; Supposedly doesn't write to IO.
71 ;
72 ;Entry for Inet_servers interface RECEIVER
73 ;SMTP service request invokes MailMan
74 ;
75SOC25 S (XMRPORT,IO,IO(0))=%,X=$E(%_"-INETMM",1,15) D SETENV^%ZOSV
76 D DT^DICRW,DUZ^XUP(.5)
77 S X="ERR^ZU",@^%ZOSF("TRAP"),ER=0
78 O IO:(SHARE,MAILBOX) U IO
79 S XMCHAN="TCP/IP-MAILMAN",XMNO220=""
80 D ENT^XMR
81 G HALT
82 ;
83 ;Check if slot on TCP/IP to use
84CK(X) S I=$P(^XMB(1,1,0),"^",17)
85 F %=1:1 L +^XMBX("TCPCHAN-COUNT",%):1 Q:$T Q:%=I
86 Q $S($T:%,1:0)
87JOB ;
88 H 90 ;wait for RVG mounts
89 S $P(^XMB(1,1,0),"^",18)="" ;Clear the TCP/IP poller run flag
90START G START^XMRTCPGO
91ERRSCRPT ;TRAP transmission errors
92 S ER=1
93 I ^%ZOSF("OS")["VAX DSM" S $ECODE=""
94 Q
Note: See TracBrowser for help on using the repository browser.