[628] | 1 | ONCX10 ;HCIOFO/SG - HTTP 1.0 CLIENT ; 6/20/06 9:29am
|
---|
| 2 | ;;2.11;ONCOLOGY;**40,41,46**;Mar 07, 1995;Build 39
|
---|
| 3 | ;
|
---|
| 4 | Q
|
---|
| 5 | ;
|
---|
| 6 | ;***** GETS THE DATA FROM THE PROVIDED URL USING HTTP 1.0
|
---|
| 7 | ;
|
---|
| 8 | ; URL URL (http://host:port/path)
|
---|
| 9 | ;
|
---|
| 10 | ; [ONC8FLG] Timeout and flags to control processing
|
---|
| 11 | ; If a value of this parameter starts from a number
|
---|
| 12 | ; then this number is used as a value of the timeout
|
---|
| 13 | ; (in seconds). Otherwise, the default value of 3
|
---|
| 14 | ; seconds is used.
|
---|
| 15 | ;
|
---|
| 16 | ; [ONC8RDAT] Closed root of the variable where the message
|
---|
| 17 | ; body is returned. Data is stored in consecutive
|
---|
| 18 | ; nodes (numbers starting from 1). If a line is
|
---|
| 19 | ; longer than 245 characters, only 245 characters
|
---|
| 20 | ; are stored in the corresponding node. After that,
|
---|
| 21 | ; overflow sub-nodes are created. For example:
|
---|
| 22 | ;
|
---|
| 23 | ; @ONC8DATA@(1)="<html>"
|
---|
| 24 | ; @ONC8DATA@(2)="<head><title>VistA</title></head>"
|
---|
| 25 | ; @ONC8DATA@(3)="<body>"
|
---|
| 26 | ; @ONC8DATA@(4)="<p>"
|
---|
| 27 | ; @ONC8DATA@(5)="Beginning of a very long line"
|
---|
| 28 | ; @ONC8DATA@(5,1)="Continuation #1 of the long line"
|
---|
| 29 | ; @ONC8DATA@(5,2)="Continuation #2 of the long line"
|
---|
| 30 | ; @ONC8DATA@(5,...)=...
|
---|
| 31 | ; @ONC8DATA@(6)="</p>"
|
---|
| 32 | ; ...
|
---|
| 33 | ;
|
---|
| 34 | ; [.ONC8RHDR] Reference to a local variable where the parsed
|
---|
| 35 | ; headers are returned. Header names are converted to
|
---|
| 36 | ; upper case; the values are left "as is". The root
|
---|
| 37 | ; node contains the status line. For example:
|
---|
| 38 | ;
|
---|
| 39 | ; ONC8HDR="HTTP/1.0 200 OK"
|
---|
| 40 | ; ONC8HDR("CACHE-CONTROL")="private"
|
---|
| 41 | ; ONC8HDR("CONNECTION")="Keep-Alive"
|
---|
| 42 | ; ONC8HDR("CONTENT-LENGTH")="2690"
|
---|
| 43 | ; ONC8HDR("CONTENT-TYPE")="text/html"
|
---|
| 44 | ; ONC8HDR("DATE")="Fri, 26 Sep 2003 16:04:10 GMT"
|
---|
| 45 | ; ONC8HDR("SERVER")="GWS/2.1"
|
---|
| 46 | ;
|
---|
| 47 | ; [ONC8SDAT] Closed root of a variable containing body of the
|
---|
| 48 | ; request message. Data should be formatted as
|
---|
| 49 | ; described earlier (see the ONC8RDAT parameter).
|
---|
| 50 | ;
|
---|
| 51 | ; NOTE: If this parameter is defined, not empty, and the
|
---|
| 52 | ; referenced array contains data then the POST request
|
---|
| 53 | ; is generated. Otherwise, the GET request is sent.
|
---|
| 54 | ;
|
---|
| 55 | ; [.ONC8SHDR] 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
|
---|
| 64 | ; (see the $$ERROR^ONCXERR for descriptor structure
|
---|
| 65 | ; and the MSGLIST^ONCXERR for list of error)
|
---|
| 66 | ;
|
---|
| 67 | ; >0 HTTP Status Code^Description
|
---|
| 68 | ;
|
---|
| 69 | ; Most common HTTP status codes:
|
---|
| 70 | ;
|
---|
| 71 | ; 200 Ok
|
---|
| 72 | ;
|
---|
| 73 | ; 301 Moved Permanently (The application should either
|
---|
| 74 | ; automatically update the URL with the new one from
|
---|
| 75 | ; the Location response header or instruct the user
|
---|
| 76 | ; how to do this).
|
---|
| 77 | ;
|
---|
| 78 | ; 302 Moved Temporarily (The application should continue
|
---|
| 79 | ; using the original URL).
|
---|
| 80 | ;
|
---|
| 81 | ; NOTE: You will not see this code for GET requests.
|
---|
| 82 | ; They are redirected automatically.
|
---|
| 83 | ;
|
---|
| 84 | ; 303 See Other (The resource has moved to another URL
|
---|
| 85 | ; given by the Location response header, and should
|
---|
| 86 | ; be automatically retrieved by the client using the
|
---|
| 87 | ; GET method. This is often used by a CGI script to
|
---|
| 88 | ; redirect the client to an existing file).
|
---|
| 89 | ;
|
---|
| 90 | ; NOTE: You will not see this status code because it
|
---|
| 91 | ; is handled automatically inside the function.
|
---|
| 92 | ;
|
---|
| 93 | ; 400 Bad Request
|
---|
| 94 | ;
|
---|
| 95 | ; 404 Not Found
|
---|
| 96 | ;
|
---|
| 97 | ; 500 Server Error (An unexpected server error. The most
|
---|
| 98 | ; common cause is a server-side script that has bad
|
---|
| 99 | ; syntax, fails, or otherwise can't run correctly).
|
---|
| 100 | ;
|
---|
| 101 | ; See the http://www.faqs.org/rfcs/rfc1945.html for more details.
|
---|
| 102 | ;
|
---|
| 103 | GETURL(URL,ONC8FLG,ONC8RDAT,ONC8RHDR,ONC8SDAT,ONC8SHDR,REDIR) ;
|
---|
| 104 | N $ESTACK,$ETRAP,HOST,I,IP,IPADDR,PATH,PORT,RQS,STATUS,X
|
---|
| 105 | S ONC8FLG=$G(ONC8FLG) S:ONC8FLG'?1.N.E ONC8FLG="3"_ONC8FLG
|
---|
| 106 | S I=$$PARSE^ONCXURL(URL,.HOST,.PORT,.PATH) Q:I<0 I
|
---|
| 107 | ;--- Check the host name/address
|
---|
| 108 | I HOST'?1.3N3(1"."1.3N) D Q:IPADDR="" $$ERROR^ONCXERR(-2,,HOST)
|
---|
| 109 | . ;--- Resolve the host name into IP address(es)
|
---|
| 110 | . S IPADDR=$$ADDRESS^XLFNSLK(HOST) Q:IPADDR=""
|
---|
| 111 | . ;--- Check for the Host header value
|
---|
| 112 | . S I=""
|
---|
| 113 | . F S I=$O(ONC8SHDR(I)) Q:(I="")!($$UP^XLFSTR(I)="HOST")
|
---|
| 114 | . S:I="" ONC8SHDR("Host")=HOST
|
---|
| 115 | E S IPADDR=HOST
|
---|
| 116 | ;--- Connect to the host
|
---|
| 117 | F I=1:1 S IP=$P(IPADDR,",",I) Q:IP="" D Q:'$G(POP)
|
---|
| 118 | . D CALL^%ZISTCP(IP,PORT,+ONC8FLG)
|
---|
| 119 | Q:$G(POP) $$ERROR^ONCXERR(-3,,IPADDR)
|
---|
| 120 | ;--- Perform the transaction
|
---|
| 121 | K STATUS D S:'$D(STATUS) STATUS=$$ERROR^ONCXERR(-6)
|
---|
| 122 | . ;--- Setup the error processing
|
---|
| 123 | . S X="ERRTRAP^ONCX10",@^%ZOSF("TRAP"),$ETRAP=""
|
---|
| 124 | . ;--- Send the request and get the response
|
---|
| 125 | . S RQS=$$REQUEST^ONCX10A(PATH,$G(ONC8SDAT),.ONC8SHDR)
|
---|
| 126 | . I RQS<0 S STATUS=RQS Q
|
---|
| 127 | . S STATUS=$$RECEIVE^ONCX10A(+ONC8FLG,$G(ONC8RDAT),.ONC8RHDR)
|
---|
| 128 | ;--- Close the socket
|
---|
| 129 | D CLOSE^%ZISTCP
|
---|
| 130 | ;--- Redirect if requested by the server
|
---|
| 131 | S I=+STATUS
|
---|
| 132 | I (I\100)=3 D:$S(I=303:1,I=301:0,1:RQS="GET")
|
---|
| 133 | . I $G(REDIR)>5 S STATUS=$$ERROR^ONCXERR(-5) Q
|
---|
| 134 | . S URL=$G(ONC8RHDR("LOCATION"))
|
---|
| 135 | . I URL="" S STATUS=$$ERROR^ONCXERR(-4) Q
|
---|
| 136 | . I RQS="POST" N ONC8SDAT ; Force the GET request
|
---|
| 137 | . S STATUS=$$GETURL(URL,ONC8FLG,$G(ONC8RDAT),.ONC8RHDR,$G(ONC8SDAT),.ONC8SHDR,$G(REDIR)+1)
|
---|
| 138 | ;--- Return the status
|
---|
| 139 | Q STATUS
|
---|
| 140 | ;
|
---|
| 141 | ERRTRAP D @^%ZOSF("ERRTN") Q
|
---|