XWBTCPZ ;SLC/KCM - calls to client listener [ 12/04/94 8:58 PM ]
;;1.0T11;RPC BROKER;;Oct 31, 1995
;
STARTAPP(APP,ERR,DHCP) ; Start a windowed application (use full path name)
; input: X is name of windowed app
; output: ERR is returned error code (passed by reference)
N X,I,DEV,LEN,OS,SKT
S SKT=9100,ERR="unknown error" IF '$L(APP) S ERR="no app" Q
S OS=$S(^%ZOSF("OS")["DSM":"DSM",^("OS")["MSM":"MSM",1:"")
; -- get the IP address of the client
I OS="DSM" S IP=$P($&ZLIB.%GETDVI($P,"TT_ACCPORNAM")," ",2)
I OS="MSM" S IP="127.0.0.1" ; -- for laptop demo only
I '$L(IP) S ERR="not telnet device" Q
; -- connect to client
I OS="DSM" O SKT:(TCPCHAN:ADDRESS=IP) U SKT S DEV=SKT
I OS="MSM" O 56 U 56::"TCP" W /SOCKET(IP,SKT) S DEV=56
; -- send StartApp message
S X="StartApp^"_APP
I $G(DHCP) S X=X_" "_$$NCRYPT^XWBTCPZ(DUZ_"^password^"_$H,$C(83,69,67,82,69,84))
W X,$C(4),!
; -- get acknowledgement
R *LEN R X#LEN
I X'="ack" S ERR="not started"
E S ERR=""
; -- close socket
C DEV
U $P
Q
;
NCRYPT(SRC,KEY) ; Encrypt the string in SRC, using KEY
; Input: SRC, KEY
; Output: DEST returned as value of function
N OFFSET,SRCPOS,SRCASC,KEYPOS,DEST
S OFFSET=($R(10000)#255)+1
S DEST=$TR($J($$HEX(OFFSET),2)," ","0")
S KEYPOS=0 F SRCPOS=1:1:$L(SRC) D
. S SRCASC=($A(SRC,SRCPOS)+OFFSET)#255
. I KEYPOS<$L(KEY) S KEYPOS=KEYPOS+1
. E S KEYPOS=1
. S SRCASC=$$XOR(SRCASC,$A(KEY,KEYPOS))
. S DEST=DEST_$J($$HEX(SRCASC),2)
. S OFFSET=SRCASC
Q DEST
DCRYPT(SRC,KEY) ; Decrypt the string in SRC, using KEY
; Input: SRC, KEY
; Output: DEST returned as value of function
N OFFSET,SRCPOS,SRCASC,KEYPOS,TMPASC,DEST
S OFFSET=$$DEC($E(SRC,1,2)),DEST="",KEYPOS=0
F SRCPOS=3:2:$L(SRC) D
. S SRCASC=$$DEC($TR($E(SRC,SRCPOS,SRCPOS+1)," ",""))
. I KEYPOS<$L(KEY) S KEYPOS=KEYPOS+1
. E S KEYPOS=1
. S TMPASC=$$XOR(SRCASC,$A(KEY,KEYPOS))
. I TMPASC'>OFFSET S TMPASC=255+TMPASC-OFFSET
. E S TMPASC=TMPASC-OFFSET
. S DEST=DEST_$C(TMPASC),OFFSET=SRCASC
Q DEST
HEX(X) ; Return the hex value of the decimal number in X
N I,X1,Y S Y="",X1=16
F I=1:1 S Y=$E("0123456789ABCDEF",X#X1+1)_Y,X=X\X1 Q:X<1
Q Y
DEC(X) ; Return the decimal value of the hex number in X
N I,X1,Y S Y=0,X1=16
F I=1:1:$L(X) S Y=Y*X1+($F("0123456789ABCDEF",$E(X,I))-2)
Q Y
XOR(X1,X2) ;Exclusive OR two numbers
I ^%ZOSF("OS")["DSM" Q $&ZLIB.%BOOLEAN(X1,X2,6)
I ^%ZOSF("OS")["MSM" Q @("$ZBOOLEAN("_X1_","_X2_",6)")
Q ""
XWBTCPZ ;SLC/KCM - calls to client listener [ 12/04/94 8:58 PM ]
+1 ;;1.0T11;RPC BROKER;;Oct 31, 1995
+2 ;
STARTAPP(APP,ERR,DHCP) ; Start a windowed application (use full path name)
+1 ; input: X is name of windowed app
+2 ; output: ERR is returned error code (passed by reference)
+3 NEW X,I,DEV,LEN,OS,SKT
+4 SET SKT=9100
SET ERR="unknown error"
IF '$LENGTH(APP)
SET ERR="no app"
QUIT
+5 SET OS=$SELECT(^%ZOSF("OS")["DSM":"DSM",^("OS")["MSM":"MSM",1:"")
+6 ; -- get the IP address of the client
+7 IF OS="DSM"
SET IP=$PIECE($&ZLIB.%GETDVI($PRINCIPAL,"TT_ACCPORNAM")," ",2)
+8 ; -- for laptop demo only
IF OS="MSM"
SET IP="127.0.0.1"
+9 IF '$LENGTH(IP)
SET ERR="not telnet device"
QUIT
+10 ; -- connect to client
+11 IF OS="DSM"
OPEN SKT:(TCPCHAN:ADDRESS=IP)
USE SKT
SET DEV=SKT
+12 IF OS="MSM"
OPEN 56
USE 56::"TCP"
WRITE /SOCKET(IP,SKT)
SET DEV=56
+13 ; -- send StartApp message
+14 SET X="StartApp^"_APP
+15 IF $GET(DHCP)
SET X=X_" "_$$NCRYPT^XWBTCPZ(DUZ_"^password^"_$HOROLOG,$CHAR(83,69,67,82,69,84))
+16 WRITE X,$CHAR(4),!
+17 ; -- get acknowledgement
+18 READ *LEN
READ X#LEN
+19 IF X'="ack"
SET ERR="not started"
+20 IF '$TEST
SET ERR=""
+21 ; -- close socket
+22 CLOSE DEV
+23 USE $PRINCIPAL
+24 QUIT
+25 ;
NCRYPT(SRC,KEY) ; Encrypt the string in SRC, using KEY
+1 ; Input: SRC, KEY
+2 ; Output: DEST returned as value of function
+3 NEW OFFSET,SRCPOS,SRCASC,KEYPOS,DEST
+4 SET OFFSET=($RANDOM(10000)#255)+1
+5 SET DEST=$TRANSLATE($JUSTIFY($$HEX(OFFSET),2)," ","0")
+6 SET KEYPOS=0
FOR SRCPOS=1:1:$LENGTH(SRC)
Begin DoDot:1
+7 SET SRCASC=($ASCII(SRC,SRCPOS)+OFFSET)#255
+8 IF KEYPOS<$LENGTH(KEY)
SET KEYPOS=KEYPOS+1
+9 IF '$TEST
SET KEYPOS=1
+10 SET SRCASC=$$XOR(SRCASC,$ASCII(KEY,KEYPOS))
+11 SET DEST=DEST_$JUSTIFY($$HEX(SRCASC),2)
+12 SET OFFSET=SRCASC
End DoDot:1
+13 QUIT DEST
DCRYPT(SRC,KEY) ; Decrypt the string in SRC, using KEY
+1 ; Input: SRC, KEY
+2 ; Output: DEST returned as value of function
+3 NEW OFFSET,SRCPOS,SRCASC,KEYPOS,TMPASC,DEST
+4 SET OFFSET=$$DEC($EXTRACT(SRC,1,2))
SET DEST=""
SET KEYPOS=0
+5 FOR SRCPOS=3:2:$LENGTH(SRC)
Begin DoDot:1
+6 SET SRCASC=$$DEC($TRANSLATE($EXTRACT(SRC,SRCPOS,SRCPOS+1)," ",""))
+7 IF KEYPOS<$LENGTH(KEY)
SET KEYPOS=KEYPOS+1
+8 IF '$TEST
SET KEYPOS=1
+9 SET TMPASC=$$XOR(SRCASC,$ASCII(KEY,KEYPOS))
+10 IF TMPASC'>OFFSET
SET TMPASC=255+TMPASC-OFFSET
+11 IF '$TEST
SET TMPASC=TMPASC-OFFSET
+12 SET DEST=DEST_$CHAR(TMPASC)
SET OFFSET=SRCASC
End DoDot:1
+13 QUIT DEST
HEX(X) ; Return the hex value of the decimal number in X
+1 NEW I,X1,Y
SET Y=""
SET X1=16
+2 FOR I=1:1
SET Y=$EXTRACT("0123456789ABCDEF",X#X1+1)_Y
SET X=X\X1
IF X<1
QUIT
+3 QUIT Y
DEC(X) ; Return the decimal value of the hex number in X
+1 NEW I,X1,Y
SET Y=0
SET X1=16
+2 FOR I=1:1:$LENGTH(X)
SET Y=Y*X1+($FIND("0123456789ABCDEF",$EXTRACT(X,I))-2)
+3 QUIT Y
XOR(X1,X2) ;Exclusive OR two numbers
+1 IF ^%ZOSF("OS")["DSM"
QUIT $&ZLIB.%BOOLEAN(X1,X2,6)
+2 IF ^%ZOSF("OS")["MSM"
QUIT @("$ZBOOLEAN("_X1_","_X2_",6)")
+3 QUIT ""
