OpenVista/GT.M Integration

Merge lp://staging/~jeff-apple/openvista-gtm-integration/bug404640 into lp://staging/openvista-gtm-integration

  1. bug404640
  2. Merge into mainline
Proposed by jeff.apple
Status: Merged
Merged at revision: not available
Proposed branch: lp://staging/~jeff-apple/openvista-gtm-integration/bug404640
Merge into: lp://staging/openvista-gtm-integration
Diff against target: None lines
To merge this branch: bzr merge lp://staging/~jeff-apple/openvista-gtm-integration/bug404640
Reviewer Review Type Date Requested Status
JSHER Approve
Review via email: mp+9810@code.staging.launchpad.net
To post a comment you must log in.
Revision history for this message
JSHER (joel-sher) :
review: Approve

Preview Diff

[H/L] Next/Prev Comment, [J/K] Next/Prev File, [N/P] Next/Prev Hunk
1=== added file 'mumps/XWBRW.m'
2--- mumps/XWBRW.m 1970-01-01 00:00:00 +0000
3+++ mumps/XWBRW.m 2009-08-06 22:57:33 +0000
4@@ -0,0 +1,92 @@
5+XWBRW ;ISF/RWF,MSC/JDA - Read/Write for Broker TCP ;06AUG2009
6+ ;;1.1;RPC BROKER;**35**;Mar 28, 1997
7+ Q
8+ ;
9+ ;XWBRBUF is global
10+ ;SE is a flag to skip error for short read. From PRSB+41^XWBBRK
11+BREAD(L,TO,SE) ;read tcp buffer, L is length, TO is timeout
12+ N R,S,DONE,C
13+ I L'>0 Q ""
14+ I $L(XWBRBUF)'<L S R=$E(XWBRBUF,1,L),XWBRBUF=$E(XWBRBUF,L+1,999999) Q R
15+ S R="",DONE=0,L=+L,C=0
16+ S TO=$S($G(TO)>0:TO,$G(XWBTIME(1))>0:XWBTIME(1),1:60)/2+1
17+ U XWBTDEV
18+ F D Q:DONE
19+ . S S=L-$L(R),R=R_$E(XWBRBUF,1,S),XWBRBUF=$E(XWBRBUF,S+1,999999)
20+ . I ($L(R)=L)!(R[$C(4))!(C>TO) S DONE=1 Q
21+ . R XWBRBUF#S:2 S:'$T C=C+1 S:$L(XWBRBUF) C=0
22+ . I $D D LOG^XWBDLOG("Device error: "_$D) S DONE=1
23+ . I $G(XWBDEBUG)>2,$L(XWBRBUF) D LOG^XWBDLOG("rd: "_$E(XWBRBUF,1,252))
24+ . Q
25+ I $L(R)<L,'$G(SE) S $ECODE=",U411," ;Throw Error, Did not read full length
26+ Q R
27+ ;
28+QSND(XWBR) ;Quick send
29+ S XWBPTYPE=1,XWBERROR="",XWBSEC="" D SND
30+ Q
31+ ;
32+ESND(XWBR) ;Send from ETRAP
33+ S XWBPTYPE=1 D SND
34+ Q
35+ ;
36+SND ; Send a responce
37+ N XWBSBUF S XWBSBUF=""
38+ U XWBTDEV
39+ ;
40+ D SNDERR ;Send any error info
41+ D SNDDATA ;Send the data
42+ ;D WRITE($C(4)) ;EOT
43+ D WRITE($C(4)),WBF
44+ Q
45+ ;
46+SNDDATA ;Send the data part
47+ N I,D
48+ ; -- single value
49+ I XWBPTYPE=1 D WRITE($G(XWBR)) Q
50+ ; -- table delimited by CR+LF
51+ I XWBPTYPE=2 D Q
52+ . S I="" F S I=$O(XWBR(I)) Q:I="" D WRITE(XWBR(I)),WRITE($C(13,10))
53+ ; -- word processing
54+ I XWBPTYPE=3 D Q
55+ . S I="" F S I=$O(XWBR(I)) Q:I="" D WRITE(XWBR(I)) D:XWBWRAP WRITE($C(13,10))
56+ ; -- global array
57+ I XWBPTYPE=4 D Q
58+ . I $E($G(XWBR))'="^" Q
59+ . S I=$G(XWBR) Q:I="" S T=$E(I,1,$L(I)-1)
60+ . ;Only send root node if non-null.
61+ . I $D(@I)>10 S D=@I I $L(D) D WRITE(D),WRITE($C(13,10)):XWBWRAP&(D'=$C(13,10))
62+ . F S I=$Q(@I) Q:I=""!(I'[T) S D=@I D WRITE(D),WRITE($C(13,10)):XWBWRAP&(D'=$C(13,10))
63+ . I $D(@XWBR) K @XWBR
64+ ; -- global instance
65+ I XWBPTYPE=5 D Q
66+ . I $E($G(XWBR))'="^" Q
67+ . S XWBR=$G(@XWBR) D WRITE(XWBR) Q
68+ ; -- variable length records only good upto 255 char)
69+ I XWBPTYPE=6 D
70+ . S I="" F S I=$O(XWBR(I)) Q:I="" D WRITE($C($L(XWBR(I)))),WRITE(XWBR(I))
71+ Q
72+ ;
73+SNDERR ;send error information
74+ ;XWBSEC is the security packet, XWBERROR is application packet
75+ N X
76+ S $X=0 ;Start with zero
77+ S X=$E($G(XWBSEC),1,255)
78+ D WRITE($C($L(X))_X)
79+ S X=$E($G(XWBERROR),1,255)
80+ D WRITE($C($L(X))_X)
81+ S XWBERROR="",XWBSEC="" ;clears parameters
82+ Q
83+ ;
84+WRITE(STR) ;Write a data string
85+ ; send data for DSM (requires buffer flush (!) every 511 chars)
86+ ;IF XWBOS="DSM"!(XWBOS="UNIX")!(XWBOS="OpenM) next line
87+ F Q:'$L(STR) D
88+ . I $L(XWBSBUF)+$L(STR)>240 D WBF
89+ . S XWBSBUF=XWBSBUF_$E(STR,1,255),STR=$E(STR,256,99999)
90+ Q
91+WBF ;Write Buffer Flush
92+ Q:'$L(XWBSBUF)
93+ I $G(XWBDEBUG)>2,$L(XWBSBUF) D LOG^XWBDLOG("wrt ("_$L(XWBSBUF)_"): "_$E(XWBSBUF,1,247))
94+ W XWBSBUF,@XWBT("BF")
95+ S XWBSBUF=""
96+ Q
97
98=== added file 'mumps/XWBSEC.m'
99--- mumps/XWBSEC.m 1970-01-01 00:00:00 +0000
100+++ mumps/XWBSEC.m 2009-08-06 23:53:40 +0000
101@@ -0,0 +1,55 @@
102+XWBSEC ;SFISC/VYD,MSC/JDA - RPC BROKER ;06AUG2009
103+ ;;1.1;RPC BROKER;**3,6,10,35**;Mar 28, 1997
104+CHKPRMIT(XWBRP) ;checks to see if remote procedure is permited to run
105+ ;Input: XWBRP - Remote procedure to check
106+ Q:$$KCHK^XUSRB("XUPROGMODE")
107+ N ERR,XWBPRMIT,XWBALLOW
108+ S U="^",XWBSEC="" ;Return XWBSEC="" if OK to run RPC
109+ ;
110+ ;In the beginning, when no DUZ is defined and no context exist, setup
111+ ;default signon context
112+ I '$G(DUZ) S DUZ=0,XQY0="XUS SIGNON" D CRCONTXT(.ERR,$$ENCRYP^XUSRB1(XQY0)) ;set up default context
113+ ;
114+ ;These RPC's are allowed in any context, so we can just quit
115+ I "^XWB IM HERE^XWB CREATE CONTEXT^XWB RPC LIST^XWB IS RPC AVAILABLE^XUS GET USER INFO^XUS GET TOKEN^"[(U_XWBRP_U) Q
116+ ;VistAlink RPC's that are always allowed.
117+ I "^XUS KAAJEE GET USER INFO^XUS KAAJEE LOGOUT^"[(U_XWBRP_U) Q
118+ ;
119+ ;If in Signon context, only allow XUS and XWB rpc's
120+ I $G(XQY0)="XUS SIGNON","^XUS^XWB^"'[(U_$E(XWBRP,1,3)_U) S XWBSEC="Application context has not been created!" Q
121+ ;XQCS allows all users access to the XUS SIGNON context.
122+ ;Also to any context in the XUCOMMAND menu.
123+ ;
124+ I $G(XQY0)'="" D ;1.1*6. XQY0="" after XUS SIGNON context deleted.
125+ . S XWBALLOW=$$CHK^XQCS(DUZ,$P(XQY0,U),XWBRP) ;do the check
126+ . S:'XWBALLOW XWBSEC=XWBALLOW
127+ E S XWBSEC="Application context has not been created!"
128+ Q
129+ ;
130+ ;
131+CRCONTXT(RESULT,OPTION) ;creates context for the passed in option
132+ K XQY0,XQY N XWB1,XABPGMOD,XWBPGMOD S RESULT=0
133+ S OPTION=$$DECRYP^XUSRB1(OPTION) ;S:OPTION="" OPTION="\"
134+ I OPTION="" S XQY=0,XQY0="",RESULT=1 K ^TMP("XQCS",$J) Q ;delete context if "" passed in.
135+ S XWB1=$$OPTLK^XQCS(OPTION)
136+ I XWB1="" S (XWBSEC,RESULT)="The context '"_OPTION_"' does not exist on server." Q ;P10
137+ S RESULT=$$CHK^XQCS(DUZ,XWB1)
138+ ;Access or programmer
139+ S XWBPGMOD=$$KCHK^XUSRB("XUPROGMODE")
140+ I RESULT!XWBPGMOD S XQY0=OPTION,XQY=XWB1,RESULT=1
141+ E S XWBSEC=RESULT
142+ Q
143+ ;
144+ ;
145+STATE(%) ;Return a state value
146+ Q:'$L($G(%)) $G(XWBSTATE)
147+ Q $G(XWBSTATE(%))
148+ ;
149+ ;
150+SET(%,VALUE) ;Set the state variable
151+ I $G(%)="" S XWBSTATE=VALUE
152+ S XWBSTATE(%)=VALUE
153+ Q
154+KILL(%) ;Kill state variable
155+ I $L($G(%)) K XWBSTATE(%)
156+ Q

Subscribers

People subscribed via source and target branches