- 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 Jan 18, 2025@03:42:07 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.