- 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 ""
