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