XTHC10 ;HCIOFO/SG - HTTP 1.0 CLIENT ;12/07/2011
;;7.3;TOOLKIT;**123,566**;Apr 25, 1995;Build 6
;
Q
;
;##### GETS THE DATA FROM THE PROVIDED URL USING HTTP 1.0
;
; URL URL (http://host:port/path)
;
; [XT8FLG] Timeout and flags to control processing.
; If a value of this parameter starts from a number
; then this number is used as a value of the timeout
; (in seconds). Otherwise, the default value of 5
; seconds is used.
;
; [XT8RDAT] Closed root of the variable where the message
; body is returned. Data is stored in consecutive
; nodes (numbers starting from 1). If a line is
; longer than 245 characters, only 245 characters
; are stored in the corresponding node. After that,
; overflow sub-nodes are created. For example:
;
; @XT8DATA@(1)="<html>"
; @XT8DATA@(2)="<head><title>VistA</title></head>"
; @XT8DATA@(3)="<body>"
; @XT8DATA@(4)="<p>"
; @XT8DATA@(5)="Beginning of a very long line"
; @XT8DATA@(5,1)="Continuation #1 of the long line"
; @XT8DATA@(5,2)="Continuation #2 of the long line"
; @XT8DATA@(5,...)=...
; @XT8DATA@(6)="</p>"
; ...
;
; [.XT8RHDR] Reference to a local variable where the parsed
; headers are returned. Header names are converted to
; upper case; the values are left "as is". The root
; node contains the status line. For example:
;
; XT8HDR="HTTP/1.0 200 OK"
; XT8HDR("CACHE-CONTROL")="private"
; XT8HDR("CONNECTION")="Keep-Alive"
; XT8HDR("CONTENT-LENGTH")="2690"
; XT8HDR("CONTENT-TYPE")="text/html"
; XT8HDR("DATE")="Fri, 26 Sep 2003 16:04:10 GMT"
; XT8HDR("SERVER")="GWS/2.1"
;
; [XT8SDAT] Closed root of a variable containing body of the
; request message. Data should be formatted as
; described earlier (see the XT8RDAT parameter).
;
; NOTE: If this parameter is defined, not empty, and
; the referenced array contains data then the
; POST request is generated. Otherwise, the GET
; request is sent.
;
; [.XT8SHDR] Reference to a local variable containing header
; values, which will be added to the request.
;
; [REDIR] This IS NOT a published parameter. It is used
; internally to limit number of redirections.
;
; Return values:
;
; <0 Error Descriptor (see the $$ERROR^XTERROR)
; >0 HTTP Status Code^Description
;
; Most common HTTP status codes:
;
; 200 Ok
;
; 301 Moved Permanently (The application should either
; automatically update the URL with the new one from
; the Location response header or instruct the user
; how to do this).
;
; 302 Moved Temporarily (The application should continue
; using the original URL).
;
; NOTE: You will not see this code for GET requests.
; They are redirected automatically.
;
; 303 See Other (The resource has moved to another URL
; given by the Location response header, and should
; be automatically retrieved by the client using the
; GET method. This is often used by a CGI script to
; redirect the client to an existing file).
;
; NOTE: You will not see this status code because it
; is handled automatically inside the function.
;
; 400 Bad Request
;
; 404 Not Found
;
; 500 Server Error (An unexpected server error. The most
; common cause is a server-side script that has bad
; syntax, fails, or otherwise can't run correctly).
;
; See the http://www.faqs.org/rfcs/rfc1945.html for more details.
;
GETURL(URL,XT8FLG,XT8RDAT,XT8RHDR,XT8SDAT,XT8SHDR,REDIR) ;
N HOST,I,IP,IPADDR,PATH,PORT,RQS,STATUS,X
;**P566 START CJM
N IO,POP
;**P566 END CJM
S XT8FLG=$G(XT8FLG) S:XT8FLG'?1.N.E XT8FLG="5"_XT8FLG
;
;Check IO
I '$D(IO(0)) D HOME^%ZIS
;=== Parse the URL
S I=$$PARSEURL^XTHCURL(URL,.HOST,.PORT,.PATH) Q:I<0 I
;
;=== Check the host name/address
I HOST'?1.3N3(1"."1.3N) D Q:IPADDR="" $$ERROR(2,HOST)
. ;--- Resolve the host name into the IP address(es)
. S IPADDR=$$ADDRESS^XLFNSLK(HOST) Q:IPADDR=""
. ;--- Check for the Host header value
. S I=""
. F S I=$O(XT8SHDR(I)) Q:(I="")!($$UP^XLFSTR(I)="HOST")
. S:I="" XT8SHDR("Host")=HOST
E S IPADDR=HOST
;
;=== Connect to the host
F I=1:1 S IP=$P(IPADDR,",",I) Q:IP="" D Q:'$G(POP)
. D CALL^%ZISTCP(IP,PORT,+XT8FLG)
Q:$G(POP) $$ERROR(3,IPADDR)
;
;=== Perform the transaction
D
. N $ESTACK,$ETRAP
. ;--- Setup the error processing
. ;D SETDEFEH^XTERROR("STATUS")
. S $ET="D ETRAP^XTHC10"
. ;--- Send the request and get the response
. S RQS=$$REQUEST^XTHC10A(PATH,$G(XT8SDAT),.XT8SHDR)
. I RQS<0 S STATUS=RQS Q
. S STATUS=$$RECEIVE^XTHC10A(+XT8FLG,$G(XT8RDAT),.XT8RHDR)
;
;=== Close the socket
D CLOSE^%ZISTCP
;
;=== Redirect if requested by the server
S I=+STATUS
I (I\100)=3 D:$S(I=303:1,I=301:0,1:RQS="GET")
. I $G(REDIR)>5 S STATUS=$$ERROR(5) Q
. S URL=$G(XT8RHDR("LOCATION"))
. ;I URL="" S STATUS=$$ERROR^XTERROR(-150000.024) Q
. I URL="" S STATUS=$$ERROR(4) Q
. I RQS="POST" N XT8SDAT ; Force the GET request
. S STATUS=$$GETURL(URL,XT8FLG,$G(XT8RDAT),.XT8RHDR,$G(XT8SDAT),.XT8SHDR,$G(REDIR)+1)
;
;=== Return the status
;I +STATUS=-150000.004 S X=$$LASTERR^XTERROR1() S:X STATUS=X
I +STATUS=-6 S STATUS=STATUS("ERROR")
Q STATUS
;
ETRAP ;Catch a runtime error
N EC
S STATUS("ERROR")=$$EC^%ZOSV D ^%ZTER
S STATUS=-6
I $L($EC) S $ECODE="" S $ETRAP="D UNW^%ZTER Q:$QUIT STATUS Q " S $ECODE=",U1,"
Q
;
ERROR(ENUM,PARAM) ;Expand error
N MSG
S MSG=$P($T(@ENUM),";;",2) S:MSG["|" MSG=$P(MSG,"|")_$G(PARAM)_$P(MSG,"|",2)
Q MSG
;
1 ;;-1^Missing host name.
2 ;;-1^Cannot resolve the host name: |.
3 ;;-1^Cannot connect to host.
4 ;;-1^Missing redirection URL.
5 ;;-1^Too many redirections.
6 ;;-6^Run Time Error.
7 ;;-1^Time Out.
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTHC10 6639 printed Apr 09, 2024@21:42:29 Page 2
XTHC10 ;HCIOFO/SG - HTTP 1.0 CLIENT ;12/07/2011
+1 ;;7.3;TOOLKIT;**123,566**;Apr 25, 1995;Build 6
+2 ;
+3 QUIT
+4 ;
+5 ;##### GETS THE DATA FROM THE PROVIDED URL USING HTTP 1.0
+6 ;
+7 ; URL URL (http://host:port/path)
+8 ;
+9 ; [XT8FLG] Timeout and flags to control processing.
+10 ; If a value of this parameter starts from a number
+11 ; then this number is used as a value of the timeout
+12 ; (in seconds). Otherwise, the default value of 5
+13 ; seconds is used.
+14 ;
+15 ; [XT8RDAT] Closed root of the variable where the message
+16 ; body is returned. Data is stored in consecutive
+17 ; nodes (numbers starting from 1). If a line is
+18 ; longer than 245 characters, only 245 characters
+19 ; are stored in the corresponding node. After that,
+20 ; overflow sub-nodes are created. For example:
+21 ;
+22 ; @XT8DATA@(1)="<html>"
+23 ; @XT8DATA@(2)="<head><title>VistA</title></head>"
+24 ; @XT8DATA@(3)="<body>"
+25 ; @XT8DATA@(4)="<p>"
+26 ; @XT8DATA@(5)="Beginning of a very long line"
+27 ; @XT8DATA@(5,1)="Continuation #1 of the long line"
+28 ; @XT8DATA@(5,2)="Continuation #2 of the long line"
+29 ; @XT8DATA@(5,...)=...
+30 ; @XT8DATA@(6)="</p>"
+31 ; ...
+32 ;
+33 ; [.XT8RHDR] Reference to a local variable where the parsed
+34 ; headers are returned. Header names are converted to
+35 ; upper case; the values are left "as is". The root
+36 ; node contains the status line. For example:
+37 ;
+38 ; XT8HDR="HTTP/1.0 200 OK"
+39 ; XT8HDR("CACHE-CONTROL")="private"
+40 ; XT8HDR("CONNECTION")="Keep-Alive"
+41 ; XT8HDR("CONTENT-LENGTH")="2690"
+42 ; XT8HDR("CONTENT-TYPE")="text/html"
+43 ; XT8HDR("DATE")="Fri, 26 Sep 2003 16:04:10 GMT"
+44 ; XT8HDR("SERVER")="GWS/2.1"
+45 ;
+46 ; [XT8SDAT] Closed root of a variable containing body of the
+47 ; request message. Data should be formatted as
+48 ; described earlier (see the XT8RDAT parameter).
+49 ;
+50 ; NOTE: If this parameter is defined, not empty, and
+51 ; the referenced array contains data then the
+52 ; POST request is generated. Otherwise, the GET
+53 ; request is sent.
+54 ;
+55 ; [.XT8SHDR] Reference to a local variable containing header
+56 ; values, which will be added to the request.
+57 ;
+58 ; [REDIR] This IS NOT a published parameter. It is used
+59 ; internally to limit number of redirections.
+60 ;
+61 ; Return values:
+62 ;
+63 ; <0 Error Descriptor (see the $$ERROR^XTERROR)
+64 ; >0 HTTP Status Code^Description
+65 ;
+66 ; Most common HTTP status codes:
+67 ;
+68 ; 200 Ok
+69 ;
+70 ; 301 Moved Permanently (The application should either
+71 ; automatically update the URL with the new one from
+72 ; the Location response header or instruct the user
+73 ; how to do this).
+74 ;
+75 ; 302 Moved Temporarily (The application should continue
+76 ; using the original URL).
+77 ;
+78 ; NOTE: You will not see this code for GET requests.
+79 ; They are redirected automatically.
+80 ;
+81 ; 303 See Other (The resource has moved to another URL
+82 ; given by the Location response header, and should
+83 ; be automatically retrieved by the client using the
+84 ; GET method. This is often used by a CGI script to
+85 ; redirect the client to an existing file).
+86 ;
+87 ; NOTE: You will not see this status code because it
+88 ; is handled automatically inside the function.
+89 ;
+90 ; 400 Bad Request
+91 ;
+92 ; 404 Not Found
+93 ;
+94 ; 500 Server Error (An unexpected server error. The most
+95 ; common cause is a server-side script that has bad
+96 ; syntax, fails, or otherwise can't run correctly).
+97 ;
+98 ; See the http://www.faqs.org/rfcs/rfc1945.html for more details.
+99 ;
GETURL(URL,XT8FLG,XT8RDAT,XT8RHDR,XT8SDAT,XT8SHDR,REDIR) ;
+1 NEW HOST,I,IP,IPADDR,PATH,PORT,RQS,STATUS,X
+2 ;**P566 START CJM
+3 NEW IO,POP
+4 ;**P566 END CJM
+5 SET XT8FLG=$GET(XT8FLG)
if XT8FLG'?1.N.E
SET XT8FLG="5"_XT8FLG
+6 ;
+7 ;Check IO
+8 IF '$DATA(IO(0))
DO HOME^%ZIS
+9 ;=== Parse the URL
+10 SET I=$$PARSEURL^XTHCURL(URL,.HOST,.PORT,.PATH)
if I<0
QUIT I
+11 ;
+12 ;=== Check the host name/address
+13 IF HOST'?1.3N3(1"."1.3N)
Begin DoDot:1
+14 ;--- Resolve the host name into the IP address(es)
+15 SET IPADDR=$$ADDRESS^XLFNSLK(HOST)
if IPADDR=""
QUIT
+16 ;--- Check for the Host header value
+17 SET I=""
+18 FOR
SET I=$ORDER(XT8SHDR(I))
if (I="")!($$UP^XLFSTR(I)="HOST")
QUIT
+19 if I=""
SET XT8SHDR("Host")=HOST
End DoDot:1
if IPADDR=""
QUIT $$ERROR(2,HOST)
+20 IF '$TEST
SET IPADDR=HOST
+21 ;
+22 ;=== Connect to the host
+23 FOR I=1:1
SET IP=$PIECE(IPADDR,",",I)
if IP=""
QUIT
Begin DoDot:1
+24 DO CALL^%ZISTCP(IP,PORT,+XT8FLG)
End DoDot:1
if '$GET(POP)
QUIT
+25 if $GET(POP)
QUIT $$ERROR(3,IPADDR)
+26 ;
+27 ;=== Perform the transaction
+28 Begin DoDot:1
+29 NEW $ESTACK,$ETRAP
+30 ;--- Setup the error processing
+31 ;D SETDEFEH^XTERROR("STATUS")
+32 SET $ETRAP="D ETRAP^XTHC10"
+33 ;--- Send the request and get the response
+34 SET RQS=$$REQUEST^XTHC10A(PATH,$GET(XT8SDAT),.XT8SHDR)
+35 IF RQS<0
SET STATUS=RQS
QUIT
+36 SET STATUS=$$RECEIVE^XTHC10A(+XT8FLG,$GET(XT8RDAT),.XT8RHDR)
End DoDot:1
+37 ;
+38 ;=== Close the socket
+39 DO CLOSE^%ZISTCP
+40 ;
+41 ;=== Redirect if requested by the server
+42 SET I=+STATUS
+43 IF (I\100)=3
if $SELECT(I=303
Begin DoDot:1
+44 IF $GET(REDIR)>5
SET STATUS=$$ERROR(5)
QUIT
+45 SET URL=$GET(XT8RHDR("LOCATION"))
+46 ;I URL="" S STATUS=$$ERROR^XTERROR(-150000.024) Q
+47 IF URL=""
SET STATUS=$$ERROR(4)
QUIT
+48 ; Force the GET request
IF RQS="POST"
NEW XT8SDAT
+49 SET STATUS=$$GETURL(URL,XT8FLG,$GET(XT8RDAT),.XT8RHDR,$GET(XT8SDAT),.XT8SHDR,$GET(REDIR)+1)
End DoDot:1
+50 ;
+51 ;=== Return the status
+52 ;I +STATUS=-150000.004 S X=$$LASTERR^XTERROR1() S:X STATUS=X
+53 IF +STATUS=-6
SET STATUS=STATUS("ERROR")
+54 QUIT STATUS
+55 ;
ETRAP ;Catch a runtime error
+1 NEW EC
+2 SET STATUS("ERROR")=$$EC^%ZOSV
DO ^%ZTER
+3 SET STATUS=-6
+4 IF $LENGTH($ECODE)
SET $ECODE=""
SET $ETRAP="D UNW^%ZTER Q:$QUIT STATUS Q "
SET $ECODE=",U1,"
+5 QUIT
+6 ;
ERROR(ENUM,PARAM) ;Expand error
+1 NEW MSG
+2 SET MSG=$PIECE($TEXT(@ENUM),";;",2)
if MSG["|"
SET MSG=$PIECE(MSG,"|")_$GET(PARAM)_$PIECE(MSG,"|",2)
+3 QUIT MSG
+4 ;
1 ;;-1^Missing host name.
2 ;;-1^Cannot resolve the host name: |.
3 ;;-1^Cannot connect to host.
4 ;;-1^Missing redirection URL.
5 ;;-1^Too many redirections.
6 ;;-6^Run Time Error.
7 ;;-1^Time Out.
